Merge pull request #22 from wirc-sjsu/develop-w21
[WRF-SFIRE.git] / wrftladj / module_sfs_nba_ad.F
blob855f38f20890db2daa6a4280a2c2fb53ccdaeaf7
2 ! ======================================================================================
3 ! This file was generated by the version 4.3.7 of ADG on 08/16/2010. The Adjoint Code
4 ! Generator (ADG) was developed and sponsored by LASG of IAP (1999-2010)
5 ! The Copyright of the ADG system was declared by Walls at LASG, 1999-2010
6 ! ======================================================================================
8 MODULE a_module_sfs_nba
10    USE module_configure, ONLY : grid_config_rec_type
11    USE module_sfs_nba, ONLY : c1, c2, c3, ce, cb, cs  ! Added by Ning Pan, 2010-08-18
13    IMPLICIT NONE
15    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
16 !   REAL :: c1,c2,c3,ce,cb,cs  ! Remarked by Ning Pan, 2010-08-18
18 !  a_F90 =0.0
20 CONTAINS
22 ! Remarked by Ning Pan, 2010-08-18
23 !   SUBROUTINE a_calc_mij_constants()
25 !PART! I: DECLARATION OF VARIABLES
27 !   IMPLICIT NONE
29 !   INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
30 !   REAL :: sk,pi
32 !PART! II: CALCULATIONS OF B. S. TRAJECTORY
34 !PART! III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
36 !!  a_F90 =0.0
38 !PART! IV: REVERSE/BACKWARD ACCUMULATIONS
40 !REVISED! BY WALLS
41 !LPB[0]
42 !   sk =0.5
43 !   pi =3.1415927
44 !   cb =0.36
46 !   cs =((8.0*(1.0+cb))/(27.0*pi**2))**0.5
47 !   c1 =((960.0**0.5)*cb)/(7.0*(1.0+cb)*sk)
48 !   c2 =c1
49 !   ce =((8.0*pi/27.0)**(1.0/3.0))*cs**(4.0/3.0)
50 !   c3 =((27.0/(8.0*pi))**(1.0/3.0))*cs**(2.0/3.0)
52 !   Return
53 !   END SUBROUTINE a_calc_mij_constants
55    SUBROUTINE a_calc_smnsmn(smnsmn,a_smnsmn,s11,a_s11,s22,a_s22,s33,a_s33,s12, &
56    a_s12,s13,a_s13,s23,a_s23,config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
57    kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
59 !PART I: DECLARATION OF VARIABLES
61    IMPLICIT NONE
63    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
64    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: smnsmn,a_smnsmn
65    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s11,a_s11,s22,a_s22,s33,a_s33,s12, &
66    a_s12,s13,a_s13,s23,a_s23
67    TYPE(grid_config_rec_type) :: config_flags
68    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, &
69    its,ite,jts,jte,kts,kte
70    REAL :: tmp,a_tmp
71    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
73    REAL,DIMENSION(max(jds+1,jts):min(jde-2,jte)) :: Keep_Lpb14_tmp   
74 !  REAL,DIMENSION(max(jds+1,jts):min(jde-2,jte)) :: Keep_Lpb15_tmp   
75    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004
76    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv300
78 !PART II: CALCULATIONS OF B. S. TRAJECTORY
80 !LPB[0]
81      ktf = min(kte,kde-1)
82      i_start = its
83      i_end   = MIN(ite,ide-1)
84      j_start = jts
85      j_end   = MIN(jte,jde-1)
87 !LPB[1]
88   IF ( config_flags%open_xs .or. config_flags%specified .or.   &
89        config_flags%nested) i_start = MAX(ids+1,its)
91 !LPB[2]
93 !LPB[3]
94   IF ( config_flags%open_xe .or. config_flags%specified .or.   &
95        config_flags%nested) i_end   = MIN(ide-2,ite)
97 !LPB[4]
99 !LPB[5]
100   IF ( config_flags%open_ys .or. config_flags%specified .or.   &
101        config_flags%nested) j_start = MAX(jds+1,jts)
103 !LPB[6]
105 !LPB[7]
106   IF ( config_flags%open_ye .or. config_flags%specified .or.   &
107        config_flags%nested) j_end   = MIN(jde-2,jte)
109 !LPB[8]
111 !LPB[9]
112   IF ( config_flags%periodic_x ) i_start = its
114 !LPB[10]
116 !LPB[11]
117   IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
119 ! Remarked by Ning Pan, 2010-08-18 : LPB[12]-[14]
120 !LPB[12]
121 !     DO j=j_start,j_end
123 !     DO k=kts,ktf
124 !     DO i=i_start,i_end
125 !       smnsmn(i,k,j) = 0.25*( s11(i,k,j)*s11(i,k,j) +   &
126 !                              s22(i,k,j)*s22(i,k,j) +   &
127 !                              s33(i,k,j)*s33(i,k,j) )
128 !     END DO
129 !     END DO
131 !     END DO
133 !LPB[13]
134 !     DO j=j_start,j_end
136 !     DO k=kts,ktf
137 !     DO i=i_start,i_end
138 !       tmp = 0.125*( s12(i  ,k,j) + s12(i  ,k,j+1) +   &
139 !                     s12(i+1,k,j) + s12(i+1,k,j+1) )
140 !       smnsmn(i,k,j) = smnsmn(i,k,j) + 2.0*tmp*tmp
141 !     END DO
142 !     END DO
144 !     END DO
146 !LPB[14]
147 !     DO j=j_start,j_end
149 !       Keep_Lpb14_tmp(j) =tmp
151 !     DO k=kts,ktf
152 !     DO i=i_start,i_end
153 !       tmp = 0.125*( s13(i  ,k+1,j) + s13(i  ,k,j) +   &
154 !                     s13(i+1,k+1,j) + s13(i+1,k,j) )
155 !       smnsmn(i,k,j) = smnsmn(i,k,j) + 2.0*tmp*tmp
156 !     END DO
157 !     END DO
159 !     END DO
161 !!LPB[15]
162 !     DO j=j_start,j_end
164 !    !  Keep_Lpb15_tmp(j) =tmp
166 !     DO k=kts,ktf
167 !     DO i=i_start,i_end
168 !       tmp = 0.125*( s23(i,k+1,j  ) + s23(i,k,j  ) +   &
169 !                     s23(i,k+1,j+1) + s23(i,k,j+1) )
170 !       smnsmn(i,k,j) = smnsmn(i,k,j) + 2.0*tmp*tmp
171 !     END DO
172 !     END DO
174 !     END DO
176 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
178    a_tmp =0.0
180 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
182 !LPB[15]
183    DO j =j_end, j_start, -1
185 !  tmp =Keep_Lpb15_tmp(j)
187    DO k =kts, ktf
188    DO i =i_start, i_end
189    Tmpv001 =s23(i,k+1,j) +s23(i,k,j)
190    Tmpv002 =Tmpv001 +s23(i,k+1,j+1)
191    Tmpv003 =Tmpv002 +s23(i,k,j+1)
192    Tmpv004 =0.125*Tmpv003
193    tmp =Tmpv004
194    Tmpv300(i,k) =tmp
196 ! Remarked by Ning Pan, 2010-08-18
197 !   Tmpv001 =smnsmn(i,k,j) +2.0*tmp*tmp
198 !   smnsmn(i,k,j) =Tmpv001
200    ENDDO
201    ENDDO
203    DO k =ktf, kts, -1
204    DO i =i_end, i_start, -1
205    tmp =Tmpv300(i,k)  ! Added by Ning Pan, 2010-08-18
206    a_Tmpv1 =a_smnsmn(i,k,j)
207    a_smnsmn(i,k,j) =0.0
208    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +a_Tmpv1
209    a_tmp =a_tmp +(2.0*tmp +2.0*tmp)*a_Tmpv1
211 !   tmp =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-08-18
213    a_Tmpv4 =a_tmp
214    a_tmp =0.0
215    a_Tmpv3 =0.125*a_Tmpv4
216    a_Tmpv2 =a_Tmpv3
217    a_s23(i,k,j+1) =a_s23(i,k,j+1) +a_Tmpv3
218    a_Tmpv1 =a_Tmpv2
219    a_s23(i,k+1,j+1) =a_s23(i,k+1,j+1) +a_Tmpv2
220    a_s23(i,k+1,j) =a_s23(i,k+1,j) +a_Tmpv1
221    a_s23(i,k,j) =a_s23(i,k,j) +a_Tmpv1
222    ENDDO
223    ENDDO
225    ENDDO
227 !LPB[14]
228    DO j =j_end, j_start, -1
230 !   tmp =Keep_Lpb14_tmp(j)  ! Remarked by Ning Pan, 2010-08-18
232    DO k =kts, ktf
233    DO i =i_start, i_end
234    Tmpv001 =s13(i,k+1,j) +s13(i,k,j)
235    Tmpv002 =Tmpv001 +s13(i+1,k+1,j)
236    Tmpv003 =Tmpv002 +s13(i+1,k,j)
237    Tmpv004 =0.125*Tmpv003
238    tmp =Tmpv004
239    Tmpv300(i,k) =tmp
241 ! Remarked by Ning Pan, 2010-08-18
242 !   Tmpv001 =smnsmn(i,k,j) +2.0*tmp*tmp
243 !   smnsmn(i,k,j) =Tmpv001
245    ENDDO
246    ENDDO
248    DO k =ktf, kts, -1
249    DO i =i_end, i_start, -1
250    tmp =Tmpv300(i,k)  ! Added by Ning Pan, 2010-08-18
251    a_Tmpv1 =a_smnsmn(i,k,j)
252    a_smnsmn(i,k,j) =0.0
253    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +a_Tmpv1
254    a_tmp =a_tmp +(2.0*tmp +2.0*tmp)*a_Tmpv1
256 !   tmp =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-08-18
258    a_Tmpv4 =a_tmp
259    a_tmp =0.0
260    a_Tmpv3 =0.125*a_Tmpv4
261    a_Tmpv2 =a_Tmpv3
262    a_s13(i+1,k,j) =a_s13(i+1,k,j) +a_Tmpv3
263    a_Tmpv1 =a_Tmpv2
264    a_s13(i+1,k+1,j) =a_s13(i+1,k+1,j) +a_Tmpv2
265    a_s13(i,k+1,j) =a_s13(i,k+1,j) +a_Tmpv1
266    a_s13(i,k,j) =a_s13(i,k,j) +a_Tmpv1
267    ENDDO
268    ENDDO
270    ENDDO
272 !LPB[13]
273    DO j =j_end, j_start, -1
275    DO k =kts, ktf
276    DO i =i_start, i_end
277    Tmpv001 =s12(i,k,j) +s12(i,k,j+1)
278    Tmpv002 =Tmpv001 +s12(i+1,k,j)
279    Tmpv003 =Tmpv002 +s12(i+1,k,j+1)
280    Tmpv004 =0.125*Tmpv003
281    tmp =Tmpv004
282    Tmpv300(i,k) =tmp
284 ! Remarked by Ning Pan, 2010-08-18
285 !   Tmpv001 =smnsmn(i,k,j) +2.0*tmp*tmp
286 !   smnsmn(i,k,j) =Tmpv001
288    ENDDO
289    ENDDO
291    DO k =ktf, kts, -1
292    DO i =i_end, i_start, -1
293    tmp =Tmpv300(i,k)  ! Added by Ning Pan, 2010-08-18
294    a_Tmpv1 =a_smnsmn(i,k,j)
295    a_smnsmn(i,k,j) =0.0
296    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +a_Tmpv1
297    a_tmp =a_tmp +(2.0*tmp +2.0*tmp)*a_Tmpv1
299 !   tmp =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-08-18
301    a_Tmpv4 =a_tmp
302    a_tmp =0.0
303    a_Tmpv3 =0.125*a_Tmpv4
304    a_Tmpv2 =a_Tmpv3
305    a_s12(i+1,k,j+1) =a_s12(i+1,k,j+1) +a_Tmpv3
306    a_Tmpv1 =a_Tmpv2
307    a_s12(i+1,k,j) =a_s12(i+1,k,j) +a_Tmpv2
308    a_s12(i,k,j) =a_s12(i,k,j) +a_Tmpv1
309    a_s12(i,k,j+1) =a_s12(i,k,j+1) +a_Tmpv1
310    ENDDO
311    ENDDO
313    ENDDO
315 !LPB[12]
316    DO j =j_end, j_start, -1
318 !  DO k =kts, ktf
319 !  DO i =i_start, i_end
320 !  Tmpv001 =s11(i,k,j)*s11(i,k,j) +s22(i,k,j)*s22(i,k,j)
321 !  Tmpv002 =Tmpv001 +s33(i,k,j)*s33(i,k,j)
322 !  Tmpv003 =0.25*Tmpv002
323 !  smnsmn(i,k,j) =Tmpv003
325 !  ENDDO
326 !  ENDDO
328    DO k =ktf, kts, -1
329    DO i =i_end, i_start, -1
330    a_Tmpv3 =a_smnsmn(i,k,j)
331    a_smnsmn(i,k,j) =0.0
332    a_Tmpv2 =0.25*a_Tmpv3
333    a_Tmpv1 =a_Tmpv2
334    a_s33(i,k,j) =a_s33(i,k,j) +2.0*s33(i,k,j)*a_Tmpv2
335    a_s11(i,k,j) =a_s11(i,k,j) +2.0*s11(i,k,j)*a_Tmpv1
336    a_s22(i,k,j) =a_s22(i,k,j) +2.0*s22(i,k,j)*a_Tmpv1
337    ENDDO
338    ENDDO
340    ENDDO
342 !LPB[11]
344 !  IF( config_flags%periodic_x ) THEN
345 !  i_end =min(ite, ide-1)
346 !  END IF
348 !  IF( config_flags%periodic_x ) THEN
350 !  END IF
352 !LPB[10]
354 !LPB[9]
356 !  IF( config_flags%periodic_x ) THEN
357 !  i_start =its
358 !  END IF
360 !  IF( config_flags%periodic_x ) THEN
362 !  END IF
364 !LPB[8]
366 !LPB[7]
368 !  IF( config_flags%open_ye .or. config_flags%specified .or.           config_flags%nested) THEN
369 !  j_end =min(jde-2, jte)
370 !  END IF
372 !  IF( config_flags%open_ye .or. config_flags%specified .or.   &
373 !          config_flags%nested) THEN
375 !  END IF
377 !LPB[6]
379 !LPB[5]
381 !  IF( config_flags%open_ys .or. config_flags%specified .or.           config_flags%nested) THEN
382 !  j_start =max(jds+1, jts)
383 !  END IF
385 !  IF( config_flags%open_ys .or. config_flags%specified .or.   &
386 !          config_flags%nested) THEN
388 !  END IF
390 !LPB[4]
392 !LPB[3]
394 !  IF( config_flags%open_xe .or. config_flags%specified .or.           config_flags%nested) THEN
395 !  i_end =min(ide-2, ite)
396 !  END IF
398 !  IF( config_flags%open_xe .or. config_flags%specified .or.   &
399 !          config_flags%nested) THEN
401 !  END IF
403 !LPB[2]
405 !LPB[1]
407 !  IF( config_flags%open_xs .or. config_flags%specified .or.           config_flags%nested) THEN
408 !  i_start =max(ids+1, its)
409 !  END IF
411 !  IF( config_flags%open_xs .or. config_flags%specified .or.   &
412 !          config_flags%nested) THEN
414 !  END IF
416 !LPB[0]
417 !  ktf =min(kte, kde-1)
418 !  i_start =its
419 !  i_end =min(ite, ide-1)
420 !  j_start =jts
421 !  j_end =min(jte, jde-1)
423    Return
424         END SUBROUTINE a_calc_smnsmn
426    SUBROUTINE a_calc_mii(m11,a_m11,m22,a_m22,m33,a_m33,s11,a_s11,s22,a_s22, &
427    s33,a_s33,s12,a_s12,s13,a_s13,s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23, &
428    smnsmn,a_smnsmn,tke,a_tke,rdzw,a_rdzw,dx,dy,config_flags,ids,ide,jds,jde,kds, &
429    kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
431 !PART I: DECLARATION OF VARIABLES
433    IMPLICIT NONE
435    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
436    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: m11,a_m11,m22,a_m22,m33,a_m33
437    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s11,a_s11,s22,a_s22,s33,a_s33,s12, &
438    a_s12,s13,a_s13,s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23,smnsmn, &
439    a_smnsmn,tke,a_tke,rdzw,a_rdzw
440    REAL :: dx,dy
441    TYPE(grid_config_rec_type) :: config_flags
442    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, &
443    its,ite,jts,jte,kts,kte
444    REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss11,a_ss11,ss22,a_ss22,ss33, &
445    a_ss33,ss12,a_ss12,ss13,a_ss13,ss23,a_ss23,rr12,a_rr12,rr13,a_rr13,rr23,a_rr23
446    REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss12c,a_ss12c,rr12c,a_rr12c, &
447    ss13c,a_ss13c,rr13c,a_rr13c,ss23c,a_ss23c,rr23c,a_rr23c
448    REAL :: delta,a_delta,a,a_a,b,a_b
449    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf,is_ext,js_ext
451    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
452    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9, &
453    Tmpv009,a_Tmpv10,Tmpv010,a_Tmpv11,Tmpv011,a_Tmpv12,Tmpv012,a_Tmpv13,Tmpv013, &
454    a_Tmpv14,Tmpv014
455    REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
456     :: Tmpv400
457    REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
458     :: Tmpv401
459    REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
460     :: Tmpv402
461    REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
462     :: Tmpv403
463    REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
464     :: Tmpv404
465    REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
466     :: Tmpv405
467    REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
468     :: Tmpv406
469    REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
470     :: Tmpv407
471    REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
472     :: Tmpv408
473    REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
474     :: Tmpv409
475    REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
476     :: Tmpv4010
477    REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
478     :: Tmpv4011
480    REAL :: g_Sqrt
482 !PART II: CALCULATIONS OF B. S. TRAJECTORY
484 !LPB[0]
485      ktf = MIN( kte, kde-1 )
486      i_start = its
487      i_end   = ite
488      j_start = jts
489      j_end   = jte
491 !LPB[1]
492     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
493          config_flags%nested) i_start = MAX( ids+1, its )
495 !LPB[2]
497 !LPB[3]
498     IF ( config_flags%open_xe .OR. config_flags%specified .OR.   &
499          config_flags%nested) i_end   = MIN( ide-1, ite )
501 !LPB[4]
503 !LPB[5]
504     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
505          config_flags%nested) j_start = MAX( jds+1, jts )
507 !LPB[6]
509 !LPB[7]
510     IF ( config_flags%open_ye .OR. config_flags%specified .OR.   &
511          config_flags%nested) j_end   = MIN( jde-1, jte )
513 !LPB[8]
515 !LPB[9]
516       IF ( config_flags%periodic_x ) i_start = its
518 !LPB[10]
520 !LPB[11]
521       IF ( config_flags%periodic_x ) i_end = ite
523 !LPB[12]
524      is_ext = 1
525      js_ext = 1
526      i_start = i_start - is_ext  
527      j_start = j_start - js_ext   
529 !LPB[13]
530      DO j=j_start,j_end+1
532      DO k=kts,ktf
533      DO i=i_start,i_end+1
534        ss11(i,k,j)=s11(i,k,j)/2.0
535        ss22(i,k,j)=s22(i,k,j)/2.0
536        ss33(i,k,j)=s33(i,k,j)/2.0
537        ss12(i,k,j)=s12(i,k,j)/2.0
538        ss13(i,k,j)=s13(i,k,j)/2.0
539        ss23(i,k,j)=s23(i,k,j)/2.0
540        rr12(i,k,j)=r12(i,k,j)/2.0
541        rr13(i,k,j)=r13(i,k,j)/2.0
542        rr23(i,k,j)=r23(i,k,j)/2.0
543      END DO
544      END DO
546      END DO
548 !LPB[14]
549      DO j=j_start,j_end+1
551      DO i=i_start,i_end+1
552        ss13(i,kde,j) = 0.0
553        ss23(i,kde,j) = 0.0
554        rr13(i,kde,j) = 0.0
555        rr23(i,kde,j) = 0.0
556      END DO
558      END DO
560 !LPB[15]
561      DO j = j_start, j_end
563      DO k = kts, ktf
564      DO i = i_start, i_end
565        ss12c(i,k,j) = 0.25*( ss12(i  ,k  ,j  ) + ss12(i  ,k  ,j+1) +   &
566                              ss12(i+1,k  ,j  ) + ss12(i+1,k  ,j+1) )
567        rr12c(i,k,j) = 0.25*( rr12(i  ,k  ,j  ) + rr12(i  ,k  ,j+1) +   &
568                              rr12(i+1,k  ,j  ) + rr12(i+1,k  ,j+1) )
569        ss13c(i,k,j) = 0.25*( ss13(i  ,k+1,j  ) + ss13(i  ,k  ,j  ) +   &
570                              ss13(i+1,k+1,j  ) + ss13(i+1,k  ,j  ) )
571        rr13c(i,k,j) = 0.25*( rr13(i  ,k+1,j  ) + rr13(i  ,k  ,j  ) +   &
572                              rr13(i+1,k+1,j  ) + rr13(i+1,k  ,j  ) )
573        ss23c(i,k,j) = 0.25*( ss23(i  ,k+1,j  ) + ss23(i  ,k  ,j  ) +   &
574                              ss23(i  ,k+1,j+1) + ss23(i  ,k  ,j+1) )
575        rr23c(i,k,j) = 0.25*( rr23(i  ,k+1,j  ) + rr23(i  ,k  ,j  ) +   &
576                              rr23(i  ,k+1,j+1) + rr23(i  ,k  ,j+1) )
577      ENDDO
578      ENDDO
580      ENDDO
582 !LPB[16]
584 !!LPB[17]
585 !  IF ( config_flags%sfs_opt .EQ. 1 ) THEN
587 !       DO j=j_start,j_end
588 !       DO k=kts,ktf
589 !       DO i=i_start,i_end
590 !         delta = ( dx * dy / rdzw(i,k,j) )**0.33333333
591 !         a = -1.0*( cs*delta )**2
592 !         m11(i,k,j) = a*(   2.0*sqrt( 2.0*smnsmn(i,k,j) )*ss11(i,k,j)   &
593 !                          + c1*(   ss11(i,k,j) *ss11(i,k,j)             &
594 !                                 + ss12c(i,k,j)*ss12c(i,k,j)            &
595 !                                 + ss13c(i,k,j)*ss13c(i,k,j)            &
596 !                                 - smnsmn(i,k,j)/3.0                    &
597 !                               )                                        &
598 !                          + c2*( -2.0*(   ss12c(i,k,j)*rr12c(i,k,j)     &
599 !                                        + ss13c(i,k,j)*rr13c(i,k,j)     &
600 !                                      )                                 &
601 !                               )                                        &
602 !                        )
603 !         m22(i,k,j) = a*(   2.0*sqrt( 2.0*smnsmn(i,k,j) )*ss22(i,k,j)   &
604 !                          + c1*(   ss22(i,k,j) *ss22(i,k,j)             &
605 !                                 + ss12c(i,k,j)*ss12c(i,k,j)            &
606 !                                 + ss23c(i,k,j)*ss23c(i,k,j)            &
607 !                                 - smnsmn(i,k,j)/3.0                    &
608 !                               )                                        &
609 !                          + c2*(  2.0*(   ss12c(i,k,j)*rr12c(i,k,j)     &
610 !                                        - ss23c(i,k,j)*rr23c(i,k,j)     &
611 !                                      )                                 &
612 !                               )                                        &
613 !                        )
614 !         m33(i,k,j) = a*(   2.0*sqrt( 2.0*smnsmn(i,k,j) )*ss33(i,k,j)   &
615 !                          + c1*(   ss33(i,k,j) *ss33(i,k,j)              &
616 !                                 + ss13c(i,k,j)*ss13c(i,k,j)            &
617 !                                 + ss23c(i,k,j)*ss23c(i,k,j)            &
618 !                                 - smnsmn(i,k,j)/3.0                    &
619 !                               )                                        &
620 !                          + c2*(  2.0*(   ss13c(i,k,j)*rr13c(i,k,j)     &
621 !                                        + ss23c(i,k,j)*rr23c(i,k,j)     &
622 !                                      )                                 &
623 !                               )                                        &
624 !                        )
625 !       ENDDO
626 !       ENDDO
627 !       ENDDO
628 !     ELSE
630 !       DO j=j_start,j_end
631 !       DO k=kts,ktf
632 !       DO i=i_start,i_end
633 !         delta = ( dx * dy / rdzw(i,k,j) )**0.33333333
634 !         a = -1.0*ce*delta
635 !         b = c3*delta
636 !         m11(i,k,j) = a*(   2.0*sqrt( tke(i,k,j) )*ss11(i,k,j)              &
637 !                          + b*(                                             &
638 !                                  c1*(   ss11(i,k,j) *ss11(i,k,j)           &
639 !                                       + ss12c(i,k,j)*ss12c(i,k,j)          &
640 !                                       + ss13c(i,k,j)*ss13c(i,k,j)          &
641 !                                       - smnsmn(i,k,j)/3.0                  &
642 !                                             )                              &
643 !                                + c2*( -2.0*(   ss12c(i,k,j)*rr12c(i,k,j)   &
644 !                                              + ss13c(i,k,j)*rr13c(i,k,j)   &
645 !                                            )                               &
646 !                                     )                                      &
647 !                              )                                             &
648 !                        )
649 !         m22(i,k,j) = a*(   2.0*sqrt( tke(i,k,j) )*ss22(i,k,j)              &
650 !                          + b*(                                             &
651 !                                  c1*(   ss22(i,k,j) *ss22(i,k,j)           &
652 !                                       + ss12c(i,k,j)*ss12c(i,k,j)          &
653 !                                       + ss23c(i,k,j)*ss23c(i,k,j)          &
654 !                                       - smnsmn(i,k,j)/3.0                  &
655 !                                               )                            &
656 !                                + c2*(  2.0*(   ss12c(i,k,j)*rr12c(i,k,j)   &
657 !                                              - ss23c(i,k,j)*rr23c(i,k,j)   &
658 !                                            )                               &
659 !                                     )                                      &
660 !                              )                                             &
661 !                        )
662 !         m33(i,k,j) = a*(   2.0*sqrt( tke(i,k,j) )*ss33(i,k,j)              &
663 !                          + b*(                                             &
664 !                                  c1*(   ss33(i,k,j) *ss33(i,k,j)           &
665 !                                       + ss13c(i,k,j)*ss13c(i,k,j)          &
666 !                                       + ss23c(i,k,j)*ss23c(i,k,j)          &
667 !                                       - smnsmn(i,k,j)/3.0                  &
668 !                                     )                                      &
669 !                                + c2*(  2.0*(   ss13c(i,k,j)*rr13c(i,k,j)   &
670 !                                              + ss23c(i,k,j)*rr23c(i,k,j)   &
671 !                                            )                               &
672 !                                     )                                      &
673 !                              )                                             &
674 !                        )
675 !       ENDDO
676 !       ENDDO
677 !       ENDDO
679 !   ENDIF
681 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
683    Do K2_ADJ =jts-1, jte+1
684    Do K1_ADJ =kms, kme
685    Do K0_ADJ =its-1, ite+1
686    a_ss11(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
687    End Do
688    End Do
689    End Do
691    Do K2_ADJ =jts-1, jte+1
692    Do K1_ADJ =kms, kme
693    Do K0_ADJ =its-1, ite+1
694    a_ss22(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
695    End Do
696    End Do
697    End Do
699    Do K2_ADJ =jts-1, jte+1
700    Do K1_ADJ =kms, kme
701    Do K0_ADJ =its-1, ite+1
702    a_ss33(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
703    End Do
704    End Do
705    End Do
707    Do K2_ADJ =jts-1, jte+1
708    Do K1_ADJ =kms, kme
709    Do K0_ADJ =its-1, ite+1
710    a_ss12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
711    End Do
712    End Do
713    End Do
715    Do K2_ADJ =jts-1, jte+1
716    Do K1_ADJ =kms, kme
717    Do K0_ADJ =its-1, ite+1
718    a_ss13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
719    End Do
720    End Do
721    End Do
723    Do K2_ADJ =jts-1, jte+1
724    Do K1_ADJ =kms, kme
725    Do K0_ADJ =its-1, ite+1
726    a_ss23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
727    End Do
728    End Do
729    End Do
731    Do K2_ADJ =jts-1, jte+1
732    Do K1_ADJ =kms, kme
733    Do K0_ADJ =its-1, ite+1
734    a_rr12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
735    End Do
736    End Do
737    End Do
739    Do K2_ADJ =jts-1, jte+1
740    Do K1_ADJ =kms, kme
741    Do K0_ADJ =its-1, ite+1
742    a_rr13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
743    End Do
744    End Do
745    End Do
747    Do K2_ADJ =jts-1, jte+1
748    Do K1_ADJ =kms, kme
749    Do K0_ADJ =its-1, ite+1
750    a_rr23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
751    End Do
752    End Do
753    End Do
755    Do K2_ADJ =jts-1, jte+1
756    Do K1_ADJ =kms, kme
757    Do K0_ADJ =its-1, ite+1
758    a_ss12c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
759    End Do
760    End Do
761    End Do
763    Do K2_ADJ =jts-1, jte+1
764    Do K1_ADJ =kms, kme
765    Do K0_ADJ =its-1, ite+1
766    a_rr12c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
767    End Do
768    End Do
769    End Do
771    Do K2_ADJ =jts-1, jte+1
772    Do K1_ADJ =kms, kme
773    Do K0_ADJ =its-1, ite+1
774    a_ss13c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
775    End Do
776    End Do
777    End Do
779    Do K2_ADJ =jts-1, jte+1
780    Do K1_ADJ =kms, kme
781    Do K0_ADJ =its-1, ite+1
782    a_rr13c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
783    End Do
784    End Do
785    End Do
787    Do K2_ADJ =jts-1, jte+1
788    Do K1_ADJ =kms, kme
789    Do K0_ADJ =its-1, ite+1
790    a_ss23c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
791    End Do
792    End Do
793    End Do
795    Do K2_ADJ =jts-1, jte+1
796    Do K1_ADJ =kms, kme
797    Do K0_ADJ =its-1, ite+1
798    a_rr23c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
799    End Do
800    End Do
801    End Do
803    a_delta =0.0
804    a_a =0.0
805    a_b =0.0
807 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
809 !LPB[17]
811    IF( config_flags%sfs_opt .EQ. 1 ) THEN
812    DO j =j_start, j_end
813    DO k =kts, ktf
814    DO i =i_start, i_end
815    delta =(dx*dy/rdzw(i,k,j))**0.33333333
817    a =-1.0*(cs*delta)**2
818    Tmpv400(i,k,j) =a
820    Tmpv001 =2.0*sqrt(2.0*smnsmn(i,k,j))*ss11(i,k,j)
821    Tmpv002 =ss11(i,k,j)*ss11(i,k,j) +ss12c(i,k,j)*ss12c(i,k,j)
822    Tmpv003 =Tmpv002 +ss13c(i,k,j)*ss13c(i,k,j)
823    Tmpv004 =Tmpv003 -smnsmn(i,k,j)/3.0
824    Tmpv005 =c1*Tmpv004
825    Tmpv006 =Tmpv001 +Tmpv005
826    Tmpv007 =ss12c(i,k,j)*rr12c(i,k,j)
827    Tmpv008 =ss13c(i,k,j)*rr13c(i,k,j)
828    Tmpv009 =Tmpv007 +Tmpv008
829    Tmpv010 =-2.0*Tmpv009
830    Tmpv011 =c2*Tmpv010
831    Tmpv012 =Tmpv006 +Tmpv011
832    Tmpv401(i,k,j) =Tmpv012
833    Tmpv013 =a*Tmpv401(i,k,j)
834    m11(i,k,j) =Tmpv013
836    Tmpv001 =2.0*sqrt(2.0*smnsmn(i,k,j))*ss22(i,k,j)
837    Tmpv002 =ss22(i,k,j)*ss22(i,k,j) +ss12c(i,k,j)*ss12c(i,k,j)
838    Tmpv003 =Tmpv002 +ss23c(i,k,j)*ss23c(i,k,j)
839    Tmpv004 =Tmpv003 -smnsmn(i,k,j)/3.0
840    Tmpv005 =c1*Tmpv004
841    Tmpv006 =Tmpv001 +Tmpv005
842    Tmpv007 =ss12c(i,k,j)*rr12c(i,k,j)
843    Tmpv008 =ss23c(i,k,j)*rr23c(i,k,j)
844    Tmpv009 =Tmpv007 -Tmpv008
845    Tmpv010 =2.0*Tmpv009
846    Tmpv011 =c2*Tmpv010
847    Tmpv012 =Tmpv006 +Tmpv011
848    Tmpv402(i,k,j) =Tmpv012
849    Tmpv013 =a*Tmpv402(i,k,j)
850    m22(i,k,j) =Tmpv013
852    Tmpv001 =2.0*sqrt(2.0*smnsmn(i,k,j))*ss33(i,k,j)
853    Tmpv002 =ss33(i,k,j)*ss33(i,k,j) +ss13c(i,k,j)*ss13c(i,k,j)
854    Tmpv003 =Tmpv002 +ss23c(i,k,j)*ss23c(i,k,j)
855    Tmpv004 =Tmpv003 -smnsmn(i,k,j)/3.0
856    Tmpv005 =c1*Tmpv004
857    Tmpv006 =Tmpv001 +Tmpv005
858    Tmpv007 =ss13c(i,k,j)*rr13c(i,k,j)
859    Tmpv008 =ss23c(i,k,j)*rr23c(i,k,j)
860    Tmpv009 =Tmpv007 +Tmpv008
861    Tmpv010 =2.0*Tmpv009
862    Tmpv011 =c2*Tmpv010
863    Tmpv012 =Tmpv006 +Tmpv011
864    Tmpv403(i,k,j) =Tmpv012
865    Tmpv013 =a*Tmpv403(i,k,j)
866    m33(i,k,j) =Tmpv013
868    ENDDO
869    ENDDO
870    ENDDO
871    ELSE
872    DO j =j_start, j_end
873    DO k =kts, ktf
874    DO i =i_start, i_end
875    delta =(dx*dy/rdzw(i,k,j))**0.33333333
877    a =-1.0*ce*delta
878    Tmpv404(i,k,j) =a
880    b =c3*delta
881    Tmpv405(i,k,j) =b
883    Tmpv001 =2.0*sqrt(tke(i,k,j))*ss11(i,k,j)
884    Tmpv002 =ss11(i,k,j)*ss11(i,k,j) +ss12c(i,k,j)*ss12c(i,k,j)
885    Tmpv003 =Tmpv002 +ss13c(i,k,j)*ss13c(i,k,j)
886    Tmpv004 =Tmpv003 -smnsmn(i,k,j)/3.0
887    Tmpv005 =c1*Tmpv004
888    Tmpv006 =ss12c(i,k,j)*rr12c(i,k,j)
889    Tmpv007 =ss13c(i,k,j)*rr13c(i,k,j)
890    Tmpv008 =Tmpv006 +Tmpv007
891    Tmpv009 =-2.0*Tmpv008
892    Tmpv010 =c2*Tmpv009
893    Tmpv011 =Tmpv005 +Tmpv010
894    Tmpv406(i,k,j) =Tmpv011
895    Tmpv012 =b*Tmpv406(i,k,j)
896    Tmpv013 =Tmpv001 +Tmpv012
897    Tmpv407(i,k,j) =Tmpv013
898    Tmpv014 =a*Tmpv407(i,k,j)
899    m11(i,k,j) =Tmpv014
901    Tmpv001 =2.0*sqrt(tke(i,k,j))*ss22(i,k,j)
902    Tmpv002 =ss22(i,k,j)*ss22(i,k,j) +ss12c(i,k,j)*ss12c(i,k,j)
903    Tmpv003 =Tmpv002 +ss23c(i,k,j)*ss23c(i,k,j)
904    Tmpv004 =Tmpv003 -smnsmn(i,k,j)/3.0
905    Tmpv005 =c1*Tmpv004
906    Tmpv006 =ss12c(i,k,j)*rr12c(i,k,j)
907    Tmpv007 =ss23c(i,k,j)*rr23c(i,k,j)
908    Tmpv008 =Tmpv006 -Tmpv007
909    Tmpv009 =2.0*Tmpv008
910    Tmpv010 =c2*Tmpv009
911    Tmpv011 =Tmpv005 +Tmpv010
912    Tmpv408(i,k,j) =Tmpv011
913    Tmpv012 =b*Tmpv408(i,k,j)
914    Tmpv013 =Tmpv001 +Tmpv012
915    Tmpv409(i,k,j) =Tmpv013
916    Tmpv014 =a*Tmpv409(i,k,j)
917    m22(i,k,j) =Tmpv014
919    Tmpv001 =2.0*sqrt(tke(i,k,j))*ss33(i,k,j)
920    Tmpv002 =ss33(i,k,j)*ss33(i,k,j) +ss13c(i,k,j)*ss13c(i,k,j)
921    Tmpv003 =Tmpv002 +ss23c(i,k,j)*ss23c(i,k,j)
922    Tmpv004 =Tmpv003 -smnsmn(i,k,j)/3.0
923    Tmpv005 =c1*Tmpv004
924    Tmpv006 =ss13c(i,k,j)*rr13c(i,k,j)
925    Tmpv007 =ss23c(i,k,j)*rr23c(i,k,j)
926    Tmpv008 =Tmpv006 +Tmpv007
927    Tmpv009 =2.0*Tmpv008
928    Tmpv010 =c2*Tmpv009
929    Tmpv011 =Tmpv005 +Tmpv010
930    Tmpv4010(i,k,j) =Tmpv011
931    Tmpv012 =b*Tmpv4010(i,k,j)
932    Tmpv013 =Tmpv001 +Tmpv012
933    Tmpv4011(i,k,j) =Tmpv013
934    Tmpv014 =a*Tmpv4011(i,k,j)
935    m33(i,k,j) =Tmpv014
937    ENDDO
938    ENDDO
939    ENDDO
940    ENDIF
942    IF( config_flags%sfs_opt .EQ. 1 ) THEN
944    DO j =j_end, j_start, -1
945    DO k =ktf, kts, -1
946    DO i =i_end, i_start, -1
947    delta =(dx*dy/rdzw(i,k,j))**0.33333333
948    a =Tmpv400(i,k,j)
950    a_Tmpv13 =a_m33(i,k,j)
951    a_m33(i,k,j) =0.0
952    a_a =a_a +Tmpv403(i,k,j)*a_Tmpv13
953    a_Tmpv12 =a*a_Tmpv13
954    a_Tmpv6 =a_Tmpv12
955    a_Tmpv11 =a_Tmpv12
956    a_Tmpv10 =c2*a_Tmpv11
957    a_Tmpv9 =2.0*a_Tmpv10
958    a_Tmpv7 =a_Tmpv9
959    a_Tmpv8 =a_Tmpv9
960    a_ss23c(i,k,j) =a_ss23c(i,k,j) +rr23c(i,k,j)*a_Tmpv8
961    a_rr23c(i,k,j) =a_rr23c(i,k,j) +ss23c(i,k,j)*a_Tmpv8
962    a_ss13c(i,k,j) =a_ss13c(i,k,j) +rr13c(i,k,j)*a_Tmpv7
963    a_rr13c(i,k,j) =a_rr13c(i,k,j) +ss13c(i,k,j)*a_Tmpv7
964    a_Tmpv1 =a_Tmpv6
965    a_Tmpv5 =a_Tmpv6
966    a_Tmpv4 =c1*a_Tmpv5
967    a_Tmpv3 =a_Tmpv4
968    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4
969    a_Tmpv2 =a_Tmpv3
970    a_ss23c(i,k,j) =a_ss23c(i,k,j) +2.0*ss23c(i,k,j)*a_Tmpv3
971    a_ss33(i,k,j) =a_ss33(i,k,j) +2.0*ss33(i,k,j)*a_Tmpv2
972    a_ss13c(i,k,j) =a_ss13c(i,k,j) +2.0*ss13c(i,k,j)*a_Tmpv2
973    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +2.0*g_Sqrt(2.0, 2.0*smnsmn(i,k,j))  &
974    *ss33(i,k,j)*a_Tmpv1
975    a_ss33(i,k,j) =a_ss33(i,k,j) +2.0*sqrt(2.0*smnsmn(i,k,j))*a_Tmpv1
976    a_Tmpv13 =a_m22(i,k,j)
977    a_m22(i,k,j) =0.0
978    a_a =a_a +Tmpv402(i,k,j)*a_Tmpv13
979    a_Tmpv12 =a*a_Tmpv13
980    a_Tmpv6 =a_Tmpv12
981    a_Tmpv11 =a_Tmpv12
982    a_Tmpv10 =c2*a_Tmpv11
983    a_Tmpv9 =2.0*a_Tmpv10
984    a_Tmpv7 =a_Tmpv9
985    a_Tmpv8 =-a_Tmpv9
986    a_ss23c(i,k,j) =a_ss23c(i,k,j) +rr23c(i,k,j)*a_Tmpv8
987    a_rr23c(i,k,j) =a_rr23c(i,k,j) +ss23c(i,k,j)*a_Tmpv8
988    a_ss12c(i,k,j) =a_ss12c(i,k,j) +rr12c(i,k,j)*a_Tmpv7
989    a_rr12c(i,k,j) =a_rr12c(i,k,j) +ss12c(i,k,j)*a_Tmpv7
990    a_Tmpv1 =a_Tmpv6
991    a_Tmpv5 =a_Tmpv6
992    a_Tmpv4 =c1*a_Tmpv5
993    a_Tmpv3 =a_Tmpv4
994    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4
995    a_Tmpv2 =a_Tmpv3
996    a_ss23c(i,k,j) =a_ss23c(i,k,j) +2.0*ss23c(i,k,j)*a_Tmpv3
997    a_ss22(i,k,j) =a_ss22(i,k,j) +2.0*ss22(i,k,j)*a_Tmpv2
998    a_ss12c(i,k,j) =a_ss12c(i,k,j) +2.0*ss12c(i,k,j)*a_Tmpv2
999    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +2.0*g_Sqrt(2.0, 2.0*smnsmn(i,k,j))  &
1000    *ss22(i,k,j)*a_Tmpv1
1001    a_ss22(i,k,j) =a_ss22(i,k,j) +2.0*sqrt(2.0*smnsmn(i,k,j))*a_Tmpv1
1002    a_Tmpv13 =a_m11(i,k,j)
1003    a_m11(i,k,j) =0.0
1004    a_a =a_a +Tmpv401(i,k,j)*a_Tmpv13
1005    a_Tmpv12 =a*a_Tmpv13
1006    a_Tmpv6 =a_Tmpv12
1007    a_Tmpv11 =a_Tmpv12
1008    a_Tmpv10 =c2*a_Tmpv11
1009    a_Tmpv9 =-2.0*a_Tmpv10
1010    a_Tmpv7 =a_Tmpv9
1011    a_Tmpv8 =a_Tmpv9
1012    a_ss13c(i,k,j) =a_ss13c(i,k,j) +rr13c(i,k,j)*a_Tmpv8
1013    a_rr13c(i,k,j) =a_rr13c(i,k,j) +ss13c(i,k,j)*a_Tmpv8
1014    a_ss12c(i,k,j) =a_ss12c(i,k,j) +rr12c(i,k,j)*a_Tmpv7
1015    a_rr12c(i,k,j) =a_rr12c(i,k,j) +ss12c(i,k,j)*a_Tmpv7
1016    a_Tmpv1 =a_Tmpv6
1017    a_Tmpv5 =a_Tmpv6
1018    a_Tmpv4 =c1*a_Tmpv5
1019    a_Tmpv3 =a_Tmpv4
1020    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4
1021    a_Tmpv2 =a_Tmpv3
1022    a_ss13c(i,k,j) =a_ss13c(i,k,j) +2.0*ss13c(i,k,j)*a_Tmpv3
1023    a_ss11(i,k,j) =a_ss11(i,k,j) +2.0*ss11(i,k,j)*a_Tmpv2
1024    a_ss12c(i,k,j) =a_ss12c(i,k,j) +2.0*ss12c(i,k,j)*a_Tmpv2
1025    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +2.0*g_Sqrt(2.0, 2.0*smnsmn(i,k,j))  &
1026    *ss11(i,k,j)*a_Tmpv1
1027    a_ss11(i,k,j) =a_ss11(i,k,j) +2.0*sqrt(2.0*smnsmn(i,k,j))*a_Tmpv1
1029 !  a =Tmpv400(i,k,j)
1031    a_delta =a_delta -1.0*2.0*(cs*delta)*cs*a_a
1032    a_a =0.0
1033    a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx*  &
1034    dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta
1035    a_delta =0.0
1036    ENDDO
1037    ENDDO
1038    ENDDO
1040    ELSE
1042    DO j =j_end, j_start, -1
1043    DO k =ktf, kts, -1
1044    DO i =i_end, i_start, -1
1045    a =Tmpv404(i,k,j)
1046    b =Tmpv405(i,k,j)
1048    a_Tmpv14 =a_m33(i,k,j)
1049    a_m33(i,k,j) =0.0
1050    a_a =a_a +Tmpv4011(i,k,j)*a_Tmpv14
1051    a_Tmpv13 =a*a_Tmpv14
1052    a_Tmpv1 =a_Tmpv13
1053    a_Tmpv12 =a_Tmpv13
1054    a_b =a_b +Tmpv4010(i,k,j)*a_Tmpv12
1055    a_Tmpv11 =b*a_Tmpv12
1056    a_Tmpv5 =a_Tmpv11
1057    a_Tmpv10 =a_Tmpv11
1058    a_Tmpv9 =c2*a_Tmpv10
1059    a_Tmpv8 =2.0*a_Tmpv9
1060    a_Tmpv6 =a_Tmpv8
1061    a_Tmpv7 =a_Tmpv8
1062    a_ss23c(i,k,j) =a_ss23c(i,k,j) +rr23c(i,k,j)*a_Tmpv7
1063    a_rr23c(i,k,j) =a_rr23c(i,k,j) +ss23c(i,k,j)*a_Tmpv7
1064    a_ss13c(i,k,j) =a_ss13c(i,k,j) +rr13c(i,k,j)*a_Tmpv6
1065    a_rr13c(i,k,j) =a_rr13c(i,k,j) +ss13c(i,k,j)*a_Tmpv6
1066    a_Tmpv4 =c1*a_Tmpv5
1067    a_Tmpv3 =a_Tmpv4
1068    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4
1069    a_Tmpv2 =a_Tmpv3
1070    a_ss23c(i,k,j) =a_ss23c(i,k,j) +2.0*ss23c(i,k,j)*a_Tmpv3
1071    a_ss33(i,k,j) =a_ss33(i,k,j) +2.0*ss33(i,k,j)*a_Tmpv2
1072    a_ss13c(i,k,j) =a_ss13c(i,k,j) +2.0*ss13c(i,k,j)*a_Tmpv2
1073    a_tke(i,k,j) =a_tke(i,k,j) +2.0*g_Sqrt(1.0, tke(i,k,j))*ss33(i,k,j)*a_Tmpv1
1074    a_ss33(i,k,j) =a_ss33(i,k,j) +2.0*sqrt(tke(i,k,j))*a_Tmpv1
1075    a_Tmpv14 =a_m22(i,k,j)
1076    a_m22(i,k,j) =0.0
1077    a_a =a_a +Tmpv409(i,k,j)*a_Tmpv14
1078    a_Tmpv13 =a*a_Tmpv14
1079    a_Tmpv1 =a_Tmpv13
1080    a_Tmpv12 =a_Tmpv13
1081    a_b =a_b +Tmpv408(i,k,j)*a_Tmpv12
1082    a_Tmpv11 =b*a_Tmpv12
1083    a_Tmpv5 =a_Tmpv11
1084    a_Tmpv10 =a_Tmpv11
1085    a_Tmpv9 =c2*a_Tmpv10
1086    a_Tmpv8 =2.0*a_Tmpv9
1087    a_Tmpv6 =a_Tmpv8
1088    a_Tmpv7 =-a_Tmpv8
1089    a_ss23c(i,k,j) =a_ss23c(i,k,j) +rr23c(i,k,j)*a_Tmpv7
1090    a_rr23c(i,k,j) =a_rr23c(i,k,j) +ss23c(i,k,j)*a_Tmpv7
1091    a_ss12c(i,k,j) =a_ss12c(i,k,j) +rr12c(i,k,j)*a_Tmpv6
1092    a_rr12c(i,k,j) =a_rr12c(i,k,j) +ss12c(i,k,j)*a_Tmpv6
1093    a_Tmpv4 =c1*a_Tmpv5
1094    a_Tmpv3 =a_Tmpv4
1095    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4
1096    a_Tmpv2 =a_Tmpv3
1097    a_ss23c(i,k,j) =a_ss23c(i,k,j) +2.0*ss23c(i,k,j)*a_Tmpv3
1098    a_ss22(i,k,j) =a_ss22(i,k,j) +2.0*ss22(i,k,j)*a_Tmpv2
1099    a_ss12c(i,k,j) =a_ss12c(i,k,j) +2.0*ss12c(i,k,j)*a_Tmpv2
1100    a_tke(i,k,j) =a_tke(i,k,j) +2.0*g_Sqrt(1.0, tke(i,k,j))*ss22(i,k,j)*a_Tmpv1
1101    a_ss22(i,k,j) =a_ss22(i,k,j) +2.0*sqrt(tke(i,k,j))*a_Tmpv1
1102    a_Tmpv14 =a_m11(i,k,j)
1103    a_m11(i,k,j) =0.0
1104    a_a =a_a +Tmpv407(i,k,j)*a_Tmpv14
1105    a_Tmpv13 =a*a_Tmpv14
1106    a_Tmpv1 =a_Tmpv13
1107    a_Tmpv12 =a_Tmpv13
1108    a_b =a_b +Tmpv406(i,k,j)*a_Tmpv12
1109    a_Tmpv11 =b*a_Tmpv12
1110    a_Tmpv5 =a_Tmpv11
1111    a_Tmpv10 =a_Tmpv11
1112    a_Tmpv9 =c2*a_Tmpv10
1113    a_Tmpv8 =-2.0*a_Tmpv9
1114    a_Tmpv6 =a_Tmpv8
1115    a_Tmpv7 =a_Tmpv8
1116    a_ss13c(i,k,j) =a_ss13c(i,k,j) +rr13c(i,k,j)*a_Tmpv7
1117    a_rr13c(i,k,j) =a_rr13c(i,k,j) +ss13c(i,k,j)*a_Tmpv7
1118    a_ss12c(i,k,j) =a_ss12c(i,k,j) +rr12c(i,k,j)*a_Tmpv6
1119    a_rr12c(i,k,j) =a_rr12c(i,k,j) +ss12c(i,k,j)*a_Tmpv6
1120    a_Tmpv4 =c1*a_Tmpv5
1121    a_Tmpv3 =a_Tmpv4
1122    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4
1123    a_Tmpv2 =a_Tmpv3
1124    a_ss13c(i,k,j) =a_ss13c(i,k,j) +2.0*ss13c(i,k,j)*a_Tmpv3
1125    a_ss11(i,k,j) =a_ss11(i,k,j) +2.0*ss11(i,k,j)*a_Tmpv2
1126    a_ss12c(i,k,j) =a_ss12c(i,k,j) +2.0*ss12c(i,k,j)*a_Tmpv2
1127    a_tke(i,k,j) =a_tke(i,k,j) +2.0*g_Sqrt(1.0, tke(i,k,j))*ss11(i,k,j)*a_Tmpv1
1128    a_ss11(i,k,j) =a_ss11(i,k,j) +2.0*sqrt(tke(i,k,j))*a_Tmpv1
1130    a_delta =a_delta +c3*a_b
1131    a_b =0.0
1133    a_delta =a_delta -1.0*ce*a_a
1134    a_a =0.0
1135    a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx*  &
1136    dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta
1137    a_delta =0.0
1138    ENDDO
1139    ENDDO
1140    ENDDO
1142    ENDIF
1144 !LPB[16]
1146 !LPB[15]
1147    DO j =j_end, j_start, -1
1149 !  DO k =kts, ktf
1150 !  DO i =i_start, i_end
1151 !  Tmpv001 =ss12(i,k,j) +ss12(i,k,j+1)
1152 !  Tmpv002 =Tmpv001 +ss12(i+1,k,j)
1153 !  Tmpv003 =Tmpv002 +ss12(i+1,k,j+1)
1154 !  Tmpv004 =0.25*Tmpv003
1155 !  ss12c(i,k,j) =Tmpv004
1157 !  Tmpv001 =rr12(i,k,j) +rr12(i,k,j+1)
1158 !  Tmpv002 =Tmpv001 +rr12(i+1,k,j)
1159 !  Tmpv003 =Tmpv002 +rr12(i+1,k,j+1)
1160 !  Tmpv004 =0.25*Tmpv003
1161 !  rr12c(i,k,j) =Tmpv004
1163 !  Tmpv001 =ss13(i,k+1,j) +ss13(i,k,j)
1164 !  Tmpv002 =Tmpv001 +ss13(i+1,k+1,j)
1165 !  Tmpv003 =Tmpv002 +ss13(i+1,k,j)
1166 !  Tmpv004 =0.25*Tmpv003
1167 !  ss13c(i,k,j) =Tmpv004
1169 !  Tmpv001 =rr13(i,k+1,j) +rr13(i,k,j)
1170 !  Tmpv002 =Tmpv001 +rr13(i+1,k+1,j)
1171 !  Tmpv003 =Tmpv002 +rr13(i+1,k,j)
1172 !  Tmpv004 =0.25*Tmpv003
1173 !  rr13c(i,k,j) =Tmpv004
1175 !  Tmpv001 =ss23(i,k+1,j) +ss23(i,k,j)
1176 !  Tmpv002 =Tmpv001 +ss23(i,k+1,j+1)
1177 !  Tmpv003 =Tmpv002 +ss23(i,k,j+1)
1178 !  Tmpv004 =0.25*Tmpv003
1179 !  ss23c(i,k,j) =Tmpv004
1181 !  Tmpv001 =rr23(i,k+1,j) +rr23(i,k,j)
1182 !  Tmpv002 =Tmpv001 +rr23(i,k+1,j+1)
1183 !  Tmpv003 =Tmpv002 +rr23(i,k,j+1)
1184 !  Tmpv004 =0.25*Tmpv003
1185 !  rr23c(i,k,j) =Tmpv004
1187 !  ENDDO
1188 !  ENDDO
1190    DO k =ktf, kts, -1
1191    DO i =i_end, i_start, -1
1192    a_Tmpv4 =a_rr23c(i,k,j)
1193    a_rr23c(i,k,j) =0.0
1194    a_Tmpv3 =0.25*a_Tmpv4
1195    a_Tmpv2 =a_Tmpv3
1196    a_rr23(i,k,j+1) =a_rr23(i,k,j+1) +a_Tmpv3
1197    a_Tmpv1 =a_Tmpv2
1198    a_rr23(i,k+1,j+1) =a_rr23(i,k+1,j+1) +a_Tmpv2
1199    a_rr23(i,k+1,j) =a_rr23(i,k+1,j) +a_Tmpv1
1200    a_rr23(i,k,j) =a_rr23(i,k,j) +a_Tmpv1
1201    a_Tmpv4 =a_ss23c(i,k,j)
1202    a_ss23c(i,k,j) =0.0
1203    a_Tmpv3 =0.25*a_Tmpv4
1204    a_Tmpv2 =a_Tmpv3
1205    a_ss23(i,k,j+1) =a_ss23(i,k,j+1) +a_Tmpv3
1206    a_Tmpv1 =a_Tmpv2
1207    a_ss23(i,k+1,j+1) =a_ss23(i,k+1,j+1) +a_Tmpv2
1208    a_ss23(i,k+1,j) =a_ss23(i,k+1,j) +a_Tmpv1
1209    a_ss23(i,k,j) =a_ss23(i,k,j) +a_Tmpv1
1210    a_Tmpv4 =a_rr13c(i,k,j)
1211    a_rr13c(i,k,j) =0.0
1212    a_Tmpv3 =0.25*a_Tmpv4
1213    a_Tmpv2 =a_Tmpv3
1214    a_rr13(i+1,k,j) =a_rr13(i+1,k,j) +a_Tmpv3
1215    a_Tmpv1 =a_Tmpv2
1216    a_rr13(i+1,k+1,j) =a_rr13(i+1,k+1,j) +a_Tmpv2
1217    a_rr13(i,k+1,j) =a_rr13(i,k+1,j) +a_Tmpv1
1218    a_rr13(i,k,j) =a_rr13(i,k,j) +a_Tmpv1
1219    a_Tmpv4 =a_ss13c(i,k,j)
1220    a_ss13c(i,k,j) =0.0
1221    a_Tmpv3 =0.25*a_Tmpv4
1222    a_Tmpv2 =a_Tmpv3
1223    a_ss13(i+1,k,j) =a_ss13(i+1,k,j) +a_Tmpv3
1224    a_Tmpv1 =a_Tmpv2
1225    a_ss13(i+1,k+1,j) =a_ss13(i+1,k+1,j) +a_Tmpv2
1226    a_ss13(i,k+1,j) =a_ss13(i,k+1,j) +a_Tmpv1
1227    a_ss13(i,k,j) =a_ss13(i,k,j) +a_Tmpv1
1228    a_Tmpv4 =a_rr12c(i,k,j)
1229    a_rr12c(i,k,j) =0.0
1230    a_Tmpv3 =0.25*a_Tmpv4
1231    a_Tmpv2 =a_Tmpv3
1232    a_rr12(i+1,k,j+1) =a_rr12(i+1,k,j+1) +a_Tmpv3
1233    a_Tmpv1 =a_Tmpv2
1234    a_rr12(i+1,k,j) =a_rr12(i+1,k,j) +a_Tmpv2
1235    a_rr12(i,k,j) =a_rr12(i,k,j) +a_Tmpv1
1236    a_rr12(i,k,j+1) =a_rr12(i,k,j+1) +a_Tmpv1
1237    a_Tmpv4 =a_ss12c(i,k,j)
1238    a_ss12c(i,k,j) =0.0
1239    a_Tmpv3 =0.25*a_Tmpv4
1240    a_Tmpv2 =a_Tmpv3
1241    a_ss12(i+1,k,j+1) =a_ss12(i+1,k,j+1) +a_Tmpv3
1242    a_Tmpv1 =a_Tmpv2
1243    a_ss12(i+1,k,j) =a_ss12(i+1,k,j) +a_Tmpv2
1244    a_ss12(i,k,j) =a_ss12(i,k,j) +a_Tmpv1
1245    a_ss12(i,k,j+1) =a_ss12(i,k,j+1) +a_Tmpv1
1246    ENDDO
1247    ENDDO
1249    ENDDO
1251 !LPB[14]
1252    DO j =j_end+1, j_start, -1
1254 !  DO i =i_start, i_end+1
1255 !  ss13(i,kde,j) =0.0
1257 !  ss23(i,kde,j) =0.0
1259 !  rr13(i,kde,j) =0.0
1261 !  rr23(i,kde,j) =0.0
1263 !  ENDDO
1265    DO i =i_end+1, i_start, -1
1266    a_rr23(i,kde,j) =0.0
1267    a_rr13(i,kde,j) =0.0
1268    a_ss23(i,kde,j) =0.0
1269    a_ss13(i,kde,j) =0.0
1270    ENDDO
1272    ENDDO
1274 !LPB[13]
1275    DO j =j_end+1, j_start, -1
1277 !  DO k =kts, ktf
1278 !  DO i =i_start, i_end+1
1279 !  ss11(i,k,j) =s11(i,k,j)/2.0
1281 !  ss22(i,k,j) =s22(i,k,j)/2.0
1283 !  ss33(i,k,j) =s33(i,k,j)/2.0
1285 !  ss12(i,k,j) =s12(i,k,j)/2.0
1287 !  ss13(i,k,j) =s13(i,k,j)/2.0
1289 !  ss23(i,k,j) =s23(i,k,j)/2.0
1291 !  rr12(i,k,j) =r12(i,k,j)/2.0
1293 !  rr13(i,k,j) =r13(i,k,j)/2.0
1295 !  rr23(i,k,j) =r23(i,k,j)/2.0
1297 !  ENDDO
1298 !  ENDDO
1300    DO k =ktf, kts, -1
1301    DO i =i_end+1, i_start, -1
1302    a_r23(i,k,j) =a_r23(i,k,j) +1.0/2.0*a_rr23(i,k,j)
1303    a_rr23(i,k,j) =0.0
1304    a_r13(i,k,j) =a_r13(i,k,j) +1.0/2.0*a_rr13(i,k,j)
1305    a_rr13(i,k,j) =0.0
1306    a_r12(i,k,j) =a_r12(i,k,j) +1.0/2.0*a_rr12(i,k,j)
1307    a_rr12(i,k,j) =0.0
1308    a_s23(i,k,j) =a_s23(i,k,j) +1.0/2.0*a_ss23(i,k,j)
1309    a_ss23(i,k,j) =0.0
1310    a_s13(i,k,j) =a_s13(i,k,j) +1.0/2.0*a_ss13(i,k,j)
1311    a_ss13(i,k,j) =0.0
1312    a_s12(i,k,j) =a_s12(i,k,j) +1.0/2.0*a_ss12(i,k,j)
1313    a_ss12(i,k,j) =0.0
1314    a_s33(i,k,j) =a_s33(i,k,j) +1.0/2.0*a_ss33(i,k,j)
1315    a_ss33(i,k,j) =0.0
1316    a_s22(i,k,j) =a_s22(i,k,j) +1.0/2.0*a_ss22(i,k,j)
1317    a_ss22(i,k,j) =0.0
1318    a_s11(i,k,j) =a_s11(i,k,j) +1.0/2.0*a_ss11(i,k,j)
1319    a_ss11(i,k,j) =0.0
1320    ENDDO
1321    ENDDO
1323    ENDDO
1325 !LPB[12]
1326 !  is_ext =1
1327 !  js_ext =1
1328 !  i_start =i_start-is_ext
1329 !  j_start =j_start-js_ext
1331 !LPB[11]
1333 !  IF( config_flags%periodic_x ) THEN
1334 !  i_end =ite
1335 !  END IF
1337 !  IF( config_flags%periodic_x ) THEN
1339 !  END IF
1341 !LPB[10]
1343 !LPB[9]
1345 !  IF( config_flags%periodic_x ) THEN
1346 !  i_start =its
1347 !  END IF
1349 !  IF( config_flags%periodic_x ) THEN
1351 !  END IF
1353 !LPB[8]
1355 !LPB[7]
1357 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.             config_flags%nested) THEN
1358 !  j_end =min(jde-1, jte)
1359 !  END IF
1361 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
1362 !            config_flags%nested) THEN
1364 !  END IF
1366 !LPB[6]
1368 !LPB[5]
1370 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested) THEN
1371 !  j_start =max(jds+1, jts)
1372 !  END IF
1374 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
1375 !            config_flags%nested) THEN
1377 !  END IF
1379 !LPB[4]
1381 !LPB[3]
1383 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.             config_flags%nested) THEN
1384 !  i_end =min(ide-1, ite)
1385 !  END IF
1387 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
1388 !            config_flags%nested) THEN
1390 !  END IF
1392 !LPB[2]
1394 !LPB[1]
1396 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested) THEN
1397 !  i_start =max(ids+1, its)
1398 !  END IF
1400 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
1401 !            config_flags%nested) THEN
1403 !  END IF
1405 !LPB[0]
1406 !  ktf =min(kte, kde-1)
1407 !  i_start =its
1408 !  i_end =ite
1409 !  j_start =jts
1410 !  j_end =jte
1412    Return
1413         END SUBROUTINE a_calc_mii
1415    SUBROUTINE a_calc_m12(m12,a_m12,s11,a_s11,s22,a_s22,s12,a_s12,s13,a_s13, &
1416    s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23,smnsmn,a_smnsmn,tke,a_tke,rdzw, &
1417    a_rdzw,dx,dy,config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe, &
1418    jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
1420 !PART I: DECLARATION OF VARIABLES
1422    IMPLICIT NONE
1424    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
1425    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: m12,a_m12
1426    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s11,a_s11,s22,a_s22,s12,a_s12,s13, &
1427    a_s13,s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23,smnsmn,a_smnsmn,tke, &
1428    a_tke,rdzw,a_rdzw
1429    REAL :: dx,dy
1430    TYPE(grid_config_rec_type) :: config_flags
1431    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, &
1432    its,ite,jts,jte,kts,kte
1433    REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss11,a_ss11,ss22,a_ss22,ss12, &
1434    a_ss12,ss13,a_ss13,ss23,a_ss23,rr12,a_rr12,rr13,a_rr13,rr23,a_rr23
1435    REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: tked,a_tked,ss11d,a_ss11d, &
1436    ss22d,a_ss22d,ss13d,a_ss13d,ss23d,a_ss23d,rr13d,a_rr13d,rr23d,a_rr23d, &
1437    smnsmnd,a_smnsmnd
1438    REAL :: delta,a_delta,a,a_a,b,a_b
1439    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf,je_ext,ie_ext
1441    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
1442    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9, &
1443    Tmpv009,a_Tmpv10,Tmpv010,a_Tmpv11,Tmpv011,a_Tmpv12,Tmpv012,a_Tmpv13,Tmpv013, &
1444    a_Tmpv14,Tmpv014,a_Tmpv15,Tmpv015,a_Tmpv16,Tmpv016,a_Tmpv17,Tmpv017, &
1445    a_Tmpv18,Tmpv018,a_Tmpv19,Tmpv019
1446    REAL,DIMENSION(its:ite+1,kts:min(kte,kde-1),max(jds+1,jts):jte+1) :: Tmpv400
1447    REAL,DIMENSION(its:ite+1,kts:min(kte,kde-1),max(jds+1,jts):jte+1) :: Tmpv401
1448    REAL,DIMENSION(its:ite+1,kts:min(kte,kde-1),max(jds+1,jts):jte+1) :: Tmpv402
1449    REAL,DIMENSION(its:ite+1,kts:min(kte,kde-1),max(jds+1,jts):jte+1) :: Tmpv403
1450    REAL,DIMENSION(its:ite+1,kts:min(kte,kde-1),max(jds+1,jts):jte+1) :: Tmpv404
1451    REAL,DIMENSION(its:ite+1,kts:min(kte,kde-1),max(jds+1,jts):jte+1) :: Tmpv405
1453    REAL :: g_Sqrt
1455 !PART II: CALCULATIONS OF B. S. TRAJECTORY
1457 !LPB[0]
1459      ktf = MIN( kte, kde-1 )
1460      i_start = its
1461      i_end   = ite
1462      j_start = jts
1463      j_end   = jte
1465 !LPB[1]
1466     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
1467          config_flags%nested ) i_start = MAX( ids+1, its )
1469 !LPB[2]
1471 !LPB[3]
1472     IF ( config_flags%open_xe .OR. config_flags%specified .OR.   &
1473          config_flags%nested ) i_end   = MIN( ide-1, ite )
1475 !LPB[4]
1477 !LPB[5]
1478     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
1479          config_flags%nested ) j_start = MAX( jds+1, jts )
1481 !LPB[6]
1483 !LPB[7]
1484     IF ( config_flags%open_ye .OR. config_flags%specified .OR.   &
1485          config_flags%nested ) j_end   = MIN( jde-1, jte )
1487 !LPB[8]
1489 !LPB[9]
1490       IF ( config_flags%periodic_x ) i_start = its
1492 !LPB[10]
1494 !LPB[11]
1495       IF ( config_flags%periodic_x ) i_end = ite
1497 !LPB[12]
1498      je_ext = 1
1499      ie_ext = 1
1500      i_end = i_end + ie_ext  
1501      j_end = j_end + je_ext   
1503 !LPB[13]
1504      DO j=j_start-1,j_end
1506      DO k=kts,ktf
1507      DO i=i_start-1,i_end
1508        ss11(i,k,j)=s11(i,k,j)/2.0
1509        ss22(i,k,j)=s22(i,k,j)/2.0
1510        ss12(i,k,j)=s12(i,k,j)/2.0
1511        ss13(i,k,j)=s13(i,k,j)/2.0
1512        ss23(i,k,j)=s23(i,k,j)/2.0
1513        rr12(i,k,j)=r12(i,k,j)/2.0
1514        rr13(i,k,j)=r13(i,k,j)/2.0
1515        rr23(i,k,j)=r23(i,k,j)/2.0
1516      END DO
1517      END DO
1519      END DO
1521 !LPB[14]
1522      DO j=j_start-1,j_end
1524      DO i=i_start-1,i_end
1525        ss13(i,kde,j) = 0.0
1526        ss23(i,kde,j) = 0.0
1527        rr13(i,kde,j) = 0.0
1528        rr23(i,kde,j) = 0.0
1529      END DO
1531      END DO
1533 !LPB[15]
1534      DO j = j_start, j_end
1536      DO k = kts, ktf
1537      DO i = i_start, i_end
1538        tked(i,k,j) = 0.25*( tke(i-1,k  ,j  ) + tke(i  ,k  ,j  ) +   &
1539                             tke(i-1,k  ,j-1) + tke(i  ,k  ,j-1) )
1540        smnsmnd(i,k,j) = 0.25*( smnsmn(i-1,k  ,j  ) + smnsmn(i  ,k  ,j  ) +   &
1541                                smnsmn(i-1,k  ,j-1) + smnsmn(i  ,k  ,j-1) )
1542        ss11d(i,k,j) = 0.25*( ss11(i-1,k  ,j  ) + ss11(i  ,k  ,j  ) +   &
1543                              ss11(i-1,k  ,j-1) + ss11(i  ,k  ,j-1) )
1544        ss22d(i,k,j) = 0.25*( ss22(i-1,k  ,j  ) + ss22(i  ,k  ,j  ) +   &
1545                              ss22(i-1,k  ,j-1) + ss22(i  ,k  ,j-1) )
1546        ss13d(i,k,j) = 0.25*( ss13(i  ,k+1,j  ) + ss13(i  ,k+1,j-1) +   &
1547                              ss13(i  ,k  ,j  ) + ss13(i  ,k  ,j-1) )
1548        rr13d(i,k,j) = 0.25*( rr13(i  ,k+1,j  ) + rr13(i  ,k+1,j-1) +   &
1549                              rr13(i  ,k  ,j  ) + rr13(i  ,k  ,j-1) )
1550        ss23d(i,k,j) = 0.25*( ss23(i  ,k+1,j  ) + ss23(i-1,k+1,j  ) +   &
1551                              ss23(i  ,k  ,j  ) + ss23(i-1,k  ,j  ) )
1552        rr23d(i,k,j) = 0.25*( rr23(i  ,k+1,j  ) + rr23(i-1,k+1,j  ) +   &
1553                              rr23(i  ,k  ,j  ) + rr23(i-1,k  ,j  ) )
1554      END DO
1555      END DO
1557      END DO
1559 !LPB[16]
1561 !!LPB[17]
1562 !  IF ( config_flags%sfs_opt .EQ. 1 ) THEN
1564 !       DO j=j_start,j_end
1565 !       DO k=kts,ktf
1566 !       DO i=i_start,i_end
1567 !         delta = ( dx * dy / rdzw(i,k,j) )**0.33333333
1568 !         a = -1.0*( cs*delta )**2
1569 !         m12(i,k,j) = a*(   2.0*sqrt( 2.0*smnsmnd(i,k,j) )*ss12(i,k,j)   &
1570 !                          + c1*(   ss11d(i,k,j)*ss12(i,k,j)              &
1571 !                                 + ss22d(i,k,j)*ss12(i,k,j)              &
1572 !                                 + ss13d(i,k,j)*ss23d(i,k,j)             &
1573 !                               )                                         &
1574 !                          + c2*(   ss11d(i,k,j)*rr12(i,k,j)              &
1575 !                                 - ss13d(i,k,j)*rr23d(i,k,j)              &
1576 !                                 - ss22d(i,k,j)*rr12(i,k,j)              &
1577 !                                 - ss23d(i,k,j)*rr13d(i,k,j)             &
1578 !                               )                                         &
1579 !                         )
1580 !       ENDDO
1581 !       ENDDO
1582 !       ENDDO
1583 !     ELSE
1585 !       DO j=j_start,j_end
1586 !       DO k=kts,ktf
1587 !       DO i=i_start,i_end 
1588 !         delta = ( dx * dy / rdzw(i,k,j) )**0.33333333
1589 !         a = -1.0*ce*delta
1590 !         b = c3*delta
1591 !         m12(i,k,j) = a*(   2.0*sqrt( tked(i,k,j) )*s12(i,k,j)       &
1592 !                          + b*(                                      &
1593 !                                  c1*(   ss11d(i,k,j)*ss12(i,k,j)    &
1594 !                                       + ss22d(i,k,j)*ss12(i,k,j)    &
1595 !                                       + ss13d(i,k,j)*ss23d(i,k,j)   &
1596 !                                     )                               &
1597 !                                + c2*(   ss11d(i,k,j)*rr12(i,k,j)    &
1598 !                                       - ss13d(i,k,j)*rr23d(i,k,j)   &
1599 !                                       - ss22d(i,k,j)*rr12(i,k,j)    &
1600 !                                       - ss23d(i,k,j)*rr13d(i,k,j)   &
1601 !                                     )                               &
1602 !                              )                                      &
1603 !                        )
1604 !       ENDDO
1605 !       ENDDO
1606 !       ENDDO
1608 !   ENDIF
1610 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
1612    Do K2_ADJ =jts-1, jte+1
1613    Do K1_ADJ =kms, kme
1614    Do K0_ADJ =its-1, ite+1
1615    a_ss11(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1616    End Do
1617    End Do
1618    End Do
1620    Do K2_ADJ =jts-1, jte+1
1621    Do K1_ADJ =kms, kme
1622    Do K0_ADJ =its-1, ite+1
1623    a_ss22(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1624    End Do
1625    End Do
1626    End Do
1628    Do K2_ADJ =jts-1, jte+1
1629    Do K1_ADJ =kms, kme
1630    Do K0_ADJ =its-1, ite+1
1631    a_ss12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1632    End Do
1633    End Do
1634    End Do
1636    Do K2_ADJ =jts-1, jte+1
1637    Do K1_ADJ =kms, kme
1638    Do K0_ADJ =its-1, ite+1
1639    a_ss13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1640    End Do
1641    End Do
1642    End Do
1644    Do K2_ADJ =jts-1, jte+1
1645    Do K1_ADJ =kms, kme
1646    Do K0_ADJ =its-1, ite+1
1647    a_ss23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1648    End Do
1649    End Do
1650    End Do
1652    Do K2_ADJ =jts-1, jte+1
1653    Do K1_ADJ =kms, kme
1654    Do K0_ADJ =its-1, ite+1
1655    a_rr12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1656    End Do
1657    End Do
1658    End Do
1660    Do K2_ADJ =jts-1, jte+1
1661    Do K1_ADJ =kms, kme
1662    Do K0_ADJ =its-1, ite+1
1663    a_rr13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1664    End Do
1665    End Do
1666    End Do
1668    Do K2_ADJ =jts-1, jte+1
1669    Do K1_ADJ =kms, kme
1670    Do K0_ADJ =its-1, ite+1
1671    a_rr23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1672    End Do
1673    End Do
1674    End Do
1676    Do K2_ADJ =jts-1, jte+1
1677    Do K1_ADJ =kms, kme
1678    Do K0_ADJ =its-1, ite+1
1679    a_tked(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1680    End Do
1681    End Do
1682    End Do
1684    Do K2_ADJ =jts-1, jte+1
1685    Do K1_ADJ =kms, kme
1686    Do K0_ADJ =its-1, ite+1
1687    a_ss11d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1688    End Do
1689    End Do
1690    End Do
1692    Do K2_ADJ =jts-1, jte+1
1693    Do K1_ADJ =kms, kme
1694    Do K0_ADJ =its-1, ite+1
1695    a_ss22d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1696    End Do
1697    End Do
1698    End Do
1700    Do K2_ADJ =jts-1, jte+1
1701    Do K1_ADJ =kms, kme
1702    Do K0_ADJ =its-1, ite+1
1703    a_ss13d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1704    End Do
1705    End Do
1706    End Do
1708    Do K2_ADJ =jts-1, jte+1
1709    Do K1_ADJ =kms, kme
1710    Do K0_ADJ =its-1, ite+1
1711    a_ss23d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1712    End Do
1713    End Do
1714    End Do
1716    Do K2_ADJ =jts-1, jte+1
1717    Do K1_ADJ =kms, kme
1718    Do K0_ADJ =its-1, ite+1
1719    a_rr13d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1720    End Do
1721    End Do
1722    End Do
1724    Do K2_ADJ =jts-1, jte+1
1725    Do K1_ADJ =kms, kme
1726    Do K0_ADJ =its-1, ite+1
1727    a_rr23d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1728    End Do
1729    End Do
1730    End Do
1732    Do K2_ADJ =jts-1, jte+1
1733    Do K1_ADJ =kms, kme
1734    Do K0_ADJ =its-1, ite+1
1735    a_smnsmnd(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1736    End Do
1737    End Do
1738    End Do
1740    a_delta =0.0
1741    a_a =0.0
1742    a_b =0.0
1744 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
1746 !LPB[17]
1748    IF( config_flags%sfs_opt .EQ. 1 ) THEN
1749    DO j =j_start, j_end
1750    DO k =kts, ktf
1751    DO i =i_start, i_end
1752    delta =(dx*dy/rdzw(i,k,j))**0.33333333
1754    a =-1.0*(cs*delta)**2
1755    Tmpv400(i,k,j) =a
1757    Tmpv001 =2.0*sqrt(2.0*smnsmnd(i,k,j))*ss12(i,k,j)
1758    Tmpv002 =ss11d(i,k,j)*ss12(i,k,j)
1759    Tmpv003 =ss22d(i,k,j)*ss12(i,k,j)
1760    Tmpv004 =Tmpv002 +Tmpv003
1761    Tmpv005 =ss13d(i,k,j)*ss23d(i,k,j)
1762    Tmpv006 =Tmpv004 +Tmpv005
1763    Tmpv007 =c1*Tmpv006
1764    Tmpv008 =Tmpv001 +Tmpv007
1765    Tmpv009 =ss11d(i,k,j)*rr12(i,k,j)
1766    Tmpv010 =ss13d(i,k,j)*rr23d(i,k,j)
1767    Tmpv011 =Tmpv009 -Tmpv010
1768    Tmpv012 =ss22d(i,k,j)*rr12(i,k,j)
1769    Tmpv013 =Tmpv011 -Tmpv012
1770    Tmpv014 =ss23d(i,k,j)*rr13d(i,k,j)
1771    Tmpv015 =Tmpv013 -Tmpv014
1772    Tmpv016 =c2*Tmpv015
1773    Tmpv017 =Tmpv008 +Tmpv016
1774    Tmpv401(i,k,j) =Tmpv017
1775    Tmpv018 =a*Tmpv401(i,k,j)
1776    m12(i,k,j) =Tmpv018
1778    ENDDO
1779    ENDDO
1780    ENDDO
1781    ELSE
1782    DO j =j_start, j_end
1783    DO k =kts, ktf
1784    DO i =i_start, i_end
1785    delta =(dx*dy/rdzw(i,k,j))**0.33333333
1787    a =-1.0*ce*delta
1788    Tmpv402(i,k,j) =a
1790    b =c3*delta
1791    Tmpv403(i,k,j) =b
1793    Tmpv001 =2.0*sqrt(tked(i,k,j))*s12(i,k,j)
1794    Tmpv002 =ss11d(i,k,j)*ss12(i,k,j)
1795    Tmpv003 =ss22d(i,k,j)*ss12(i,k,j)
1796    Tmpv004 =Tmpv002 +Tmpv003
1797    Tmpv005 =ss13d(i,k,j)*ss23d(i,k,j)
1798    Tmpv006 =Tmpv004 +Tmpv005
1799    Tmpv007 =c1*Tmpv006
1800    Tmpv008 =ss11d(i,k,j)*rr12(i,k,j)
1801    Tmpv009 =ss13d(i,k,j)*rr23d(i,k,j)
1802    Tmpv010 =Tmpv008 -Tmpv009
1803    Tmpv011 =ss22d(i,k,j)*rr12(i,k,j)
1804    Tmpv012 =Tmpv010 -Tmpv011
1805    Tmpv013 =ss23d(i,k,j)*rr13d(i,k,j)
1806    Tmpv014 =Tmpv012 -Tmpv013
1807    Tmpv015 =c2*Tmpv014
1808    Tmpv016 =Tmpv007 +Tmpv015
1809    Tmpv404(i,k,j) =Tmpv016
1810    Tmpv017 =b*Tmpv404(i,k,j)
1811    Tmpv018 =Tmpv001 +Tmpv017
1812    Tmpv405(i,k,j) =Tmpv018
1813    Tmpv019 =a*Tmpv405(i,k,j)
1814    m12(i,k,j) =Tmpv019
1816    ENDDO
1817    ENDDO
1818    ENDDO
1819    ENDIF
1821    IF( config_flags%sfs_opt .EQ. 1 ) THEN
1823    DO j =j_end, j_start, -1
1824    DO k =ktf, kts, -1
1825    DO i =i_end, i_start, -1
1826    a =Tmpv400(i,k,j)
1828    a_Tmpv18 =a_m12(i,k,j)
1829    a_m12(i,k,j) =0.0
1830    a_a =a_a +Tmpv401(i,k,j)*a_Tmpv18
1831    a_Tmpv17 =a*a_Tmpv18
1832    a_Tmpv8 =a_Tmpv17
1833    a_Tmpv16 =a_Tmpv17
1834    a_Tmpv15 =c2*a_Tmpv16
1835    a_Tmpv13 =a_Tmpv15
1836    a_Tmpv14 =-a_Tmpv15
1837    a_ss23d(i,k,j) =a_ss23d(i,k,j) +rr13d(i,k,j)*a_Tmpv14
1838    a_rr13d(i,k,j) =a_rr13d(i,k,j) +ss23d(i,k,j)*a_Tmpv14
1839    a_Tmpv11 =a_Tmpv13
1840    a_Tmpv12 =-a_Tmpv13
1841    a_ss22d(i,k,j) =a_ss22d(i,k,j) +rr12(i,k,j)*a_Tmpv12
1842    a_rr12(i,k,j) =a_rr12(i,k,j) +ss22d(i,k,j)*a_Tmpv12
1843    a_Tmpv9 =a_Tmpv11
1844    a_Tmpv10 =-a_Tmpv11
1845    a_ss13d(i,k,j) =a_ss13d(i,k,j) +rr23d(i,k,j)*a_Tmpv10
1846    a_rr23d(i,k,j) =a_rr23d(i,k,j) +ss13d(i,k,j)*a_Tmpv10
1847    a_ss11d(i,k,j) =a_ss11d(i,k,j) +rr12(i,k,j)*a_Tmpv9
1848    a_rr12(i,k,j) =a_rr12(i,k,j) +ss11d(i,k,j)*a_Tmpv9
1849    a_Tmpv1 =a_Tmpv8
1850    a_Tmpv7 =a_Tmpv8
1851    a_Tmpv6 =c1*a_Tmpv7
1852    a_Tmpv4 =a_Tmpv6
1853    a_Tmpv5 =a_Tmpv6
1854    a_ss13d(i,k,j) =a_ss13d(i,k,j) +ss23d(i,k,j)*a_Tmpv5
1855    a_ss23d(i,k,j) =a_ss23d(i,k,j) +ss13d(i,k,j)*a_Tmpv5
1856    a_Tmpv2 =a_Tmpv4
1857    a_Tmpv3 =a_Tmpv4
1858    a_ss22d(i,k,j) =a_ss22d(i,k,j) +ss12(i,k,j)*a_Tmpv3
1859    a_ss12(i,k,j) =a_ss12(i,k,j) +ss22d(i,k,j)*a_Tmpv3
1860    a_ss11d(i,k,j) =a_ss11d(i,k,j) +ss12(i,k,j)*a_Tmpv2
1861    a_ss12(i,k,j) =a_ss12(i,k,j) +ss11d(i,k,j)*a_Tmpv2
1862    a_smnsmnd(i,k,j) =a_smnsmnd(i,k,j) +2.0*g_Sqrt(2.0, 2.0*smnsmnd(i,k,j))  &
1863    *ss12(i,k,j)*a_Tmpv1
1864    a_ss12(i,k,j) =a_ss12(i,k,j) +2.0*sqrt(2.0*smnsmnd(i,k,j))*a_Tmpv1
1866    Tmpv001 =2.0*sqrt(2.0*smnsmnd(i,k,j))*ss12(i,k,j)
1867 !  a =Tmpv400(i,k,j)
1869 !ADDED BY WALLS
1870    delta =(dx*dy/rdzw(i,k,j))**0.33333333
1872    a_delta =a_delta -1.0*2.0*(cs*delta)*cs*a_a
1873    a_a =0.0
1874    a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx*  &
1875    dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta
1876    a_delta =0.0
1877    ENDDO
1878    ENDDO
1879    ENDDO
1881    ELSE
1883    DO j =j_end, j_start, -1
1884    DO k =ktf, kts, -1
1885    DO i =i_end, i_start, -1
1886    a =Tmpv402(i,k,j)
1887    b =Tmpv403(i,k,j)
1889    a_Tmpv19 =a_m12(i,k,j)
1890    a_m12(i,k,j) =0.0
1891    a_a =a_a +Tmpv405(i,k,j)*a_Tmpv19
1892    a_Tmpv18 =a*a_Tmpv19
1893    a_Tmpv1 =a_Tmpv18
1894    a_Tmpv17 =a_Tmpv18
1895    a_b =a_b +Tmpv404(i,k,j)*a_Tmpv17
1896    a_Tmpv16 =b*a_Tmpv17
1897    a_Tmpv7 =a_Tmpv16
1898    a_Tmpv15 =a_Tmpv16
1899    a_Tmpv14 =c2*a_Tmpv15
1900    a_Tmpv12 =a_Tmpv14
1901    a_Tmpv13 =-a_Tmpv14
1902    a_ss23d(i,k,j) =a_ss23d(i,k,j) +rr13d(i,k,j)*a_Tmpv13
1903    a_rr13d(i,k,j) =a_rr13d(i,k,j) +ss23d(i,k,j)*a_Tmpv13
1904    a_Tmpv10 =a_Tmpv12
1905    a_Tmpv11 =-a_Tmpv12
1906    a_ss22d(i,k,j) =a_ss22d(i,k,j) +rr12(i,k,j)*a_Tmpv11
1907    a_rr12(i,k,j) =a_rr12(i,k,j) +ss22d(i,k,j)*a_Tmpv11
1908    a_Tmpv8 =a_Tmpv10
1909    a_Tmpv9 =-a_Tmpv10
1910    a_ss13d(i,k,j) =a_ss13d(i,k,j) +rr23d(i,k,j)*a_Tmpv9
1911    a_rr23d(i,k,j) =a_rr23d(i,k,j) +ss13d(i,k,j)*a_Tmpv9
1912    a_ss11d(i,k,j) =a_ss11d(i,k,j) +rr12(i,k,j)*a_Tmpv8
1913    a_rr12(i,k,j) =a_rr12(i,k,j) +ss11d(i,k,j)*a_Tmpv8
1914    a_Tmpv6 =c1*a_Tmpv7
1915    a_Tmpv4 =a_Tmpv6
1916    a_Tmpv5 =a_Tmpv6
1917    a_ss13d(i,k,j) =a_ss13d(i,k,j) +ss23d(i,k,j)*a_Tmpv5
1918    a_ss23d(i,k,j) =a_ss23d(i,k,j) +ss13d(i,k,j)*a_Tmpv5
1919    a_Tmpv2 =a_Tmpv4
1920    a_Tmpv3 =a_Tmpv4
1921    a_ss22d(i,k,j) =a_ss22d(i,k,j) +ss12(i,k,j)*a_Tmpv3
1922    a_ss12(i,k,j) =a_ss12(i,k,j) +ss22d(i,k,j)*a_Tmpv3
1923    a_ss11d(i,k,j) =a_ss11d(i,k,j) +ss12(i,k,j)*a_Tmpv2
1924    a_ss12(i,k,j) =a_ss12(i,k,j) +ss11d(i,k,j)*a_Tmpv2
1925    a_tked(i,k,j) =a_tked(i,k,j) +2.0*g_Sqrt(1.0, tked(i,k,j))*s12(i,k,j)*a_Tmpv1
1926    a_s12(i,k,j) =a_s12(i,k,j) +2.0*sqrt(tked(i,k,j))*a_Tmpv1
1928 !  b =Tmpv403(i,k,j)
1930    a_delta =a_delta +c3*a_b
1931    a_b =0.0
1933 !  a =Tmpv402(i,k,j)
1935    a_delta =a_delta -1.0*ce*a_a
1936    a_a =0.0
1937    a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx*  &
1938    dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta
1939    a_delta =0.0
1940    ENDDO
1941    ENDDO
1942    ENDDO
1944    ENDIF
1946 !LPB[16]
1948 !LPB[15]
1949    DO j =j_end, j_start, -1
1951 !  DO k =kts, ktf
1952 !  DO i =i_start, i_end
1953 !  Tmpv001 =tke(i-1,k,j) +tke(i,k,j)
1954 !  Tmpv002 =Tmpv001 +tke(i-1,k,j-1)
1955 !  Tmpv003 =Tmpv002 +tke(i,k,j-1)
1956 !  Tmpv004 =0.25*Tmpv003
1957 !  tked(i,k,j) =Tmpv004
1959 !  Tmpv001 =smnsmn(i-1,k,j) +smnsmn(i,k,j)
1960 !  Tmpv002 =Tmpv001 +smnsmn(i-1,k,j-1)
1961 !  Tmpv003 =Tmpv002 +smnsmn(i,k,j-1)
1962 !  Tmpv004 =0.25*Tmpv003
1963 !  smnsmnd(i,k,j) =Tmpv004
1965 !  Tmpv001 =ss11(i-1,k,j) +ss11(i,k,j)
1966 !  Tmpv002 =Tmpv001 +ss11(i-1,k,j-1)
1967 !  Tmpv003 =Tmpv002 +ss11(i,k,j-1)
1968 !  Tmpv004 =0.25*Tmpv003
1969 !  ss11d(i,k,j) =Tmpv004
1971 !  Tmpv001 =ss22(i-1,k,j) +ss22(i,k,j)
1972 !  Tmpv002 =Tmpv001 +ss22(i-1,k,j-1)
1973 !  Tmpv003 =Tmpv002 +ss22(i,k,j-1)
1974 !  Tmpv004 =0.25*Tmpv003
1975 !  ss22d(i,k,j) =Tmpv004
1977 !  Tmpv001 =ss13(i,k+1,j) +ss13(i,k+1,j-1)
1978 !  Tmpv002 =Tmpv001 +ss13(i,k,j)
1979 !  Tmpv003 =Tmpv002 +ss13(i,k,j-1)
1980 !  Tmpv004 =0.25*Tmpv003
1981 !  ss13d(i,k,j) =Tmpv004
1983 !  Tmpv001 =rr13(i,k+1,j) +rr13(i,k+1,j-1)
1984 !  Tmpv002 =Tmpv001 +rr13(i,k,j)
1985 !  Tmpv003 =Tmpv002 +rr13(i,k,j-1)
1986 !  Tmpv004 =0.25*Tmpv003
1987 !  rr13d(i,k,j) =Tmpv004
1989 !  Tmpv001 =ss23(i,k+1,j) +ss23(i-1,k+1,j)
1990 !  Tmpv002 =Tmpv001 +ss23(i,k,j)
1991 !  Tmpv003 =Tmpv002 +ss23(i-1,k,j)
1992 !  Tmpv004 =0.25*Tmpv003
1993 !  ss23d(i,k,j) =Tmpv004
1995 !  Tmpv001 =rr23(i,k+1,j) +rr23(i-1,k+1,j)
1996 !  Tmpv002 =Tmpv001 +rr23(i,k,j)
1997 !  Tmpv003 =Tmpv002 +rr23(i-1,k,j)
1998 !  Tmpv004 =0.25*Tmpv003
1999 !  rr23d(i,k,j) =Tmpv004
2001 !  ENDDO
2002 !  ENDDO
2004    DO k =ktf, kts, -1
2005    DO i =i_end, i_start, -1
2006    a_Tmpv4 =a_rr23d(i,k,j)
2007    a_rr23d(i,k,j) =0.0
2008    a_Tmpv3 =0.25*a_Tmpv4
2009    a_Tmpv2 =a_Tmpv3
2010    a_rr23(i-1,k,j) =a_rr23(i-1,k,j) +a_Tmpv3
2011    a_Tmpv1 =a_Tmpv2
2012    a_rr23(i,k,j) =a_rr23(i,k,j) +a_Tmpv2
2013    a_rr23(i,k+1,j) =a_rr23(i,k+1,j) +a_Tmpv1
2014    a_rr23(i-1,k+1,j) =a_rr23(i-1,k+1,j) +a_Tmpv1
2015    a_Tmpv4 =a_ss23d(i,k,j)
2016    a_ss23d(i,k,j) =0.0
2017    a_Tmpv3 =0.25*a_Tmpv4
2018    a_Tmpv2 =a_Tmpv3
2019    a_ss23(i-1,k,j) =a_ss23(i-1,k,j) +a_Tmpv3
2020    a_Tmpv1 =a_Tmpv2
2021    a_ss23(i,k,j) =a_ss23(i,k,j) +a_Tmpv2
2022    a_ss23(i,k+1,j) =a_ss23(i,k+1,j) +a_Tmpv1
2023    a_ss23(i-1,k+1,j) =a_ss23(i-1,k+1,j) +a_Tmpv1
2024    a_Tmpv4 =a_rr13d(i,k,j)
2025    a_rr13d(i,k,j) =0.0
2026    a_Tmpv3 =0.25*a_Tmpv4
2027    a_Tmpv2 =a_Tmpv3
2028    a_rr13(i,k,j-1) =a_rr13(i,k,j-1) +a_Tmpv3
2029    a_Tmpv1 =a_Tmpv2
2030    a_rr13(i,k,j) =a_rr13(i,k,j) +a_Tmpv2
2031    a_rr13(i,k+1,j) =a_rr13(i,k+1,j) +a_Tmpv1
2032    a_rr13(i,k+1,j-1) =a_rr13(i,k+1,j-1) +a_Tmpv1
2033    a_Tmpv4 =a_ss13d(i,k,j)
2034    a_ss13d(i,k,j) =0.0
2035    a_Tmpv3 =0.25*a_Tmpv4
2036    a_Tmpv2 =a_Tmpv3
2037    a_ss13(i,k,j-1) =a_ss13(i,k,j-1) +a_Tmpv3
2038    a_Tmpv1 =a_Tmpv2
2039    a_ss13(i,k,j) =a_ss13(i,k,j) +a_Tmpv2
2040    a_ss13(i,k+1,j) =a_ss13(i,k+1,j) +a_Tmpv1
2041    a_ss13(i,k+1,j-1) =a_ss13(i,k+1,j-1) +a_Tmpv1
2042    a_Tmpv4 =a_ss22d(i,k,j)
2043    a_ss22d(i,k,j) =0.0
2044    a_Tmpv3 =0.25*a_Tmpv4
2045    a_Tmpv2 =a_Tmpv3
2046    a_ss22(i,k,j-1) =a_ss22(i,k,j-1) +a_Tmpv3
2047    a_Tmpv1 =a_Tmpv2
2048    a_ss22(i-1,k,j-1) =a_ss22(i-1,k,j-1) +a_Tmpv2
2049    a_ss22(i-1,k,j) =a_ss22(i-1,k,j) +a_Tmpv1
2050    a_ss22(i,k,j) =a_ss22(i,k,j) +a_Tmpv1
2051    a_Tmpv4 =a_ss11d(i,k,j)
2052    a_ss11d(i,k,j) =0.0
2053    a_Tmpv3 =0.25*a_Tmpv4
2054    a_Tmpv2 =a_Tmpv3
2055    a_ss11(i,k,j-1) =a_ss11(i,k,j-1) +a_Tmpv3
2056    a_Tmpv1 =a_Tmpv2
2057    a_ss11(i-1,k,j-1) =a_ss11(i-1,k,j-1) +a_Tmpv2
2058    a_ss11(i-1,k,j) =a_ss11(i-1,k,j) +a_Tmpv1
2059    a_ss11(i,k,j) =a_ss11(i,k,j) +a_Tmpv1
2060    a_Tmpv4 =a_smnsmnd(i,k,j)
2061    a_smnsmnd(i,k,j) =0.0
2062    a_Tmpv3 =0.25*a_Tmpv4
2063    a_Tmpv2 =a_Tmpv3
2064    a_smnsmn(i,k,j-1) =a_smnsmn(i,k,j-1) +a_Tmpv3
2065    a_Tmpv1 =a_Tmpv2
2066    a_smnsmn(i-1,k,j-1) =a_smnsmn(i-1,k,j-1) +a_Tmpv2
2067    a_smnsmn(i-1,k,j) =a_smnsmn(i-1,k,j) +a_Tmpv1
2068    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +a_Tmpv1
2069    a_Tmpv4 =a_tked(i,k,j)
2070    a_tked(i,k,j) =0.0
2071    a_Tmpv3 =0.25*a_Tmpv4
2072    a_Tmpv2 =a_Tmpv3
2073    a_tke(i,k,j-1) =a_tke(i,k,j-1) +a_Tmpv3
2074    a_Tmpv1 =a_Tmpv2
2075    a_tke(i-1,k,j-1) =a_tke(i-1,k,j-1) +a_Tmpv2
2076    a_tke(i-1,k,j) =a_tke(i-1,k,j) +a_Tmpv1
2077    a_tke(i,k,j) =a_tke(i,k,j) +a_Tmpv1
2078    ENDDO
2079    ENDDO
2081    ENDDO
2083 !LPB[14]
2084    DO j =j_end, j_start-1, -1
2086 !  DO i =i_start-1, i_end
2087 !  ss13(i,kde,j) =0.0
2089 !  ss23(i,kde,j) =0.0
2091 !  rr13(i,kde,j) =0.0
2093 !  rr23(i,kde,j) =0.0
2095 !  ENDDO
2097    DO i =i_end, i_start-1, -1
2098    a_rr23(i,kde,j) =0.0
2099    a_rr13(i,kde,j) =0.0
2100    a_ss23(i,kde,j) =0.0
2101    a_ss13(i,kde,j) =0.0
2102    ENDDO
2104    ENDDO
2106 !LPB[13]
2107    DO j =j_end, j_start-1, -1
2109 !  DO k =kts, ktf
2110 !  DO i =i_start-1, i_end
2111 !  ss11(i,k,j) =s11(i,k,j)/2.0
2113 !  ss22(i,k,j) =s22(i,k,j)/2.0
2115 !  ss12(i,k,j) =s12(i,k,j)/2.0
2117 !  ss13(i,k,j) =s13(i,k,j)/2.0
2119 !  ss23(i,k,j) =s23(i,k,j)/2.0
2121 !  rr12(i,k,j) =r12(i,k,j)/2.0
2123 !  rr13(i,k,j) =r13(i,k,j)/2.0
2125 !  rr23(i,k,j) =r23(i,k,j)/2.0
2127 !  ENDDO
2128 !  ENDDO
2130    DO k =ktf, kts, -1
2131    DO i =i_end, i_start-1, -1
2132    a_r23(i,k,j) =a_r23(i,k,j) +1.0/2.0*a_rr23(i,k,j)
2133    a_rr23(i,k,j) =0.0
2134    a_r13(i,k,j) =a_r13(i,k,j) +1.0/2.0*a_rr13(i,k,j)
2135    a_rr13(i,k,j) =0.0
2136    a_r12(i,k,j) =a_r12(i,k,j) +1.0/2.0*a_rr12(i,k,j)
2137    a_rr12(i,k,j) =0.0
2138    a_s23(i,k,j) =a_s23(i,k,j) +1.0/2.0*a_ss23(i,k,j)
2139    a_ss23(i,k,j) =0.0
2140    a_s13(i,k,j) =a_s13(i,k,j) +1.0/2.0*a_ss13(i,k,j)
2141    a_ss13(i,k,j) =0.0
2142    a_s12(i,k,j) =a_s12(i,k,j) +1.0/2.0*a_ss12(i,k,j)
2143    a_ss12(i,k,j) =0.0
2144    a_s22(i,k,j) =a_s22(i,k,j) +1.0/2.0*a_ss22(i,k,j)
2145    a_ss22(i,k,j) =0.0
2146    a_s11(i,k,j) =a_s11(i,k,j) +1.0/2.0*a_ss11(i,k,j)
2147    a_ss11(i,k,j) =0.0
2148    ENDDO
2149    ENDDO
2151    ENDDO
2153 !LPB[12]
2154 !  je_ext =1
2155 !  ie_ext =1
2156 !  i_end =i_end+ie_ext
2157 !  j_end =j_end+je_ext
2159 !LPB[11]
2161 !  IF( config_flags%periodic_x ) THEN
2162 !  i_end =ite
2163 !  END IF
2165 !  IF( config_flags%periodic_x ) THEN
2167 !  END IF
2169 !LPB[10]
2171 !LPB[9]
2173 !  IF( config_flags%periodic_x ) THEN
2174 !  i_start =its
2175 !  END IF
2177 !  IF( config_flags%periodic_x ) THEN
2179 !  END IF
2181 !LPB[8]
2183 !LPB[7]
2185 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.             config_flags%nested ) THEN
2186 !  j_end =min(jde-1, jte)
2187 !  END IF
2189 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
2190 !            config_flags%nested ) THEN
2192 !  END IF
2194 !LPB[6]
2196 !LPB[5]
2198 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested ) THEN
2199 !  j_start =max(jds+1, jts)
2200 !  END IF
2202 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
2203 !            config_flags%nested ) THEN
2205 !  END IF
2207 !LPB[4]
2209 !LPB[3]
2211 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.             config_flags%nested ) THEN
2212 !  i_end =min(ide-1, ite)
2213 !  END IF
2215 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
2216 !            config_flags%nested ) THEN
2218 !  END IF
2220 !LPB[2]
2222 !LPB[1]
2224 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested ) THEN
2225 !  i_start =max(ids+1, its)
2226 !  END IF
2228 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
2229 !            config_flags%nested ) THEN
2231 !  END IF
2233 !LPB[0]
2234 !  ktf =min(kte, kde-1)
2235 !  i_start =its
2236 !  i_end =ite
2237 !  j_start =jts
2238 !  j_end =jte
2240    Return
2241         END SUBROUTINE a_calc_m12
2243    SUBROUTINE a_calc_m13(m13,a_m13,s11,a_s11,s33,a_s33,s12,a_s12,s13,a_s13, &
2244    s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23,smnsmn,a_smnsmn,tke,a_tke,rdzw, &
2245    a_rdzw,dx,dy,fnm,fnp,config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
2246    ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
2248 !PART I: DECLARATION OF VARIABLES
2250    IMPLICIT NONE
2252    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
2253    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: m13,a_m13
2254    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s11,a_s11,s33,a_s33,s12,a_s12,s13, &
2255    a_s13,s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23,smnsmn,a_smnsmn,tke, &
2256    a_tke,rdzw,a_rdzw
2257    REAL :: dx,dy
2258    REAL,DIMENSION(kms:kme) :: fnm,fnp
2259    TYPE(grid_config_rec_type) :: config_flags
2260    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, &
2261    its,ite,jts,jte,kts,kte
2262    REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss11,a_ss11,ss33,a_ss33,ss12, &
2263    a_ss12,ss13,a_ss13,ss23,a_ss23,rr12,a_rr12,rr13,a_rr13,rr23,a_rr23
2264    REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: tkee,a_tkee,ss11e,a_ss11e, &
2265    ss33e,a_ss33e,ss12e,a_ss12e,ss23e,a_ss23e,rr12e,a_rr12e,rr23e,a_rr23e, &
2266    smnsmne,a_smnsmne
2267    REAL :: delta,a_delta,a,a_a,b,a_b
2268    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf,ie_ext
2270    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
2271    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9, &
2272    Tmpv009,a_Tmpv10,Tmpv010,a_Tmpv11,Tmpv011,a_Tmpv12,Tmpv012,a_Tmpv13,Tmpv013, &
2273    a_Tmpv14,Tmpv014,a_Tmpv15,Tmpv015,a_Tmpv16,Tmpv016,a_Tmpv17,Tmpv017, &
2274    a_Tmpv18,Tmpv018,a_Tmpv19,Tmpv019
2275    REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
2276     :: Tmpv400
2277    REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
2278     :: Tmpv401
2279    REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
2280     :: Tmpv402
2281    REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
2282     :: Tmpv403
2283    REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
2284     :: Tmpv404
2285    REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
2286     :: Tmpv405
2288    REAL :: g_Sqrt
2290 !PART II: CALCULATIONS OF B. S. TRAJECTORY
2292 !LPB[0]
2294      ktf = MIN( kte, kde-1 )
2295      i_start = its
2296      i_end   = ite
2297      j_start = jts
2298      j_end   = MIN( jte, jde-1 )
2300 !LPB[1]
2301     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
2302          config_flags%nested) i_start = MAX( ids+1, its )
2304 !LPB[2]
2306 !LPB[3]
2307     IF ( config_flags%open_xe .OR. config_flags%specified .OR.   &
2308          config_flags%nested) i_end   = MIN( ide-1, ite )
2310 !LPB[4]
2312 !LPB[5]
2313     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
2314          config_flags%nested) j_start = MAX( jds+1, jts )
2316 !LPB[6]
2318 !LPB[7]
2319     IF ( config_flags%open_ye .OR. config_flags%specified .OR.   &
2320          config_flags%nested) j_end   = MIN( jde-2, jte )
2322 !LPB[8]
2324 !LPB[9]
2325       IF ( config_flags%periodic_x ) i_start = its
2327 !LPB[10]
2329 !LPB[11]
2330       IF ( config_flags%periodic_x ) i_end = ite
2332 !LPB[12]
2333      ie_ext = 1
2334      i_end = i_end + ie_ext   
2336 !LPB[13]
2337      DO j=j_start,j_end+1
2339      DO k=kts,ktf
2340      DO i=i_start-1,i_end
2341        ss11(i,k,j)=s11(i,k,j)/2.0
2342        ss33(i,k,j)=s33(i,k,j)/2.0
2343        ss12(i,k,j)=s12(i,k,j)/2.0
2344        ss13(i,k,j)=s13(i,k,j)/2.0
2345        ss23(i,k,j)=s23(i,k,j)/2.0
2346        rr12(i,k,j)=r12(i,k,j)/2.0
2347        rr13(i,k,j)=r13(i,k,j)/2.0
2348        rr23(i,k,j)=r23(i,k,j)/2.0
2349      END DO
2350      END DO
2352      END DO
2354 !LPB[14]
2355      DO j = j_start, j_end
2357      DO k = kts+1, ktf
2358      DO i = i_start, i_end
2359        tkee(i,k,j) = 0.5*( fnm(k)*( tke(i,k  ,j) + tke(i-1,k  ,j) ) +   &
2360                            fnp(k)*( tke(i,k-1,j) + tke(i-1,k-1,j) ) )
2361        smnsmne(i,k,j) = 0.5*( fnm(k)*( smnsmn(i,k  ,j) + smnsmn(i-1,k  ,j) ) +   &
2362                               fnp(k)*( smnsmn(i,k-1,j) + smnsmn(i-1,k-1,j) ) )
2363        ss11e(i,k,j) = 0.5*( fnm(k)*( ss11(i  ,k  ,j  ) + ss11(i-1,k  ,j  ) ) +   &
2364                             fnp(k)*( ss11(i  ,k-1,j  ) + ss11(i-1,k-1,j  ) ) )
2365        ss33e(i,k,j) = 0.5*( fnm(k)*( ss33(i  ,k  ,j  ) + ss33(i-1,k  ,j  ) ) +   &
2366                             fnp(k)*( ss33(i  ,k-1,j  ) + ss33(i-1,k-1,j  ) ) )
2367        ss12e(i,k,j) = 0.5*( fnm(k)*( ss12(i  ,k  ,j  ) + ss12(i  ,k  ,j+1) ) +   &
2368                             fnp(k)*( ss12(i  ,k-1,j  ) + ss12(i  ,k-1,j+1) ) )
2369        rr12e(i,k,j) = 0.5*( fnm(k)*( rr12(i  ,k  ,j  ) + rr12(i  ,k  ,j+1) ) +   &
2370                             fnp(k)*( rr12(i  ,k-1,j  ) + rr12(i  ,k-1,j+1) ) )
2371        ss23e(i,k,j) = 0.25*( ss23(i  ,k  ,j) + ss23(i  ,k  ,j+1) +   &
2372                              ss23(i-1,k  ,j) + ss23(i-1,k  ,j+1) )
2373        rr23e(i,k,j) = 0.25*( rr23(i  ,k  ,j) + rr23(i  ,k  ,j+1) +   &
2374                              rr23(i-1,k  ,j) + rr23(i-1,k  ,j+1) )
2375      END DO
2376      END DO
2378      END DO
2380 !LPB[15]
2382 !!LPB[16]
2383 !  IF ( config_flags%sfs_opt .EQ. 1 ) THEN
2385 !       DO j=j_start,j_end
2386 !       DO k=kts+1,ktf
2387 !       DO i=i_start,i_end
2388 !         delta = ( dx * dy / rdzw(i,k,j) )**0.33333333
2389 !         a = -1.0*( cs*delta )**2
2390 !         m13(i,k,j) = a*(   2.0*sqrt( 2.0*smnsmne(i,k,j) )*ss13(i,k,j)   &
2391 !                          + c1*(   ss11e(i,k,j)*ss13(i,k,j)              &
2392 !                                 + ss12e(i,k,j)*ss23e(i,k,j)             &
2393 !                                 + ss13(i,k,j)*ss33e(i,k,j)              &
2394 !                               )                                         &
2395 !                          + c2*(   ss11e(i,k,j)*rr13(i,k,j)              &
2396 !                                 + ss12e(i,k,j)*rr23e(i,k,j)             &
2397 !                                 - ss23e(i,k,j)*rr12e(i,k,j)             &
2398 !                                 - ss33e(i,k,j)*rr13(i,k,j)              &
2399 !                               )                                         &
2400 !                        )
2401 !       ENDDO
2402 !       ENDDO
2403 !       ENDDO
2404 !     ELSE
2406 !       DO j=j_start,j_end
2407 !       DO k=kts+1,ktf
2408 !       DO i=i_start,i_end
2409 !         delta = ( dx * dy / rdzw(i,k,j) )**0.33333333
2410 !         a = -1.0*ce*delta
2411 !         b = c3*delta
2412 !         m13(i,k,j) = a*(   2.0*sqrt( tkee(i,k,j) )*ss13(i,k,j)      &
2413 !                          + b*(                                      &
2414 !                                  c1*(   ss11e(i,k,j)*ss13(i,k,j)    &
2415 !                                       + ss12e(i,k,j)*ss23e(i,k,j)   &
2416 !                                       + ss13(i,k,j)*ss33e(i,k,j)    &
2417 !                                     )                               &
2418 !                                + c2*(   ss11e(i,k,j)*rr13(i,k,j)    &
2419 !                                       + ss12e(i,k,j)*rr23e(i,k,j)   &
2420 !                                       - ss23e(i,k,j)*rr12e(i,k,j)   &
2421 !                                       - ss33e(i,k,j)*rr13(i,k,j)    &
2422 !                                     )                               &
2423 !                              )                                      &
2424 !                        )
2425 !       ENDDO
2426 !       ENDDO
2427 !       ENDDO
2429 !   ENDIF
2431 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
2433    Do K2_ADJ =jts-1, jte+1
2434    Do K1_ADJ =kms, kme
2435    Do K0_ADJ =its-1, ite+1
2436    a_ss11(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2437    End Do
2438    End Do
2439    End Do
2441    Do K2_ADJ =jts-1, jte+1
2442    Do K1_ADJ =kms, kme
2443    Do K0_ADJ =its-1, ite+1
2444    a_ss33(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2445    End Do
2446    End Do
2447    End Do
2449    Do K2_ADJ =jts-1, jte+1
2450    Do K1_ADJ =kms, kme
2451    Do K0_ADJ =its-1, ite+1
2452    a_ss12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2453    End Do
2454    End Do
2455    End Do
2457    Do K2_ADJ =jts-1, jte+1
2458    Do K1_ADJ =kms, kme
2459    Do K0_ADJ =its-1, ite+1
2460    a_ss13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2461    End Do
2462    End Do
2463    End Do
2465    Do K2_ADJ =jts-1, jte+1
2466    Do K1_ADJ =kms, kme
2467    Do K0_ADJ =its-1, ite+1
2468    a_ss23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2469    End Do
2470    End Do
2471    End Do
2473    Do K2_ADJ =jts-1, jte+1
2474    Do K1_ADJ =kms, kme
2475    Do K0_ADJ =its-1, ite+1
2476    a_rr12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2477    End Do
2478    End Do
2479    End Do
2481    Do K2_ADJ =jts-1, jte+1
2482    Do K1_ADJ =kms, kme
2483    Do K0_ADJ =its-1, ite+1
2484    a_rr13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2485    End Do
2486    End Do
2487    End Do
2489    Do K2_ADJ =jts-1, jte+1
2490    Do K1_ADJ =kms, kme
2491    Do K0_ADJ =its-1, ite+1
2492    a_rr23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2493    End Do
2494    End Do
2495    End Do
2497    Do K2_ADJ =jts-1, jte+1
2498    Do K1_ADJ =kms, kme
2499    Do K0_ADJ =its-1, ite+1
2500    a_tkee(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2501    End Do
2502    End Do
2503    End Do
2505    Do K2_ADJ =jts-1, jte+1
2506    Do K1_ADJ =kms, kme
2507    Do K0_ADJ =its-1, ite+1
2508    a_ss11e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2509    End Do
2510    End Do
2511    End Do
2513    Do K2_ADJ =jts-1, jte+1
2514    Do K1_ADJ =kms, kme
2515    Do K0_ADJ =its-1, ite+1
2516    a_ss33e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2517    End Do
2518    End Do
2519    End Do
2521    Do K2_ADJ =jts-1, jte+1
2522    Do K1_ADJ =kms, kme
2523    Do K0_ADJ =its-1, ite+1
2524    a_ss12e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2525    End Do
2526    End Do
2527    End Do
2529    Do K2_ADJ =jts-1, jte+1
2530    Do K1_ADJ =kms, kme
2531    Do K0_ADJ =its-1, ite+1
2532    a_ss23e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2533    End Do
2534    End Do
2535    End Do
2537    Do K2_ADJ =jts-1, jte+1
2538    Do K1_ADJ =kms, kme
2539    Do K0_ADJ =its-1, ite+1
2540    a_rr12e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2541    End Do
2542    End Do
2543    End Do
2545    Do K2_ADJ =jts-1, jte+1
2546    Do K1_ADJ =kms, kme
2547    Do K0_ADJ =its-1, ite+1
2548    a_rr23e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2549    End Do
2550    End Do
2551    End Do
2553    Do K2_ADJ =jts-1, jte+1
2554    Do K1_ADJ =kms, kme
2555    Do K0_ADJ =its-1, ite+1
2556    a_smnsmne(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2557    End Do
2558    End Do
2559    End Do
2561    a_delta =0.0
2562    a_a =0.0
2563    a_b =0.0
2565 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
2567 !LPB[16]
2569    IF( config_flags%sfs_opt .EQ. 1 ) THEN
2570    DO j =j_start, j_end
2571    DO k =kts+1, ktf
2572    DO i =i_start, i_end
2573    delta =(dx*dy/rdzw(i,k,j))**0.33333333
2575    a =-1.0*(cs*delta)**2
2576    Tmpv400(i,k,j) =a
2578    Tmpv001 =2.0*sqrt(2.0*smnsmne(i,k,j))*ss13(i,k,j)
2579    Tmpv002 =ss11e(i,k,j)*ss13(i,k,j)
2580    Tmpv003 =ss12e(i,k,j)*ss23e(i,k,j)
2581    Tmpv004 =Tmpv002 +Tmpv003
2582    Tmpv005 =ss13(i,k,j)*ss33e(i,k,j)
2583    Tmpv006 =Tmpv004 +Tmpv005
2584    Tmpv007 =c1*Tmpv006
2585    Tmpv008 =Tmpv001 +Tmpv007
2586    Tmpv009 =ss11e(i,k,j)*rr13(i,k,j)
2587    Tmpv010 =ss12e(i,k,j)*rr23e(i,k,j)
2588    Tmpv011 =Tmpv009 +Tmpv010
2589    Tmpv012 =ss23e(i,k,j)*rr12e(i,k,j)
2590    Tmpv013 =Tmpv011 -Tmpv012
2591    Tmpv014 =ss33e(i,k,j)*rr13(i,k,j)
2592    Tmpv015 =Tmpv013 -Tmpv014
2593    Tmpv016 =c2*Tmpv015
2594    Tmpv017 =Tmpv008 +Tmpv016
2595    Tmpv401(i,k,j) =Tmpv017
2596    Tmpv018 =a*Tmpv401(i,k,j)
2597    m13(i,k,j) =Tmpv018
2599    ENDDO
2600    ENDDO
2601    ENDDO
2602    ELSE
2603    DO j =j_start, j_end
2604    DO k =kts+1, ktf
2605    DO i =i_start, i_end
2606    delta =(dx*dy/rdzw(i,k,j))**0.33333333
2608    a =-1.0*ce*delta
2609    Tmpv402(i,k,j) =a
2611    b =c3*delta
2612    Tmpv403(i,k,j) =b
2614    Tmpv001 =2.0*sqrt(tkee(i,k,j))*ss13(i,k,j)
2615    Tmpv002 =ss11e(i,k,j)*ss13(i,k,j)
2616    Tmpv003 =ss12e(i,k,j)*ss23e(i,k,j)
2617    Tmpv004 =Tmpv002 +Tmpv003
2618    Tmpv005 =ss13(i,k,j)*ss33e(i,k,j)
2619    Tmpv006 =Tmpv004 +Tmpv005
2620    Tmpv007 =c1*Tmpv006
2621    Tmpv008 =ss11e(i,k,j)*rr13(i,k,j)
2622    Tmpv009 =ss12e(i,k,j)*rr23e(i,k,j)
2623    Tmpv010 =Tmpv008 +Tmpv009
2624    Tmpv011 =ss23e(i,k,j)*rr12e(i,k,j)
2625    Tmpv012 =Tmpv010 -Tmpv011
2626    Tmpv013 =ss33e(i,k,j)*rr13(i,k,j)
2627    Tmpv014 =Tmpv012 -Tmpv013
2628    Tmpv015 =c2*Tmpv014
2629    Tmpv016 =Tmpv007 +Tmpv015
2630    Tmpv404(i,k,j) =Tmpv016
2631    Tmpv017 =b*Tmpv404(i,k,j)
2632    Tmpv018 =Tmpv001 +Tmpv017
2633    Tmpv405(i,k,j) =Tmpv018
2634    Tmpv019 =a*Tmpv405(i,k,j)
2635    m13(i,k,j) =Tmpv019
2637    ENDDO
2638    ENDDO
2639    ENDDO
2640    ENDIF
2642    IF( config_flags%sfs_opt .EQ. 1 ) THEN
2644    DO j =j_end, j_start, -1
2645    DO k =ktf, kts+1, -1
2646    DO i =i_end, i_start, -1
2647 !ADDED BY WALLS
2648    delta =(dx*dy/rdzw(i,k,j))**0.33333333
2649    a =Tmpv400(i,k,j)
2651    a_Tmpv18 =a_m13(i,k,j)
2652    a_m13(i,k,j) =0.0
2653    a_a =a_a +Tmpv401(i,k,j)*a_Tmpv18
2654    a_Tmpv17 =a*a_Tmpv18
2655    a_Tmpv8 =a_Tmpv17
2656    a_Tmpv16 =a_Tmpv17
2657    a_Tmpv15 =c2*a_Tmpv16
2658    a_Tmpv13 =a_Tmpv15
2659    a_Tmpv14 =-a_Tmpv15
2660    a_ss33e(i,k,j) =a_ss33e(i,k,j) +rr13(i,k,j)*a_Tmpv14
2661    a_rr13(i,k,j) =a_rr13(i,k,j) +ss33e(i,k,j)*a_Tmpv14
2662    a_Tmpv11 =a_Tmpv13
2663    a_Tmpv12 =-a_Tmpv13
2664    a_ss23e(i,k,j) =a_ss23e(i,k,j) +rr12e(i,k,j)*a_Tmpv12
2665    a_rr12e(i,k,j) =a_rr12e(i,k,j) +ss23e(i,k,j)*a_Tmpv12
2666    a_Tmpv9 =a_Tmpv11
2667    a_Tmpv10 =a_Tmpv11
2668    a_ss12e(i,k,j) =a_ss12e(i,k,j) +rr23e(i,k,j)*a_Tmpv10
2669    a_rr23e(i,k,j) =a_rr23e(i,k,j) +ss12e(i,k,j)*a_Tmpv10
2670    a_ss11e(i,k,j) =a_ss11e(i,k,j) +rr13(i,k,j)*a_Tmpv9
2671    a_rr13(i,k,j) =a_rr13(i,k,j) +ss11e(i,k,j)*a_Tmpv9
2672    a_Tmpv1 =a_Tmpv8
2673    a_Tmpv7 =a_Tmpv8
2674    a_Tmpv6 =c1*a_Tmpv7
2675    a_Tmpv4 =a_Tmpv6
2676    a_Tmpv5 =a_Tmpv6
2677    a_ss13(i,k,j) =a_ss13(i,k,j) +ss33e(i,k,j)*a_Tmpv5
2678    a_ss33e(i,k,j) =a_ss33e(i,k,j) +ss13(i,k,j)*a_Tmpv5
2679    a_Tmpv2 =a_Tmpv4
2680    a_Tmpv3 =a_Tmpv4
2681    a_ss12e(i,k,j) =a_ss12e(i,k,j) +ss23e(i,k,j)*a_Tmpv3
2682    a_ss23e(i,k,j) =a_ss23e(i,k,j) +ss12e(i,k,j)*a_Tmpv3
2683    a_ss11e(i,k,j) =a_ss11e(i,k,j) +ss13(i,k,j)*a_Tmpv2
2684    a_ss13(i,k,j) =a_ss13(i,k,j) +ss11e(i,k,j)*a_Tmpv2
2685    a_smnsmne(i,k,j) =a_smnsmne(i,k,j) +2.0*g_Sqrt(2.0, 2.0*smnsmne(i,k,j))  &
2686    *ss13(i,k,j)*a_Tmpv1
2687    a_ss13(i,k,j) =a_ss13(i,k,j) +2.0*sqrt(2.0*smnsmne(i,k,j))*a_Tmpv1
2689    a_delta =a_delta -1.0*2.0*(cs*delta)*cs*a_a
2690    a_a =0.0
2691    a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx*  &
2692    dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta
2693    a_delta =0.0
2694    ENDDO
2695    ENDDO
2696    ENDDO
2698    ELSE
2700    DO j =j_end, j_start, -1
2701    DO k =ktf, kts+1, -1
2702    DO i =i_end, i_start, -1
2703    a =Tmpv402(i,k,j)
2704    b =Tmpv403(i,k,j)
2706    a_Tmpv19 =a_m13(i,k,j)
2707    a_m13(i,k,j) =0.0
2708    a_a =a_a +Tmpv405(i,k,j)*a_Tmpv19
2709    a_Tmpv18 =a*a_Tmpv19
2710    a_Tmpv1 =a_Tmpv18
2711    a_Tmpv17 =a_Tmpv18
2712    a_b =a_b +Tmpv404(i,k,j)*a_Tmpv17
2713    a_Tmpv16 =b*a_Tmpv17
2714    a_Tmpv7 =a_Tmpv16
2715    a_Tmpv15 =a_Tmpv16
2716    a_Tmpv14 =c2*a_Tmpv15
2717    a_Tmpv12 =a_Tmpv14
2718    a_Tmpv13 =-a_Tmpv14
2719    a_ss33e(i,k,j) =a_ss33e(i,k,j) +rr13(i,k,j)*a_Tmpv13
2720    a_rr13(i,k,j) =a_rr13(i,k,j) +ss33e(i,k,j)*a_Tmpv13
2721    a_Tmpv10 =a_Tmpv12
2722    a_Tmpv11 =-a_Tmpv12
2723    a_ss23e(i,k,j) =a_ss23e(i,k,j) +rr12e(i,k,j)*a_Tmpv11
2724    a_rr12e(i,k,j) =a_rr12e(i,k,j) +ss23e(i,k,j)*a_Tmpv11
2725    a_Tmpv8 =a_Tmpv10
2726    a_Tmpv9 =a_Tmpv10
2727    a_ss12e(i,k,j) =a_ss12e(i,k,j) +rr23e(i,k,j)*a_Tmpv9
2728    a_rr23e(i,k,j) =a_rr23e(i,k,j) +ss12e(i,k,j)*a_Tmpv9
2729    a_ss11e(i,k,j) =a_ss11e(i,k,j) +rr13(i,k,j)*a_Tmpv8
2730    a_rr13(i,k,j) =a_rr13(i,k,j) +ss11e(i,k,j)*a_Tmpv8
2731    a_Tmpv6 =c1*a_Tmpv7
2732    a_Tmpv4 =a_Tmpv6
2733    a_Tmpv5 =a_Tmpv6
2734    a_ss13(i,k,j) =a_ss13(i,k,j) +ss33e(i,k,j)*a_Tmpv5
2735    a_ss33e(i,k,j) =a_ss33e(i,k,j) +ss13(i,k,j)*a_Tmpv5
2736    a_Tmpv2 =a_Tmpv4
2737    a_Tmpv3 =a_Tmpv4
2738    a_ss12e(i,k,j) =a_ss12e(i,k,j) +ss23e(i,k,j)*a_Tmpv3
2739    a_ss23e(i,k,j) =a_ss23e(i,k,j) +ss12e(i,k,j)*a_Tmpv3
2740    a_ss11e(i,k,j) =a_ss11e(i,k,j) +ss13(i,k,j)*a_Tmpv2
2741    a_ss13(i,k,j) =a_ss13(i,k,j) +ss11e(i,k,j)*a_Tmpv2
2742    a_tkee(i,k,j) =a_tkee(i,k,j) +2.0*g_Sqrt(1.0, tkee(i,k,j))*ss13(i,k,j)*a_Tmpv1
2743    a_ss13(i,k,j) =a_ss13(i,k,j) +2.0*sqrt(tkee(i,k,j))*a_Tmpv1
2745    a_delta =a_delta +c3*a_b
2746    a_b =0.0
2748    a_delta =a_delta -1.0*ce*a_a
2749    a_a =0.0
2750    a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx*  &
2751    dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta
2752    a_delta =0.0
2753    ENDDO
2754    ENDDO
2755    ENDDO
2757    ENDIF
2759 !LPB[15]
2761 !LPB[14]
2762    DO j =j_end, j_start, -1
2764 !  DO k =kts+1, ktf
2765 !  DO i =i_start, i_end
2766 !  Tmpv001 =tke(i,k,j) +tke(i-1,k,j)
2767 !  Tmpv002 =fnm(k)*Tmpv001
2768 !  Tmpv003 =tke(i,k-1,j) +tke(i-1,k-1,j)
2769 !  Tmpv004 =fnp(k)*Tmpv003
2770 !  Tmpv005 =Tmpv002 +Tmpv004
2771 !  Tmpv006 =0.5*Tmpv005
2772 !  tkee(i,k,j) =Tmpv006
2774 !  Tmpv001 =smnsmn(i,k,j) +smnsmn(i-1,k,j)
2775 !  Tmpv002 =fnm(k)*Tmpv001
2776 !  Tmpv003 =smnsmn(i,k-1,j) +smnsmn(i-1,k-1,j)
2777 !  Tmpv004 =fnp(k)*Tmpv003
2778 !  Tmpv005 =Tmpv002 +Tmpv004
2779 !  Tmpv006 =0.5*Tmpv005
2780 !  smnsmne(i,k,j) =Tmpv006
2782 !  Tmpv001 =ss11(i,k,j) +ss11(i-1,k,j)
2783 !  Tmpv002 =fnm(k)*Tmpv001
2784 !  Tmpv003 =ss11(i,k-1,j) +ss11(i-1,k-1,j)
2785 !  Tmpv004 =fnp(k)*Tmpv003
2786 !  Tmpv005 =Tmpv002 +Tmpv004
2787 !  Tmpv006 =0.5*Tmpv005
2788 !  ss11e(i,k,j) =Tmpv006
2790 !  Tmpv001 =ss33(i,k,j) +ss33(i-1,k,j)
2791 !  Tmpv002 =fnm(k)*Tmpv001
2792 !  Tmpv003 =ss33(i,k-1,j) +ss33(i-1,k-1,j)
2793 !  Tmpv004 =fnp(k)*Tmpv003
2794 !  Tmpv005 =Tmpv002 +Tmpv004
2795 !  Tmpv006 =0.5*Tmpv005
2796 !  ss33e(i,k,j) =Tmpv006
2798 !  Tmpv001 =ss12(i,k,j) +ss12(i,k,j+1)
2799 !  Tmpv002 =fnm(k)*Tmpv001
2800 !  Tmpv003 =ss12(i,k-1,j) +ss12(i,k-1,j+1)
2801 !  Tmpv004 =fnp(k)*Tmpv003
2802 !  Tmpv005 =Tmpv002 +Tmpv004
2803 !  Tmpv006 =0.5*Tmpv005
2804 !  ss12e(i,k,j) =Tmpv006
2806 !  Tmpv001 =rr12(i,k,j) +rr12(i,k,j+1)
2807 !  Tmpv002 =fnm(k)*Tmpv001
2808 !  Tmpv003 =rr12(i,k-1,j) +rr12(i,k-1,j+1)
2809 !  Tmpv004 =fnp(k)*Tmpv003
2810 !  Tmpv005 =Tmpv002 +Tmpv004
2811 !  Tmpv006 =0.5*Tmpv005
2812 !  rr12e(i,k,j) =Tmpv006
2814 !  Tmpv001 =ss23(i,k,j) +ss23(i,k,j+1)
2815 !  Tmpv002 =Tmpv001 +ss23(i-1,k,j)
2816 !  Tmpv003 =Tmpv002 +ss23(i-1,k,j+1)
2817 !  Tmpv004 =0.25*Tmpv003
2818 !  ss23e(i,k,j) =Tmpv004
2820 !  Tmpv001 =rr23(i,k,j) +rr23(i,k,j+1)
2821 !  Tmpv002 =Tmpv001 +rr23(i-1,k,j)
2822 !  Tmpv003 =Tmpv002 +rr23(i-1,k,j+1)
2823 !  Tmpv004 =0.25*Tmpv003
2824 !  rr23e(i,k,j) =Tmpv004
2826 !  ENDDO
2827 !  ENDDO
2829    DO k =ktf, kts+1, -1
2830    DO i =i_end, i_start, -1
2831    a_Tmpv4 =a_rr23e(i,k,j)
2832    a_rr23e(i,k,j) =0.0
2833    a_Tmpv3 =0.25*a_Tmpv4
2834    a_Tmpv2 =a_Tmpv3
2835    a_rr23(i-1,k,j+1) =a_rr23(i-1,k,j+1) +a_Tmpv3
2836    a_Tmpv1 =a_Tmpv2
2837    a_rr23(i-1,k,j) =a_rr23(i-1,k,j) +a_Tmpv2
2838    a_rr23(i,k,j) =a_rr23(i,k,j) +a_Tmpv1
2839    a_rr23(i,k,j+1) =a_rr23(i,k,j+1) +a_Tmpv1
2840    a_Tmpv4 =a_ss23e(i,k,j)
2841    a_ss23e(i,k,j) =0.0
2842    a_Tmpv3 =0.25*a_Tmpv4
2843    a_Tmpv2 =a_Tmpv3
2844    a_ss23(i-1,k,j+1) =a_ss23(i-1,k,j+1) +a_Tmpv3
2845    a_Tmpv1 =a_Tmpv2
2846    a_ss23(i-1,k,j) =a_ss23(i-1,k,j) +a_Tmpv2
2847    a_ss23(i,k,j) =a_ss23(i,k,j) +a_Tmpv1
2848    a_ss23(i,k,j+1) =a_ss23(i,k,j+1) +a_Tmpv1
2849    a_Tmpv6 =a_rr12e(i,k,j)
2850    a_rr12e(i,k,j) =0.0
2851    a_Tmpv5 =0.5*a_Tmpv6
2852    a_Tmpv2 =a_Tmpv5
2853    a_Tmpv4 =a_Tmpv5
2854    a_Tmpv3 =fnp(k)*a_Tmpv4
2855    a_rr12(i,k-1,j) =a_rr12(i,k-1,j) +a_Tmpv3
2856    a_rr12(i,k-1,j+1) =a_rr12(i,k-1,j+1) +a_Tmpv3
2857    a_Tmpv1 =fnm(k)*a_Tmpv2
2858    a_rr12(i,k,j) =a_rr12(i,k,j) +a_Tmpv1
2859    a_rr12(i,k,j+1) =a_rr12(i,k,j+1) +a_Tmpv1
2860    a_Tmpv6 =a_ss12e(i,k,j)
2861    a_ss12e(i,k,j) =0.0
2862    a_Tmpv5 =0.5*a_Tmpv6
2863    a_Tmpv2 =a_Tmpv5
2864    a_Tmpv4 =a_Tmpv5
2865    a_Tmpv3 =fnp(k)*a_Tmpv4
2866    a_ss12(i,k-1,j) =a_ss12(i,k-1,j) +a_Tmpv3
2867    a_ss12(i,k-1,j+1) =a_ss12(i,k-1,j+1) +a_Tmpv3
2868    a_Tmpv1 =fnm(k)*a_Tmpv2
2869    a_ss12(i,k,j) =a_ss12(i,k,j) +a_Tmpv1
2870    a_ss12(i,k,j+1) =a_ss12(i,k,j+1) +a_Tmpv1
2871    a_Tmpv6 =a_ss33e(i,k,j)
2872    a_ss33e(i,k,j) =0.0
2873    a_Tmpv5 =0.5*a_Tmpv6
2874    a_Tmpv2 =a_Tmpv5
2875    a_Tmpv4 =a_Tmpv5
2876    a_Tmpv3 =fnp(k)*a_Tmpv4
2877    a_ss33(i,k-1,j) =a_ss33(i,k-1,j) +a_Tmpv3
2878    a_ss33(i-1,k-1,j) =a_ss33(i-1,k-1,j) +a_Tmpv3
2879    a_Tmpv1 =fnm(k)*a_Tmpv2
2880    a_ss33(i,k,j) =a_ss33(i,k,j) +a_Tmpv1
2881    a_ss33(i-1,k,j) =a_ss33(i-1,k,j) +a_Tmpv1
2882    a_Tmpv6 =a_ss11e(i,k,j)
2883    a_ss11e(i,k,j) =0.0
2884    a_Tmpv5 =0.5*a_Tmpv6
2885    a_Tmpv2 =a_Tmpv5
2886    a_Tmpv4 =a_Tmpv5
2887    a_Tmpv3 =fnp(k)*a_Tmpv4
2888    a_ss11(i,k-1,j) =a_ss11(i,k-1,j) +a_Tmpv3
2889    a_ss11(i-1,k-1,j) =a_ss11(i-1,k-1,j) +a_Tmpv3
2890    a_Tmpv1 =fnm(k)*a_Tmpv2
2891    a_ss11(i,k,j) =a_ss11(i,k,j) +a_Tmpv1
2892    a_ss11(i-1,k,j) =a_ss11(i-1,k,j) +a_Tmpv1
2893    a_Tmpv6 =a_smnsmne(i,k,j)
2894    a_smnsmne(i,k,j) =0.0
2895    a_Tmpv5 =0.5*a_Tmpv6
2896    a_Tmpv2 =a_Tmpv5
2897    a_Tmpv4 =a_Tmpv5
2898    a_Tmpv3 =fnp(k)*a_Tmpv4
2899    a_smnsmn(i,k-1,j) =a_smnsmn(i,k-1,j) +a_Tmpv3
2900    a_smnsmn(i-1,k-1,j) =a_smnsmn(i-1,k-1,j) +a_Tmpv3
2901    a_Tmpv1 =fnm(k)*a_Tmpv2
2902    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +a_Tmpv1
2903    a_smnsmn(i-1,k,j) =a_smnsmn(i-1,k,j) +a_Tmpv1
2904    a_Tmpv6 =a_tkee(i,k,j)
2905    a_tkee(i,k,j) =0.0
2906    a_Tmpv5 =0.5*a_Tmpv6
2907    a_Tmpv2 =a_Tmpv5
2908    a_Tmpv4 =a_Tmpv5
2909    a_Tmpv3 =fnp(k)*a_Tmpv4
2910    a_tke(i,k-1,j) =a_tke(i,k-1,j) +a_Tmpv3
2911    a_tke(i-1,k-1,j) =a_tke(i-1,k-1,j) +a_Tmpv3
2912    a_Tmpv1 =fnm(k)*a_Tmpv2
2913    a_tke(i,k,j) =a_tke(i,k,j) +a_Tmpv1
2914    a_tke(i-1,k,j) =a_tke(i-1,k,j) +a_Tmpv1
2915    ENDDO
2916    ENDDO
2918    ENDDO
2920 !LPB[13]
2921    DO j =j_end+1, j_start, -1
2923 !  DO k =kts, ktf
2924 !  DO i =i_start-1, i_end
2925 !  ss11(i,k,j) =s11(i,k,j)/2.0
2927 !  ss33(i,k,j) =s33(i,k,j)/2.0
2929 !  ss12(i,k,j) =s12(i,k,j)/2.0
2931 !  ss13(i,k,j) =s13(i,k,j)/2.0
2933 !  ss23(i,k,j) =s23(i,k,j)/2.0
2935 !  rr12(i,k,j) =r12(i,k,j)/2.0
2937 !  rr13(i,k,j) =r13(i,k,j)/2.0
2939 !  rr23(i,k,j) =r23(i,k,j)/2.0
2941 !  ENDDO
2942 !  ENDDO
2944    DO k =ktf, kts, -1
2945    DO i =i_end, i_start-1, -1
2946    a_r23(i,k,j) =a_r23(i,k,j) +1.0/2.0*a_rr23(i,k,j)
2947    a_rr23(i,k,j) =0.0
2948    a_r13(i,k,j) =a_r13(i,k,j) +1.0/2.0*a_rr13(i,k,j)
2949    a_rr13(i,k,j) =0.0
2950    a_r12(i,k,j) =a_r12(i,k,j) +1.0/2.0*a_rr12(i,k,j)
2951    a_rr12(i,k,j) =0.0
2952    a_s23(i,k,j) =a_s23(i,k,j) +1.0/2.0*a_ss23(i,k,j)
2953    a_ss23(i,k,j) =0.0
2954    a_s13(i,k,j) =a_s13(i,k,j) +1.0/2.0*a_ss13(i,k,j)
2955    a_ss13(i,k,j) =0.0
2956    a_s12(i,k,j) =a_s12(i,k,j) +1.0/2.0*a_ss12(i,k,j)
2957    a_ss12(i,k,j) =0.0
2958    a_s33(i,k,j) =a_s33(i,k,j) +1.0/2.0*a_ss33(i,k,j)
2959    a_ss33(i,k,j) =0.0
2960    a_s11(i,k,j) =a_s11(i,k,j) +1.0/2.0*a_ss11(i,k,j)
2961    a_ss11(i,k,j) =0.0
2962    ENDDO
2963    ENDDO
2965    ENDDO
2967 !LPB[12]
2968 !  ie_ext =1
2969 !  i_end =i_end+ie_ext
2971 !LPB[11]
2973 !  IF( config_flags%periodic_x ) THEN
2974 !  i_end =ite
2975 !  END IF
2977 !  IF( config_flags%periodic_x ) THEN
2979 !  END IF
2981 !LPB[10]
2983 !LPB[9]
2985 !  IF( config_flags%periodic_x ) THEN
2986 !  i_start =its
2987 !  END IF
2989 !  IF( config_flags%periodic_x ) THEN
2991 !  END IF
2993 !LPB[8]
2995 !LPB[7]
2997 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.             config_flags%nested) THEN
2998 !  j_end =min(jde-2, jte)
2999 !  END IF
3001 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
3002 !            config_flags%nested) THEN
3004 !  END IF
3006 !LPB[6]
3008 !LPB[5]
3010 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested) THEN
3011 !  j_start =max(jds+1, jts)
3012 !  END IF
3014 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
3015 !            config_flags%nested) THEN
3017 !  END IF
3019 !LPB[4]
3021 !LPB[3]
3023 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.             config_flags%nested) THEN
3024 !  i_end =min(ide-1, ite)
3025 !  END IF
3027 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
3028 !            config_flags%nested) THEN
3030 !  END IF
3032 !LPB[2]
3034 !LPB[1]
3036 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested) THEN
3037 !  i_start =max(ids+1, its)
3038 !  END IF
3040 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
3041 !            config_flags%nested) THEN
3043 !  END IF
3045 !LPB[0]
3046 !  ktf =min(kte, kde-1)
3047 !  i_start =its
3048 !  i_end =ite
3049 !  j_start =jts
3050 !  j_end =min(jte, jde-1)
3052    Return
3053         END SUBROUTINE a_calc_m13
3055    SUBROUTINE a_calc_m23(m23,a_m23,s22,a_s22,s33,a_s33,s12,a_s12,s13,a_s13, &
3056    s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23,smnsmn,a_smnsmn,tke,a_tke,rdzw, &
3057    a_rdzw,dx,dy,fnm,fnp,config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
3058    ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
3060 !PART I: DECLARATION OF VARIABLES
3062    IMPLICIT NONE
3064    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
3065    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: m23,a_m23
3066    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s22,a_s22,s33,a_s33,s12,a_s12,s13, &
3067    a_s13,s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23,smnsmn,a_smnsmn,tke, &
3068    a_tke,rdzw,a_rdzw
3069    REAL :: dx,dy
3070    REAL,DIMENSION(kms:kme) :: fnm,fnp
3071    TYPE(grid_config_rec_type) :: config_flags
3072    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, &
3073    its,ite,jts,jte,kts,kte
3074    REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss22,a_ss22,ss33,a_ss33,ss12, &
3075    a_ss12,ss13,a_ss13,ss23,a_ss23,rr12,a_rr12,rr13,a_rr13,rr23,a_rr23
3076    REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: tkef,a_tkef,ss22f,a_ss22f, &
3077    ss33f,a_ss33f,ss12f,a_ss12f,ss13f,a_ss13f,rr12f,a_rr12f,rr13f,a_rr13f, &
3078    smnsmnf,a_smnsmnf
3079    REAL :: delta,a_delta,a,a_a,b,a_b
3080    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf,je_ext
3082    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
3083    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9, &
3084    Tmpv009,a_Tmpv10,Tmpv010,a_Tmpv11,Tmpv011,a_Tmpv12,Tmpv012,a_Tmpv13,Tmpv013, &
3085    a_Tmpv14,Tmpv014,a_Tmpv15,Tmpv015,a_Tmpv16,Tmpv016,a_Tmpv17,Tmpv017, &
3086    a_Tmpv18,Tmpv018,a_Tmpv19,Tmpv019
3087    REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) &
3088     :: Tmpv400
3089    REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) &
3090     :: Tmpv401
3091    REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) &
3092     :: Tmpv402
3093    REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) &
3094     :: Tmpv403
3095    REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) &
3096     :: Tmpv404
3097    REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) &
3098     :: Tmpv405
3100    REAL :: g_Sqrt
3102 !PART II: CALCULATIONS OF B. S. TRAJECTORY
3104 !LPB[0]
3106      ktf = MIN( kte, kde-1 )
3107      i_start = its
3108      i_end   = MIN( ite, ide-1 )
3109      j_start = jts
3110      j_end   = jte
3112 !LPB[1]
3113     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
3114          config_flags%nested) i_start = MAX( ids+1, its )
3116 !LPB[2]
3118 !LPB[3]
3119     IF ( config_flags%open_xe .OR. config_flags%specified .OR.   &
3120          config_flags%nested) i_end   = MIN( ide-2, ite )
3122 !LPB[4]
3124 !LPB[5]
3125     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
3126          config_flags%nested) j_start = MAX( jds+1, jts )
3128 !LPB[6]
3130 !LPB[7]
3131     IF ( config_flags%open_ye .OR. config_flags%specified .OR.   &
3132          config_flags%nested) j_end   = MIN( jde-1, jte )
3134 !LPB[8]
3136 !LPB[9]
3137       IF ( config_flags%periodic_x ) i_start = its
3139 !LPB[10]
3141 !LPB[11]
3142       IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
3144 !LPB[12]
3145      je_ext = 1
3146      j_end = j_end + je_ext   
3148 !LPB[13]
3149      DO j=j_start-1,j_end
3151      DO k=kts,ktf
3152      DO i=i_start,i_end+1
3153        ss22(i,k,j)=s22(i,k,j)/2.0
3154        ss33(i,k,j)=s33(i,k,j)/2.0
3155        ss12(i,k,j)=s12(i,k,j)/2.0
3156        ss13(i,k,j)=s13(i,k,j)/2.0
3157        ss23(i,k,j)=s23(i,k,j)/2.0
3158        rr12(i,k,j)=r12(i,k,j)/2.0
3159        rr13(i,k,j)=r13(i,k,j)/2.0
3160        rr23(i,k,j)=r23(i,k,j)/2.0
3161      END DO
3162      END DO
3164      END DO
3166 !LPB[14]
3167      DO j = j_start, j_end
3169      DO k = kts+1, ktf
3170      DO i = i_start, i_end
3171        tkef(i,k,j) = 0.5*( fnm(k)*( tke(i  ,k  ,j  ) + tke(i  ,k  ,j-1) ) +   &
3172                            fnp(k)*( tke(i  ,k-1,j  ) + tke(i  ,k-1,j-1) ) )
3173        smnsmnf(i,k,j) = 0.5*( fnm(k)*( smnsmn(i  ,k  ,j  ) + smnsmn(i  ,k  ,j-1) ) +   &
3174                               fnp(k)*( smnsmn(i  ,k-1,j  ) + smnsmn(i  ,k-1,j-1) ) )
3175        ss22f(i,k,j) = 0.5*( fnm(k)*( ss22(i  ,k  ,j  ) + ss22(i  ,k  ,j-1) ) +   &
3176                             fnp(k)*( ss22(i  ,k-1,j  ) + ss22(i  ,k-1,j-1) ) )
3177        ss33f(i,k,j) = 0.5*( fnm(k)*( ss33(i  ,k  ,j  ) + ss33(i  ,k  ,j-1) ) +   &
3178                             fnp(k)*( ss33(i  ,k-1,j  ) + ss33(i  ,k-1,j-1) ) )
3179        ss12f(i,k,j) = 0.5*( fnm(k)*( ss12(i  ,k  ,j  ) + ss12(i+1,k  ,j  ) ) +   &
3180                             fnp(k)*( ss12(i  ,k-1,j  ) + ss12(i+1,k-1,j  ) ) )
3181        rr12f(i,k,j) = 0.5*( fnm(k)*( rr12(i  ,k  ,j  ) + rr12(i+1,k  ,j  ) ) +   &
3182                             fnp(k)*( rr12(i  ,k-1,j  ) + rr12(i+1,k-1,j  ) ) )
3183        ss13f(i,k,j) = 0.25*( ss13(i  ,k  ,j  ) + ss13(i  ,k  ,j-1) +   &
3184                              ss13(i+1,k  ,j-1) + ss13(i+1,k  ,j  ) )
3185        rr13f(i,k,j) = 0.25*( rr13(i  ,k  ,j  ) + rr13(i  ,k  ,j-1) +   &
3186                              rr13(i+1,k  ,j-1) + rr13(i+1,k  ,j  ) )
3187      END DO
3188      END DO
3190      END DO
3192 !LPB[15]
3194 !!LPB[16]
3195 !  IF ( config_flags%sfs_opt .EQ. 1 ) THEN
3197 !       DO j=j_start,j_end
3198 !       DO k=kts+1,ktf
3199 !       DO i=i_start,i_end
3200 !         delta = ( dx * dy / rdzw(i,k,j) )**0.33333333
3201 !         a = -1.0*( cs*delta )**2
3202 !         m23(i,k,j) = a*(   2.0*sqrt( 2.0*smnsmnf(i,k,j) )*ss23(i,k,j)   &
3203 !                          + c1*(   ss12f(i,k,j)*ss13f(i,k,j)             &
3204 !                                 + ss22f(i,k,j)*ss23(i,k,j)              &
3205 !                                 + ss23(i,k,j) *ss33f(i,k,j)             &
3206 !                                )                                        &
3207 !                          + c2*(   ss12f(i,k,j)*rr13f(i,k,j)             &
3208 !                                 + ss22f(i,k,j)*rr23(i,k,j)              &
3209 !                                 + ss13f(i,k,j)*rr12f(i,k,j)             &
3210 !                                 - ss33f(i,k,j)*rr23(i,k,j)              &
3211 !                               )                                         &
3212 !                        )
3213 !       ENDDO
3214 !       ENDDO
3215 !       ENDDO
3216 !     ELSE
3218 !       DO j=j_start,j_end
3219 !       DO k=kts+1,ktf
3220 !       DO i=i_start,i_end
3221 !         delta = ( dx * dy / rdzw(i,k,j) )**0.33333333
3222 !         a = -1.0*ce*delta
3223 !         b = c3*delta
3224 !         m23(i,k,j) = a*(   2.0*sqrt( tkef(i,k,j) )*ss23(i,k,j)      &
3225 !                          + b*(                                      &
3226 !                                  c1*(   ss12f(i,k,j)*ss13f(i,k,j)   &
3227 !                                       + ss22f(i,k,j)*ss23(i,k,j)    &
3228 !                                       + ss23(i,k,j) *ss33f(i,k,j)   &
3229 !                                     )                               &
3230 !                                + c2*(   ss12f(i,k,j)*rr13f(i,k,j)   &
3231 !                                       + ss22f(i,k,j)*rr23(i,k,j)    &
3232 !                                       + ss13f(i,k,j)*rr12f(i,k,j)   &
3233 !                                       - ss33f(i,k,j)*rr23(i,k,j)    &
3234 !                                     )                               &
3235 !                              )                                      &
3236 !                        )
3237 !       ENDDO
3238 !       ENDDO
3239 !       ENDDO
3241 !   ENDIF
3243 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
3245    Do K2_ADJ =jts-1, jte+1
3246    Do K1_ADJ =kms, kme
3247    Do K0_ADJ =its-1, ite+1
3248    a_ss22(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3249    End Do
3250    End Do
3251    End Do
3253    Do K2_ADJ =jts-1, jte+1
3254    Do K1_ADJ =kms, kme
3255    Do K0_ADJ =its-1, ite+1
3256    a_ss33(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3257    End Do
3258    End Do
3259    End Do
3261    Do K2_ADJ =jts-1, jte+1
3262    Do K1_ADJ =kms, kme
3263    Do K0_ADJ =its-1, ite+1
3264    a_ss12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3265    End Do
3266    End Do
3267    End Do
3269    Do K2_ADJ =jts-1, jte+1
3270    Do K1_ADJ =kms, kme
3271    Do K0_ADJ =its-1, ite+1
3272    a_ss13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3273    End Do
3274    End Do
3275    End Do
3277    Do K2_ADJ =jts-1, jte+1
3278    Do K1_ADJ =kms, kme
3279    Do K0_ADJ =its-1, ite+1
3280    a_ss23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3281    End Do
3282    End Do
3283    End Do
3285    Do K2_ADJ =jts-1, jte+1
3286    Do K1_ADJ =kms, kme
3287    Do K0_ADJ =its-1, ite+1
3288    a_rr12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3289    End Do
3290    End Do
3291    End Do
3293    Do K2_ADJ =jts-1, jte+1
3294    Do K1_ADJ =kms, kme
3295    Do K0_ADJ =its-1, ite+1
3296    a_rr13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3297    End Do
3298    End Do
3299    End Do
3301    Do K2_ADJ =jts-1, jte+1
3302    Do K1_ADJ =kms, kme
3303    Do K0_ADJ =its-1, ite+1
3304    a_rr23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3305    End Do
3306    End Do
3307    End Do
3309    Do K2_ADJ =jts-1, jte+1
3310    Do K1_ADJ =kms, kme
3311    Do K0_ADJ =its-1, ite+1
3312    a_tkef(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3313    End Do
3314    End Do
3315    End Do
3317    Do K2_ADJ =jts-1, jte+1
3318    Do K1_ADJ =kms, kme
3319    Do K0_ADJ =its-1, ite+1
3320    a_ss22f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3321    End Do
3322    End Do
3323    End Do
3325    Do K2_ADJ =jts-1, jte+1
3326    Do K1_ADJ =kms, kme
3327    Do K0_ADJ =its-1, ite+1
3328    a_ss33f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3329    End Do
3330    End Do
3331    End Do
3333    Do K2_ADJ =jts-1, jte+1
3334    Do K1_ADJ =kms, kme
3335    Do K0_ADJ =its-1, ite+1
3336    a_ss12f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3337    End Do
3338    End Do
3339    End Do
3341    Do K2_ADJ =jts-1, jte+1
3342    Do K1_ADJ =kms, kme
3343    Do K0_ADJ =its-1, ite+1
3344    a_ss13f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3345    End Do
3346    End Do
3347    End Do
3349    Do K2_ADJ =jts-1, jte+1
3350    Do K1_ADJ =kms, kme
3351    Do K0_ADJ =its-1, ite+1
3352    a_rr12f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3353    End Do
3354    End Do
3355    End Do
3357    Do K2_ADJ =jts-1, jte+1
3358    Do K1_ADJ =kms, kme
3359    Do K0_ADJ =its-1, ite+1
3360    a_rr13f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3361    End Do
3362    End Do
3363    End Do
3365    Do K2_ADJ =jts-1, jte+1
3366    Do K1_ADJ =kms, kme
3367    Do K0_ADJ =its-1, ite+1
3368    a_smnsmnf(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3369    End Do
3370    End Do
3371    End Do
3373    a_delta =0.0
3374    a_a =0.0
3375    a_b =0.0
3377 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
3379 !LPB[16]
3381    IF( config_flags%sfs_opt .EQ. 1 ) THEN
3382    DO j =j_start, j_end
3383    DO k =kts+1, ktf
3384    DO i =i_start, i_end
3385    delta =(dx*dy/rdzw(i,k,j))**0.33333333
3387    a =-1.0*(cs*delta)**2
3388    Tmpv400(i,k,j) =a
3390    Tmpv001 =2.0*sqrt(2.0*smnsmnf(i,k,j))*ss23(i,k,j)
3391    Tmpv002 =ss12f(i,k,j)*ss13f(i,k,j)
3392    Tmpv003 =ss22f(i,k,j)*ss23(i,k,j)
3393    Tmpv004 =Tmpv002 +Tmpv003
3394    Tmpv005 =ss23(i,k,j)*ss33f(i,k,j)
3395    Tmpv006 =Tmpv004 +Tmpv005
3396    Tmpv007 =c1*Tmpv006
3397    Tmpv008 =Tmpv001 +Tmpv007
3398    Tmpv009 =ss12f(i,k,j)*rr13f(i,k,j)
3399    Tmpv010 =ss22f(i,k,j)*rr23(i,k,j)
3400    Tmpv011 =Tmpv009 +Tmpv010
3401    Tmpv012 =ss13f(i,k,j)*rr12f(i,k,j)
3402    Tmpv013 =Tmpv011 +Tmpv012
3403    Tmpv014 =ss33f(i,k,j)*rr23(i,k,j)
3404    Tmpv015 =Tmpv013 -Tmpv014
3405    Tmpv016 =c2*Tmpv015
3406    Tmpv017 =Tmpv008 +Tmpv016
3407    Tmpv401(i,k,j) =Tmpv017
3408    Tmpv018 =a*Tmpv401(i,k,j)
3409    m23(i,k,j) =Tmpv018
3411    ENDDO
3412    ENDDO
3413    ENDDO
3414    ELSE
3415    DO j =j_start, j_end
3416    DO k =kts+1, ktf
3417    DO i =i_start, i_end
3418    delta =(dx*dy/rdzw(i,k,j))**0.33333333
3420    a =-1.0*ce*delta
3421    Tmpv402(i,k,j) =a
3423    b =c3*delta
3424    Tmpv403(i,k,j) =b
3426    Tmpv001 =2.0*sqrt(tkef(i,k,j))*ss23(i,k,j)
3427    Tmpv002 =ss12f(i,k,j)*ss13f(i,k,j)
3428    Tmpv003 =ss22f(i,k,j)*ss23(i,k,j)
3429    Tmpv004 =Tmpv002 +Tmpv003
3430    Tmpv005 =ss23(i,k,j)*ss33f(i,k,j)
3431    Tmpv006 =Tmpv004 +Tmpv005
3432    Tmpv007 =c1*Tmpv006
3433    Tmpv008 =ss12f(i,k,j)*rr13f(i,k,j)
3434    Tmpv009 =ss22f(i,k,j)*rr23(i,k,j)
3435    Tmpv010 =Tmpv008 +Tmpv009
3436    Tmpv011 =ss13f(i,k,j)*rr12f(i,k,j)
3437    Tmpv012 =Tmpv010 +Tmpv011
3438    Tmpv013 =ss33f(i,k,j)*rr23(i,k,j)
3439    Tmpv014 =Tmpv012 -Tmpv013
3440    Tmpv015 =c2*Tmpv014
3441    Tmpv016 =Tmpv007 +Tmpv015
3442    Tmpv404(i,k,j) =Tmpv016
3443    Tmpv017 =b*Tmpv404(i,k,j)
3444    Tmpv018 =Tmpv001 +Tmpv017
3445    Tmpv405(i,k,j) =Tmpv018
3446    Tmpv019 =a*Tmpv405(i,k,j)
3447    m23(i,k,j) =Tmpv019
3449    ENDDO
3450    ENDDO
3451    ENDDO
3452    ENDIF
3454    IF( config_flags%sfs_opt .EQ. 1 ) THEN
3456    DO j =j_end, j_start, -1
3457    DO k =ktf, kts+1, -1
3458    DO i =i_end, i_start, -1
3459 !ADDED BY WALLS
3460    delta =(dx*dy/rdzw(i,k,j))**0.33333333
3461    a =Tmpv400(i,k,j)
3463    a_Tmpv18 =a_m23(i,k,j)
3464    a_m23(i,k,j) =0.0
3465    a_a =a_a +Tmpv401(i,k,j)*a_Tmpv18
3466    a_Tmpv17 =a*a_Tmpv18
3467    a_Tmpv8 =a_Tmpv17
3468    a_Tmpv16 =a_Tmpv17
3469    a_Tmpv15 =c2*a_Tmpv16
3470    a_Tmpv13 =a_Tmpv15
3471    a_Tmpv14 =-a_Tmpv15
3472    a_ss33f(i,k,j) =a_ss33f(i,k,j) +rr23(i,k,j)*a_Tmpv14
3473    a_rr23(i,k,j) =a_rr23(i,k,j) +ss33f(i,k,j)*a_Tmpv14
3474    a_Tmpv11 =a_Tmpv13
3475    a_Tmpv12 =a_Tmpv13
3476    a_ss13f(i,k,j) =a_ss13f(i,k,j) +rr12f(i,k,j)*a_Tmpv12
3477    a_rr12f(i,k,j) =a_rr12f(i,k,j) +ss13f(i,k,j)*a_Tmpv12
3478    a_Tmpv9 =a_Tmpv11
3479    a_Tmpv10 =a_Tmpv11
3480    a_ss22f(i,k,j) =a_ss22f(i,k,j) +rr23(i,k,j)*a_Tmpv10
3481    a_rr23(i,k,j) =a_rr23(i,k,j) +ss22f(i,k,j)*a_Tmpv10
3482    a_ss12f(i,k,j) =a_ss12f(i,k,j) +rr13f(i,k,j)*a_Tmpv9
3483    a_rr13f(i,k,j) =a_rr13f(i,k,j) +ss12f(i,k,j)*a_Tmpv9
3484    a_Tmpv1 =a_Tmpv8
3485    a_Tmpv7 =a_Tmpv8
3486    a_Tmpv6 =c1*a_Tmpv7
3487    a_Tmpv4 =a_Tmpv6
3488    a_Tmpv5 =a_Tmpv6
3489    a_ss23(i,k,j) =a_ss23(i,k,j) +ss33f(i,k,j)*a_Tmpv5
3490    a_ss33f(i,k,j) =a_ss33f(i,k,j) +ss23(i,k,j)*a_Tmpv5
3491    a_Tmpv2 =a_Tmpv4
3492    a_Tmpv3 =a_Tmpv4
3493    a_ss22f(i,k,j) =a_ss22f(i,k,j) +ss23(i,k,j)*a_Tmpv3
3494    a_ss23(i,k,j) =a_ss23(i,k,j) +ss22f(i,k,j)*a_Tmpv3
3495    a_ss12f(i,k,j) =a_ss12f(i,k,j) +ss13f(i,k,j)*a_Tmpv2
3496    a_ss13f(i,k,j) =a_ss13f(i,k,j) +ss12f(i,k,j)*a_Tmpv2
3497    a_smnsmnf(i,k,j) =a_smnsmnf(i,k,j) +2.0*g_Sqrt(2.0, 2.0*smnsmnf(i,k,j))  &
3498    *ss23(i,k,j)*a_Tmpv1
3499    a_ss23(i,k,j) =a_ss23(i,k,j) +2.0*sqrt(2.0*smnsmnf(i,k,j))*a_Tmpv1
3501    a_delta =a_delta -1.0*2.0*(cs*delta)*cs*a_a
3502    a_a =0.0
3503    a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx*  &
3504    dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta
3505    a_delta =0.0
3506    ENDDO
3507    ENDDO
3508    ENDDO
3510    ELSE
3512    DO j =j_end, j_start, -1
3513    DO k =ktf, kts+1, -1
3514    DO i =i_end, i_start, -1
3515    a =Tmpv402(i,k,j)
3516    b =Tmpv403(i,k,j)
3518    a_Tmpv19 =a_m23(i,k,j)
3519    a_m23(i,k,j) =0.0
3520    a_a =a_a +Tmpv405(i,k,j)*a_Tmpv19
3521    a_Tmpv18 =a*a_Tmpv19
3522    a_Tmpv1 =a_Tmpv18
3523    a_Tmpv17 =a_Tmpv18
3524    a_b =a_b +Tmpv404(i,k,j)*a_Tmpv17
3525    a_Tmpv16 =b*a_Tmpv17
3526    a_Tmpv7 =a_Tmpv16
3527    a_Tmpv15 =a_Tmpv16
3528    a_Tmpv14 =c2*a_Tmpv15
3529    a_Tmpv12 =a_Tmpv14
3530    a_Tmpv13 =-a_Tmpv14
3531    a_ss33f(i,k,j) =a_ss33f(i,k,j) +rr23(i,k,j)*a_Tmpv13
3532    a_rr23(i,k,j) =a_rr23(i,k,j) +ss33f(i,k,j)*a_Tmpv13
3533    a_Tmpv10 =a_Tmpv12
3534    a_Tmpv11 =a_Tmpv12
3535    a_ss13f(i,k,j) =a_ss13f(i,k,j) +rr12f(i,k,j)*a_Tmpv11
3536    a_rr12f(i,k,j) =a_rr12f(i,k,j) +ss13f(i,k,j)*a_Tmpv11
3537    a_Tmpv8 =a_Tmpv10
3538    a_Tmpv9 =a_Tmpv10
3539    a_ss22f(i,k,j) =a_ss22f(i,k,j) +rr23(i,k,j)*a_Tmpv9
3540    a_rr23(i,k,j) =a_rr23(i,k,j) +ss22f(i,k,j)*a_Tmpv9
3541    a_ss12f(i,k,j) =a_ss12f(i,k,j) +rr13f(i,k,j)*a_Tmpv8
3542    a_rr13f(i,k,j) =a_rr13f(i,k,j) +ss12f(i,k,j)*a_Tmpv8
3543    a_Tmpv6 =c1*a_Tmpv7
3544    a_Tmpv4 =a_Tmpv6
3545    a_Tmpv5 =a_Tmpv6
3546    a_ss23(i,k,j) =a_ss23(i,k,j) +ss33f(i,k,j)*a_Tmpv5
3547    a_ss33f(i,k,j) =a_ss33f(i,k,j) +ss23(i,k,j)*a_Tmpv5
3548    a_Tmpv2 =a_Tmpv4
3549    a_Tmpv3 =a_Tmpv4
3550    a_ss22f(i,k,j) =a_ss22f(i,k,j) +ss23(i,k,j)*a_Tmpv3
3551    a_ss23(i,k,j) =a_ss23(i,k,j) +ss22f(i,k,j)*a_Tmpv3
3552    a_ss12f(i,k,j) =a_ss12f(i,k,j) +ss13f(i,k,j)*a_Tmpv2
3553    a_ss13f(i,k,j) =a_ss13f(i,k,j) +ss12f(i,k,j)*a_Tmpv2
3554    a_tkef(i,k,j) =a_tkef(i,k,j) +2.0*g_Sqrt(1.0, tkef(i,k,j))*ss23(i,k,j)*a_Tmpv1
3555    a_ss23(i,k,j) =a_ss23(i,k,j) +2.0*sqrt(tkef(i,k,j))*a_Tmpv1
3557    a_delta =a_delta +c3*a_b
3558    a_b =0.0
3560    a_delta =a_delta -1.0*ce*a_a
3561    a_a =0.0
3562    a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx*  &
3563    dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta
3564    a_delta =0.0
3565    ENDDO
3566    ENDDO
3567    ENDDO
3569    ENDIF
3571 !LPB[15]
3573 !LPB[14]
3574    DO j =j_end, j_start, -1
3576 !  DO k =kts+1, ktf
3577 !  DO i =i_start, i_end
3578 !  Tmpv001 =tke(i,k,j) +tke(i,k,j-1)
3579 !  Tmpv002 =fnm(k)*Tmpv001
3580 !  Tmpv003 =tke(i,k-1,j) +tke(i,k-1,j-1)
3581 !  Tmpv004 =fnp(k)*Tmpv003
3582 !  Tmpv005 =Tmpv002 +Tmpv004
3583 !  Tmpv006 =0.5*Tmpv005
3584 !  tkef(i,k,j) =Tmpv006
3586 !  Tmpv001 =smnsmn(i,k,j) +smnsmn(i,k,j-1)
3587 !  Tmpv002 =fnm(k)*Tmpv001
3588 !  Tmpv003 =smnsmn(i,k-1,j) +smnsmn(i,k-1,j-1)
3589 !  Tmpv004 =fnp(k)*Tmpv003
3590 !  Tmpv005 =Tmpv002 +Tmpv004
3591 !  Tmpv006 =0.5*Tmpv005
3592 !  smnsmnf(i,k,j) =Tmpv006
3594 !  Tmpv001 =ss22(i,k,j) +ss22(i,k,j-1)
3595 !  Tmpv002 =fnm(k)*Tmpv001
3596 !  Tmpv003 =ss22(i,k-1,j) +ss22(i,k-1,j-1)
3597 !  Tmpv004 =fnp(k)*Tmpv003
3598 !  Tmpv005 =Tmpv002 +Tmpv004
3599 !  Tmpv006 =0.5*Tmpv005
3600 !  ss22f(i,k,j) =Tmpv006
3602 !  Tmpv001 =ss33(i,k,j) +ss33(i,k,j-1)
3603 !  Tmpv002 =fnm(k)*Tmpv001
3604 !  Tmpv003 =ss33(i,k-1,j) +ss33(i,k-1,j-1)
3605 !  Tmpv004 =fnp(k)*Tmpv003
3606 !  Tmpv005 =Tmpv002 +Tmpv004
3607 !  Tmpv006 =0.5*Tmpv005
3608 !  ss33f(i,k,j) =Tmpv006
3610 !  Tmpv001 =ss12(i,k,j) +ss12(i+1,k,j)
3611 !  Tmpv002 =fnm(k)*Tmpv001
3612 !  Tmpv003 =ss12(i,k-1,j) +ss12(i+1,k-1,j)
3613 !  Tmpv004 =fnp(k)*Tmpv003
3614 !  Tmpv005 =Tmpv002 +Tmpv004
3615 !  Tmpv006 =0.5*Tmpv005
3616 !  ss12f(i,k,j) =Tmpv006
3618 !  Tmpv001 =rr12(i,k,j) +rr12(i+1,k,j)
3619 !  Tmpv002 =fnm(k)*Tmpv001
3620 !  Tmpv003 =rr12(i,k-1,j) +rr12(i+1,k-1,j)
3621 !  Tmpv004 =fnp(k)*Tmpv003
3622 !  Tmpv005 =Tmpv002 +Tmpv004
3623 !  Tmpv006 =0.5*Tmpv005
3624 !  rr12f(i,k,j) =Tmpv006
3626 !  Tmpv001 =ss13(i,k,j) +ss13(i,k,j-1)
3627 !  Tmpv002 =Tmpv001 +ss13(i+1,k,j-1)
3628 !  Tmpv003 =Tmpv002 +ss13(i+1,k,j)
3629 !  Tmpv004 =0.25*Tmpv003
3630 !  ss13f(i,k,j) =Tmpv004
3632 !  Tmpv001 =rr13(i,k,j) +rr13(i,k,j-1)
3633 !  Tmpv002 =Tmpv001 +rr13(i+1,k,j-1)
3634 !  Tmpv003 =Tmpv002 +rr13(i+1,k,j)
3635 !  Tmpv004 =0.25*Tmpv003
3636 !  rr13f(i,k,j) =Tmpv004
3638 !  ENDDO
3639 !  ENDDO
3641    DO k =ktf, kts+1, -1
3642    DO i =i_end, i_start, -1
3643    a_Tmpv4 =a_rr13f(i,k,j)
3644    a_rr13f(i,k,j) =0.0
3645    a_Tmpv3 =0.25*a_Tmpv4
3646    a_Tmpv2 =a_Tmpv3
3647    a_rr13(i+1,k,j) =a_rr13(i+1,k,j) +a_Tmpv3
3648    a_Tmpv1 =a_Tmpv2
3649    a_rr13(i+1,k,j-1) =a_rr13(i+1,k,j-1) +a_Tmpv2
3650    a_rr13(i,k,j) =a_rr13(i,k,j) +a_Tmpv1
3651    a_rr13(i,k,j-1) =a_rr13(i,k,j-1) +a_Tmpv1
3652    a_Tmpv4 =a_ss13f(i,k,j)
3653    a_ss13f(i,k,j) =0.0
3654    a_Tmpv3 =0.25*a_Tmpv4
3655    a_Tmpv2 =a_Tmpv3
3656    a_ss13(i+1,k,j) =a_ss13(i+1,k,j) +a_Tmpv3
3657    a_Tmpv1 =a_Tmpv2
3658    a_ss13(i+1,k,j-1) =a_ss13(i+1,k,j-1) +a_Tmpv2
3659    a_ss13(i,k,j) =a_ss13(i,k,j) +a_Tmpv1
3660    a_ss13(i,k,j-1) =a_ss13(i,k,j-1) +a_Tmpv1
3661    a_Tmpv6 =a_rr12f(i,k,j)
3662    a_rr12f(i,k,j) =0.0
3663    a_Tmpv5 =0.5*a_Tmpv6
3664    a_Tmpv2 =a_Tmpv5
3665    a_Tmpv4 =a_Tmpv5
3666    a_Tmpv3 =fnp(k)*a_Tmpv4
3667    a_rr12(i,k-1,j) =a_rr12(i,k-1,j) +a_Tmpv3
3668    a_rr12(i+1,k-1,j) =a_rr12(i+1,k-1,j) +a_Tmpv3
3669    a_Tmpv1 =fnm(k)*a_Tmpv2
3670    a_rr12(i,k,j) =a_rr12(i,k,j) +a_Tmpv1
3671    a_rr12(i+1,k,j) =a_rr12(i+1,k,j) +a_Tmpv1
3672    a_Tmpv6 =a_ss12f(i,k,j)
3673    a_ss12f(i,k,j) =0.0
3674    a_Tmpv5 =0.5*a_Tmpv6
3675    a_Tmpv2 =a_Tmpv5
3676    a_Tmpv4 =a_Tmpv5
3677    a_Tmpv3 =fnp(k)*a_Tmpv4
3678    a_ss12(i,k-1,j) =a_ss12(i,k-1,j) +a_Tmpv3
3679    a_ss12(i+1,k-1,j) =a_ss12(i+1,k-1,j) +a_Tmpv3
3680    a_Tmpv1 =fnm(k)*a_Tmpv2
3681    a_ss12(i,k,j) =a_ss12(i,k,j) +a_Tmpv1
3682    a_ss12(i+1,k,j) =a_ss12(i+1,k,j) +a_Tmpv1
3683    a_Tmpv6 =a_ss33f(i,k,j)
3684    a_ss33f(i,k,j) =0.0
3685    a_Tmpv5 =0.5*a_Tmpv6
3686    a_Tmpv2 =a_Tmpv5
3687    a_Tmpv4 =a_Tmpv5
3688    a_Tmpv3 =fnp(k)*a_Tmpv4
3689    a_ss33(i,k-1,j) =a_ss33(i,k-1,j) +a_Tmpv3
3690    a_ss33(i,k-1,j-1) =a_ss33(i,k-1,j-1) +a_Tmpv3
3691    a_Tmpv1 =fnm(k)*a_Tmpv2
3692    a_ss33(i,k,j) =a_ss33(i,k,j) +a_Tmpv1
3693    a_ss33(i,k,j-1) =a_ss33(i,k,j-1) +a_Tmpv1
3694    a_Tmpv6 =a_ss22f(i,k,j)
3695    a_ss22f(i,k,j) =0.0
3696    a_Tmpv5 =0.5*a_Tmpv6
3697    a_Tmpv2 =a_Tmpv5
3698    a_Tmpv4 =a_Tmpv5
3699    a_Tmpv3 =fnp(k)*a_Tmpv4
3700    a_ss22(i,k-1,j) =a_ss22(i,k-1,j) +a_Tmpv3
3701    a_ss22(i,k-1,j-1) =a_ss22(i,k-1,j-1) +a_Tmpv3
3702    a_Tmpv1 =fnm(k)*a_Tmpv2
3703    a_ss22(i,k,j) =a_ss22(i,k,j) +a_Tmpv1
3704    a_ss22(i,k,j-1) =a_ss22(i,k,j-1) +a_Tmpv1
3705    a_Tmpv6 =a_smnsmnf(i,k,j)
3706    a_smnsmnf(i,k,j) =0.0
3707    a_Tmpv5 =0.5*a_Tmpv6
3708    a_Tmpv2 =a_Tmpv5
3709    a_Tmpv4 =a_Tmpv5
3710    a_Tmpv3 =fnp(k)*a_Tmpv4
3711    a_smnsmn(i,k-1,j) =a_smnsmn(i,k-1,j) +a_Tmpv3
3712    a_smnsmn(i,k-1,j-1) =a_smnsmn(i,k-1,j-1) +a_Tmpv3
3713    a_Tmpv1 =fnm(k)*a_Tmpv2
3714    a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +a_Tmpv1
3715    a_smnsmn(i,k,j-1) =a_smnsmn(i,k,j-1) +a_Tmpv1
3716    a_Tmpv6 =a_tkef(i,k,j)
3717    a_tkef(i,k,j) =0.0
3718    a_Tmpv5 =0.5*a_Tmpv6
3719    a_Tmpv2 =a_Tmpv5
3720    a_Tmpv4 =a_Tmpv5
3721    a_Tmpv3 =fnp(k)*a_Tmpv4
3722    a_tke(i,k-1,j) =a_tke(i,k-1,j) +a_Tmpv3
3723    a_tke(i,k-1,j-1) =a_tke(i,k-1,j-1) +a_Tmpv3
3724    a_Tmpv1 =fnm(k)*a_Tmpv2
3725    a_tke(i,k,j) =a_tke(i,k,j) +a_Tmpv1
3726    a_tke(i,k,j-1) =a_tke(i,k,j-1) +a_Tmpv1
3727    ENDDO
3728    ENDDO
3730    ENDDO
3732 !LPB[13]
3733    DO j =j_end, j_start-1, -1
3735 !  DO k =kts, ktf
3736 !  DO i =i_start, i_end+1
3737 !  ss22(i,k,j) =s22(i,k,j)/2.0
3739 !  ss33(i,k,j) =s33(i,k,j)/2.0
3741 !  ss12(i,k,j) =s12(i,k,j)/2.0
3743 !  ss13(i,k,j) =s13(i,k,j)/2.0
3745 !  ss23(i,k,j) =s23(i,k,j)/2.0
3747 !  rr12(i,k,j) =r12(i,k,j)/2.0
3749 !  rr13(i,k,j) =r13(i,k,j)/2.0
3751 !  rr23(i,k,j) =r23(i,k,j)/2.0
3753 !  ENDDO
3754 !  ENDDO
3756    DO k =ktf, kts, -1
3757    DO i =i_end+1, i_start, -1
3758    a_r23(i,k,j) =a_r23(i,k,j) +1.0/2.0*a_rr23(i,k,j)
3759    a_rr23(i,k,j) =0.0
3760    a_r13(i,k,j) =a_r13(i,k,j) +1.0/2.0*a_rr13(i,k,j)
3761    a_rr13(i,k,j) =0.0
3762    a_r12(i,k,j) =a_r12(i,k,j) +1.0/2.0*a_rr12(i,k,j)
3763    a_rr12(i,k,j) =0.0
3764    a_s23(i,k,j) =a_s23(i,k,j) +1.0/2.0*a_ss23(i,k,j)
3765    a_ss23(i,k,j) =0.0
3766    a_s13(i,k,j) =a_s13(i,k,j) +1.0/2.0*a_ss13(i,k,j)
3767    a_ss13(i,k,j) =0.0
3768    a_s12(i,k,j) =a_s12(i,k,j) +1.0/2.0*a_ss12(i,k,j)
3769    a_ss12(i,k,j) =0.0
3770    a_s33(i,k,j) =a_s33(i,k,j) +1.0/2.0*a_ss33(i,k,j)
3771    a_ss33(i,k,j) =0.0
3772    a_s22(i,k,j) =a_s22(i,k,j) +1.0/2.0*a_ss22(i,k,j)
3773    a_ss22(i,k,j) =0.0
3774    ENDDO
3775    ENDDO
3777    ENDDO
3779 !LPB[12]
3780 !  je_ext =1
3781 !  j_end =j_end+je_ext
3783 !LPB[11]
3785 !  IF( config_flags%periodic_x ) THEN
3786 !  i_end =min(ite, ide-1)
3787 !  END IF
3789 !  IF( config_flags%periodic_x ) THEN
3791 !  END IF
3793 !LPB[10]
3795 !LPB[9]
3797 !  IF( config_flags%periodic_x ) THEN
3798 !  i_start =its
3799 !  END IF
3801 !  IF( config_flags%periodic_x ) THEN
3803 !  END IF
3805 !LPB[8]
3807 !LPB[7]
3809 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.             config_flags%nested) THEN
3810 !  j_end =min(jde-1, jte)
3811 !  END IF
3813 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
3814 !            config_flags%nested) THEN
3816 !  END IF
3818 !LPB[6]
3820 !LPB[5]
3822 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested) THEN
3823 !  j_start =max(jds+1, jts)
3824 !  END IF
3826 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
3827 !            config_flags%nested) THEN
3829 !  END IF
3831 !LPB[4]
3833 !LPB[3]
3835 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.             config_flags%nested) THEN
3836 !  i_end =min(ide-2, ite)
3837 !  END IF
3839 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
3840 !            config_flags%nested) THEN
3842 !  END IF
3844 !LPB[2]
3846 !LPB[1]
3848 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested) THEN
3849 !  i_start =max(ids+1, its)
3850 !  END IF
3852 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
3853 !            config_flags%nested) THEN
3855 !  END IF
3857 !LPB[0]
3858 !  ktf =min(kte, kde-1)
3859 !  i_start =its
3860 !  i_end =min(ite, ide-1)
3861 !  j_start =jts
3862 !  j_end =jte
3864    Return
3865         END SUBROUTINE a_calc_m23
3867         END MODULE a_module_sfs_nba