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
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
22 ! Remarked by Ning Pan, 2010-08-18
23 ! SUBROUTINE a_calc_mij_constants()
25 !PART! I: DECLARATION OF VARIABLES
29 ! INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
32 !PART! II: CALCULATIONS OF B. S. TRAJECTORY
34 !PART! III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
38 !PART! IV: REVERSE/BACKWARD ACCUMULATIONS
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)
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)
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
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
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
83 i_end = MIN(ite,ide-1)
85 j_end = MIN(jte,jde-1)
88 IF ( config_flags%open_xs .or. config_flags%specified .or. &
89 config_flags%nested) i_start = MAX(ids+1,its)
94 IF ( config_flags%open_xe .or. config_flags%specified .or. &
95 config_flags%nested) i_end = MIN(ide-2,ite)
100 IF ( config_flags%open_ys .or. config_flags%specified .or. &
101 config_flags%nested) j_start = MAX(jds+1,jts)
106 IF ( config_flags%open_ye .or. config_flags%specified .or. &
107 config_flags%nested) j_end = MIN(jde-2,jte)
112 IF ( config_flags%periodic_x ) i_start = its
117 IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
119 ! Remarked by Ning Pan, 2010-08-18 : LPB[12]-[14]
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) )
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
149 ! Keep_Lpb14_tmp(j) =tmp
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
164 ! ! Keep_Lpb15_tmp(j) =tmp
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
176 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
180 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
183 DO j =j_end, j_start, -1
185 ! tmp =Keep_Lpb15_tmp(j)
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
196 ! Remarked by Ning Pan, 2010-08-18
197 ! Tmpv001 =smnsmn(i,k,j) +2.0*tmp*tmp
198 ! smnsmn(i,k,j) =Tmpv001
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)
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
215 a_Tmpv3 =0.125*a_Tmpv4
217 a_s23(i,k,j+1) =a_s23(i,k,j+1) +a_Tmpv3
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
228 DO j =j_end, j_start, -1
230 ! tmp =Keep_Lpb14_tmp(j) ! Remarked by Ning Pan, 2010-08-18
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
241 ! Remarked by Ning Pan, 2010-08-18
242 ! Tmpv001 =smnsmn(i,k,j) +2.0*tmp*tmp
243 ! smnsmn(i,k,j) =Tmpv001
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)
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
260 a_Tmpv3 =0.125*a_Tmpv4
262 a_s13(i+1,k,j) =a_s13(i+1,k,j) +a_Tmpv3
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
273 DO j =j_end, j_start, -1
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
284 ! Remarked by Ning Pan, 2010-08-18
285 ! Tmpv001 =smnsmn(i,k,j) +2.0*tmp*tmp
286 ! smnsmn(i,k,j) =Tmpv001
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)
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
303 a_Tmpv3 =0.125*a_Tmpv4
305 a_s12(i+1,k,j+1) =a_s12(i+1,k,j+1) +a_Tmpv3
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
316 DO j =j_end, j_start, -1
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
329 DO i =i_end, i_start, -1
330 a_Tmpv3 =a_smnsmn(i,k,j)
332 a_Tmpv2 =0.25*a_Tmpv3
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
344 ! IF( config_flags%periodic_x ) THEN
345 ! i_end =min(ite, ide-1)
348 ! IF( config_flags%periodic_x ) THEN
356 ! IF( config_flags%periodic_x ) THEN
360 ! IF( config_flags%periodic_x ) THEN
368 ! IF( config_flags%open_ye .or. config_flags%specified .or. config_flags%nested) THEN
369 ! j_end =min(jde-2, jte)
372 ! IF( config_flags%open_ye .or. config_flags%specified .or. &
373 ! config_flags%nested) THEN
381 ! IF( config_flags%open_ys .or. config_flags%specified .or. config_flags%nested) THEN
382 ! j_start =max(jds+1, jts)
385 ! IF( config_flags%open_ys .or. config_flags%specified .or. &
386 ! config_flags%nested) THEN
394 ! IF( config_flags%open_xe .or. config_flags%specified .or. config_flags%nested) THEN
395 ! i_end =min(ide-2, ite)
398 ! IF( config_flags%open_xe .or. config_flags%specified .or. &
399 ! config_flags%nested) THEN
407 ! IF( config_flags%open_xs .or. config_flags%specified .or. config_flags%nested) THEN
408 ! i_start =max(ids+1, its)
411 ! IF( config_flags%open_xs .or. config_flags%specified .or. &
412 ! config_flags%nested) THEN
417 ! ktf =min(kte, kde-1)
419 ! i_end =min(ite, ide-1)
421 ! j_end =min(jte, jde-1)
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
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
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, &
455 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
457 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
459 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
461 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
463 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
465 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
467 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
469 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
471 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
473 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
475 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
477 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) &
482 !PART II: CALCULATIONS OF B. S. TRAJECTORY
485 ktf = MIN( kte, kde-1 )
492 IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
493 config_flags%nested) i_start = MAX( ids+1, its )
498 IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
499 config_flags%nested) i_end = MIN( ide-1, ite )
504 IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
505 config_flags%nested) j_start = MAX( jds+1, jts )
510 IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
511 config_flags%nested) j_end = MIN( jde-1, jte )
516 IF ( config_flags%periodic_x ) i_start = its
521 IF ( config_flags%periodic_x ) i_end = ite
526 i_start = i_start - is_ext
527 j_start = j_start - js_ext
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
561 DO j = j_start, j_end
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) )
585 ! IF ( config_flags%sfs_opt .EQ. 1 ) THEN
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 &
598 ! + c2*( -2.0*( ss12c(i,k,j)*rr12c(i,k,j) &
599 ! + ss13c(i,k,j)*rr13c(i,k,j) &
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 &
609 ! + c2*( 2.0*( ss12c(i,k,j)*rr12c(i,k,j) &
610 ! - ss23c(i,k,j)*rr23c(i,k,j) &
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 &
620 ! + c2*( 2.0*( ss13c(i,k,j)*rr13c(i,k,j) &
621 ! + ss23c(i,k,j)*rr23c(i,k,j) &
633 ! delta = ( dx * dy / rdzw(i,k,j) )**0.33333333
636 ! m11(i,k,j) = a*( 2.0*sqrt( tke(i,k,j) )*ss11(i,k,j) &
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 &
643 ! + c2*( -2.0*( ss12c(i,k,j)*rr12c(i,k,j) &
644 ! + ss13c(i,k,j)*rr13c(i,k,j) &
649 ! m22(i,k,j) = a*( 2.0*sqrt( tke(i,k,j) )*ss22(i,k,j) &
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 &
656 ! + c2*( 2.0*( ss12c(i,k,j)*rr12c(i,k,j) &
657 ! - ss23c(i,k,j)*rr23c(i,k,j) &
662 ! m33(i,k,j) = a*( 2.0*sqrt( tke(i,k,j) )*ss33(i,k,j) &
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 &
669 ! + c2*( 2.0*( ss13c(i,k,j)*rr13c(i,k,j) &
670 ! + ss23c(i,k,j)*rr23c(i,k,j) &
681 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
683 Do K2_ADJ =jts-1, jte+1
685 Do K0_ADJ =its-1, ite+1
686 a_ss11(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
691 Do K2_ADJ =jts-1, jte+1
693 Do K0_ADJ =its-1, ite+1
694 a_ss22(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
699 Do K2_ADJ =jts-1, jte+1
701 Do K0_ADJ =its-1, ite+1
702 a_ss33(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
707 Do K2_ADJ =jts-1, jte+1
709 Do K0_ADJ =its-1, ite+1
710 a_ss12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
715 Do K2_ADJ =jts-1, jte+1
717 Do K0_ADJ =its-1, ite+1
718 a_ss13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
723 Do K2_ADJ =jts-1, jte+1
725 Do K0_ADJ =its-1, ite+1
726 a_ss23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
731 Do K2_ADJ =jts-1, jte+1
733 Do K0_ADJ =its-1, ite+1
734 a_rr12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
739 Do K2_ADJ =jts-1, jte+1
741 Do K0_ADJ =its-1, ite+1
742 a_rr13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
747 Do K2_ADJ =jts-1, jte+1
749 Do K0_ADJ =its-1, ite+1
750 a_rr23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
755 Do K2_ADJ =jts-1, jte+1
757 Do K0_ADJ =its-1, ite+1
758 a_ss12c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
763 Do K2_ADJ =jts-1, jte+1
765 Do K0_ADJ =its-1, ite+1
766 a_rr12c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
771 Do K2_ADJ =jts-1, jte+1
773 Do K0_ADJ =its-1, ite+1
774 a_ss13c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
779 Do K2_ADJ =jts-1, jte+1
781 Do K0_ADJ =its-1, ite+1
782 a_rr13c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
787 Do K2_ADJ =jts-1, jte+1
789 Do K0_ADJ =its-1, ite+1
790 a_ss23c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
795 Do K2_ADJ =jts-1, jte+1
797 Do K0_ADJ =its-1, ite+1
798 a_rr23c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
807 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
811 IF( config_flags%sfs_opt .EQ. 1 ) THEN
815 delta =(dx*dy/rdzw(i,k,j))**0.33333333
817 a =-1.0*(cs*delta)**2
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
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
831 Tmpv012 =Tmpv006 +Tmpv011
832 Tmpv401(i,k,j) =Tmpv012
833 Tmpv013 =a*Tmpv401(i,k,j)
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
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
847 Tmpv012 =Tmpv006 +Tmpv011
848 Tmpv402(i,k,j) =Tmpv012
849 Tmpv013 =a*Tmpv402(i,k,j)
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
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
863 Tmpv012 =Tmpv006 +Tmpv011
864 Tmpv403(i,k,j) =Tmpv012
865 Tmpv013 =a*Tmpv403(i,k,j)
875 delta =(dx*dy/rdzw(i,k,j))**0.33333333
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
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
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)
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
906 Tmpv006 =ss12c(i,k,j)*rr12c(i,k,j)
907 Tmpv007 =ss23c(i,k,j)*rr23c(i,k,j)
908 Tmpv008 =Tmpv006 -Tmpv007
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)
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
924 Tmpv006 =ss13c(i,k,j)*rr13c(i,k,j)
925 Tmpv007 =ss23c(i,k,j)*rr23c(i,k,j)
926 Tmpv008 =Tmpv006 +Tmpv007
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)
942 IF( config_flags%sfs_opt .EQ. 1 ) THEN
944 DO j =j_end, j_start, -1
946 DO i =i_end, i_start, -1
947 delta =(dx*dy/rdzw(i,k,j))**0.33333333
950 a_Tmpv13 =a_m33(i,k,j)
952 a_a =a_a +Tmpv403(i,k,j)*a_Tmpv13
956 a_Tmpv10 =c2*a_Tmpv11
957 a_Tmpv9 =2.0*a_Tmpv10
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
968 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4
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)) &
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)
978 a_a =a_a +Tmpv402(i,k,j)*a_Tmpv13
982 a_Tmpv10 =c2*a_Tmpv11
983 a_Tmpv9 =2.0*a_Tmpv10
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
994 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4
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)
1004 a_a =a_a +Tmpv401(i,k,j)*a_Tmpv13
1005 a_Tmpv12 =a*a_Tmpv13
1008 a_Tmpv10 =c2*a_Tmpv11
1009 a_Tmpv9 =-2.0*a_Tmpv10
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
1020 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4
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
1031 a_delta =a_delta -1.0*2.0*(cs*delta)*cs*a_a
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
1042 DO j =j_end, j_start, -1
1044 DO i =i_end, i_start, -1
1048 a_Tmpv14 =a_m33(i,k,j)
1050 a_a =a_a +Tmpv4011(i,k,j)*a_Tmpv14
1051 a_Tmpv13 =a*a_Tmpv14
1054 a_b =a_b +Tmpv4010(i,k,j)*a_Tmpv12
1055 a_Tmpv11 =b*a_Tmpv12
1058 a_Tmpv9 =c2*a_Tmpv10
1059 a_Tmpv8 =2.0*a_Tmpv9
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
1068 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4
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)
1077 a_a =a_a +Tmpv409(i,k,j)*a_Tmpv14
1078 a_Tmpv13 =a*a_Tmpv14
1081 a_b =a_b +Tmpv408(i,k,j)*a_Tmpv12
1082 a_Tmpv11 =b*a_Tmpv12
1085 a_Tmpv9 =c2*a_Tmpv10
1086 a_Tmpv8 =2.0*a_Tmpv9
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
1095 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4
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)
1104 a_a =a_a +Tmpv407(i,k,j)*a_Tmpv14
1105 a_Tmpv13 =a*a_Tmpv14
1108 a_b =a_b +Tmpv406(i,k,j)*a_Tmpv12
1109 a_Tmpv11 =b*a_Tmpv12
1112 a_Tmpv9 =c2*a_Tmpv10
1113 a_Tmpv8 =-2.0*a_Tmpv9
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
1122 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4
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
1133 a_delta =a_delta -1.0*ce*a_a
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
1147 DO j =j_end, j_start, -1
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
1191 DO i =i_end, i_start, -1
1192 a_Tmpv4 =a_rr23c(i,k,j)
1194 a_Tmpv3 =0.25*a_Tmpv4
1196 a_rr23(i,k,j+1) =a_rr23(i,k,j+1) +a_Tmpv3
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)
1203 a_Tmpv3 =0.25*a_Tmpv4
1205 a_ss23(i,k,j+1) =a_ss23(i,k,j+1) +a_Tmpv3
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)
1212 a_Tmpv3 =0.25*a_Tmpv4
1214 a_rr13(i+1,k,j) =a_rr13(i+1,k,j) +a_Tmpv3
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)
1221 a_Tmpv3 =0.25*a_Tmpv4
1223 a_ss13(i+1,k,j) =a_ss13(i+1,k,j) +a_Tmpv3
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)
1230 a_Tmpv3 =0.25*a_Tmpv4
1232 a_rr12(i+1,k,j+1) =a_rr12(i+1,k,j+1) +a_Tmpv3
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)
1239 a_Tmpv3 =0.25*a_Tmpv4
1241 a_ss12(i+1,k,j+1) =a_ss12(i+1,k,j+1) +a_Tmpv3
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
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
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
1275 DO j =j_end+1, j_start, -1
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
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)
1304 a_r13(i,k,j) =a_r13(i,k,j) +1.0/2.0*a_rr13(i,k,j)
1306 a_r12(i,k,j) =a_r12(i,k,j) +1.0/2.0*a_rr12(i,k,j)
1308 a_s23(i,k,j) =a_s23(i,k,j) +1.0/2.0*a_ss23(i,k,j)
1310 a_s13(i,k,j) =a_s13(i,k,j) +1.0/2.0*a_ss13(i,k,j)
1312 a_s12(i,k,j) =a_s12(i,k,j) +1.0/2.0*a_ss12(i,k,j)
1314 a_s33(i,k,j) =a_s33(i,k,j) +1.0/2.0*a_ss33(i,k,j)
1316 a_s22(i,k,j) =a_s22(i,k,j) +1.0/2.0*a_ss22(i,k,j)
1318 a_s11(i,k,j) =a_s11(i,k,j) +1.0/2.0*a_ss11(i,k,j)
1328 ! i_start =i_start-is_ext
1329 ! j_start =j_start-js_ext
1333 ! IF( config_flags%periodic_x ) THEN
1337 ! IF( config_flags%periodic_x ) THEN
1345 ! IF( config_flags%periodic_x ) THEN
1349 ! IF( config_flags%periodic_x ) THEN
1357 ! IF( config_flags%open_ye .OR. config_flags%specified .OR. config_flags%nested) THEN
1358 ! j_end =min(jde-1, jte)
1361 ! IF( config_flags%open_ye .OR. config_flags%specified .OR. &
1362 ! config_flags%nested) THEN
1370 ! IF( config_flags%open_ys .OR. config_flags%specified .OR. config_flags%nested) THEN
1371 ! j_start =max(jds+1, jts)
1374 ! IF( config_flags%open_ys .OR. config_flags%specified .OR. &
1375 ! config_flags%nested) THEN
1383 ! IF( config_flags%open_xe .OR. config_flags%specified .OR. config_flags%nested) THEN
1384 ! i_end =min(ide-1, ite)
1387 ! IF( config_flags%open_xe .OR. config_flags%specified .OR. &
1388 ! config_flags%nested) THEN
1396 ! IF( config_flags%open_xs .OR. config_flags%specified .OR. config_flags%nested) THEN
1397 ! i_start =max(ids+1, its)
1400 ! IF( config_flags%open_xs .OR. config_flags%specified .OR. &
1401 ! config_flags%nested) THEN
1406 ! ktf =min(kte, kde-1)
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
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, &
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, &
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
1455 !PART II: CALCULATIONS OF B. S. TRAJECTORY
1459 ktf = MIN( kte, kde-1 )
1466 IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
1467 config_flags%nested ) i_start = MAX( ids+1, its )
1472 IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
1473 config_flags%nested ) i_end = MIN( ide-1, ite )
1478 IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
1479 config_flags%nested ) j_start = MAX( jds+1, jts )
1484 IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
1485 config_flags%nested ) j_end = MIN( jde-1, jte )
1490 IF ( config_flags%periodic_x ) i_start = its
1495 IF ( config_flags%periodic_x ) i_end = ite
1500 i_end = i_end + ie_ext
1501 j_end = j_end + je_ext
1504 DO j=j_start-1,j_end
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
1522 DO j=j_start-1,j_end
1524 DO i=i_start-1,i_end
1534 DO j = j_start, j_end
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 ) )
1562 ! IF ( config_flags%sfs_opt .EQ. 1 ) THEN
1564 ! DO j=j_start,j_end
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) &
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) &
1585 ! DO j=j_start,j_end
1587 ! DO i=i_start,i_end
1588 ! delta = ( dx * dy / rdzw(i,k,j) )**0.33333333
1591 ! m12(i,k,j) = a*( 2.0*sqrt( tked(i,k,j) )*s12(i,k,j) &
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) &
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) &
1610 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
1612 Do K2_ADJ =jts-1, jte+1
1614 Do K0_ADJ =its-1, ite+1
1615 a_ss11(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1620 Do K2_ADJ =jts-1, jte+1
1622 Do K0_ADJ =its-1, ite+1
1623 a_ss22(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1628 Do K2_ADJ =jts-1, jte+1
1630 Do K0_ADJ =its-1, ite+1
1631 a_ss12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1636 Do K2_ADJ =jts-1, jte+1
1638 Do K0_ADJ =its-1, ite+1
1639 a_ss13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1644 Do K2_ADJ =jts-1, jte+1
1646 Do K0_ADJ =its-1, ite+1
1647 a_ss23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1652 Do K2_ADJ =jts-1, jte+1
1654 Do K0_ADJ =its-1, ite+1
1655 a_rr12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1660 Do K2_ADJ =jts-1, jte+1
1662 Do K0_ADJ =its-1, ite+1
1663 a_rr13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1668 Do K2_ADJ =jts-1, jte+1
1670 Do K0_ADJ =its-1, ite+1
1671 a_rr23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1676 Do K2_ADJ =jts-1, jte+1
1678 Do K0_ADJ =its-1, ite+1
1679 a_tked(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1684 Do K2_ADJ =jts-1, jte+1
1686 Do K0_ADJ =its-1, ite+1
1687 a_ss11d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1692 Do K2_ADJ =jts-1, jte+1
1694 Do K0_ADJ =its-1, ite+1
1695 a_ss22d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1700 Do K2_ADJ =jts-1, jte+1
1702 Do K0_ADJ =its-1, ite+1
1703 a_ss13d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1708 Do K2_ADJ =jts-1, jte+1
1710 Do K0_ADJ =its-1, ite+1
1711 a_ss23d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1716 Do K2_ADJ =jts-1, jte+1
1718 Do K0_ADJ =its-1, ite+1
1719 a_rr13d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1724 Do K2_ADJ =jts-1, jte+1
1726 Do K0_ADJ =its-1, ite+1
1727 a_rr23d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1732 Do K2_ADJ =jts-1, jte+1
1734 Do K0_ADJ =its-1, ite+1
1735 a_smnsmnd(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1744 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
1748 IF( config_flags%sfs_opt .EQ. 1 ) THEN
1749 DO j =j_start, j_end
1751 DO i =i_start, i_end
1752 delta =(dx*dy/rdzw(i,k,j))**0.33333333
1754 a =-1.0*(cs*delta)**2
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
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
1773 Tmpv017 =Tmpv008 +Tmpv016
1774 Tmpv401(i,k,j) =Tmpv017
1775 Tmpv018 =a*Tmpv401(i,k,j)
1782 DO j =j_start, j_end
1784 DO i =i_start, i_end
1785 delta =(dx*dy/rdzw(i,k,j))**0.33333333
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
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
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)
1821 IF( config_flags%sfs_opt .EQ. 1 ) THEN
1823 DO j =j_end, j_start, -1
1825 DO i =i_end, i_start, -1
1828 a_Tmpv18 =a_m12(i,k,j)
1830 a_a =a_a +Tmpv401(i,k,j)*a_Tmpv18
1831 a_Tmpv17 =a*a_Tmpv18
1834 a_Tmpv15 =c2*a_Tmpv16
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
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
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
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
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)
1870 delta =(dx*dy/rdzw(i,k,j))**0.33333333
1872 a_delta =a_delta -1.0*2.0*(cs*delta)*cs*a_a
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
1883 DO j =j_end, j_start, -1
1885 DO i =i_end, i_start, -1
1889 a_Tmpv19 =a_m12(i,k,j)
1891 a_a =a_a +Tmpv405(i,k,j)*a_Tmpv19
1892 a_Tmpv18 =a*a_Tmpv19
1895 a_b =a_b +Tmpv404(i,k,j)*a_Tmpv17
1896 a_Tmpv16 =b*a_Tmpv17
1899 a_Tmpv14 =c2*a_Tmpv15
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
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
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
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
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
1930 a_delta =a_delta +c3*a_b
1935 a_delta =a_delta -1.0*ce*a_a
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
1949 DO j =j_end, j_start, -1
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
2005 DO i =i_end, i_start, -1
2006 a_Tmpv4 =a_rr23d(i,k,j)
2008 a_Tmpv3 =0.25*a_Tmpv4
2010 a_rr23(i-1,k,j) =a_rr23(i-1,k,j) +a_Tmpv3
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)
2017 a_Tmpv3 =0.25*a_Tmpv4
2019 a_ss23(i-1,k,j) =a_ss23(i-1,k,j) +a_Tmpv3
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)
2026 a_Tmpv3 =0.25*a_Tmpv4
2028 a_rr13(i,k,j-1) =a_rr13(i,k,j-1) +a_Tmpv3
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)
2035 a_Tmpv3 =0.25*a_Tmpv4
2037 a_ss13(i,k,j-1) =a_ss13(i,k,j-1) +a_Tmpv3
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)
2044 a_Tmpv3 =0.25*a_Tmpv4
2046 a_ss22(i,k,j-1) =a_ss22(i,k,j-1) +a_Tmpv3
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)
2053 a_Tmpv3 =0.25*a_Tmpv4
2055 a_ss11(i,k,j-1) =a_ss11(i,k,j-1) +a_Tmpv3
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
2064 a_smnsmn(i,k,j-1) =a_smnsmn(i,k,j-1) +a_Tmpv3
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)
2071 a_Tmpv3 =0.25*a_Tmpv4
2073 a_tke(i,k,j-1) =a_tke(i,k,j-1) +a_Tmpv3
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
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
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
2107 DO j =j_end, j_start-1, -1
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
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)
2134 a_r13(i,k,j) =a_r13(i,k,j) +1.0/2.0*a_rr13(i,k,j)
2136 a_r12(i,k,j) =a_r12(i,k,j) +1.0/2.0*a_rr12(i,k,j)
2138 a_s23(i,k,j) =a_s23(i,k,j) +1.0/2.0*a_ss23(i,k,j)
2140 a_s13(i,k,j) =a_s13(i,k,j) +1.0/2.0*a_ss13(i,k,j)
2142 a_s12(i,k,j) =a_s12(i,k,j) +1.0/2.0*a_ss12(i,k,j)
2144 a_s22(i,k,j) =a_s22(i,k,j) +1.0/2.0*a_ss22(i,k,j)
2146 a_s11(i,k,j) =a_s11(i,k,j) +1.0/2.0*a_ss11(i,k,j)
2156 ! i_end =i_end+ie_ext
2157 ! j_end =j_end+je_ext
2161 ! IF( config_flags%periodic_x ) THEN
2165 ! IF( config_flags%periodic_x ) THEN
2173 ! IF( config_flags%periodic_x ) THEN
2177 ! IF( config_flags%periodic_x ) THEN
2185 ! IF( config_flags%open_ye .OR. config_flags%specified .OR. config_flags%nested ) THEN
2186 ! j_end =min(jde-1, jte)
2189 ! IF( config_flags%open_ye .OR. config_flags%specified .OR. &
2190 ! config_flags%nested ) THEN
2198 ! IF( config_flags%open_ys .OR. config_flags%specified .OR. config_flags%nested ) THEN
2199 ! j_start =max(jds+1, jts)
2202 ! IF( config_flags%open_ys .OR. config_flags%specified .OR. &
2203 ! config_flags%nested ) THEN
2211 ! IF( config_flags%open_xe .OR. config_flags%specified .OR. config_flags%nested ) THEN
2212 ! i_end =min(ide-1, ite)
2215 ! IF( config_flags%open_xe .OR. config_flags%specified .OR. &
2216 ! config_flags%nested ) THEN
2224 ! IF( config_flags%open_xs .OR. config_flags%specified .OR. config_flags%nested ) THEN
2225 ! i_start =max(ids+1, its)
2228 ! IF( config_flags%open_xs .OR. config_flags%specified .OR. &
2229 ! config_flags%nested ) THEN
2234 ! ktf =min(kte, kde-1)
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
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, &
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, &
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)) &
2277 REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
2279 REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
2281 REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
2283 REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
2285 REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
2290 !PART II: CALCULATIONS OF B. S. TRAJECTORY
2294 ktf = MIN( kte, kde-1 )
2298 j_end = MIN( jte, jde-1 )
2301 IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
2302 config_flags%nested) i_start = MAX( ids+1, its )
2307 IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
2308 config_flags%nested) i_end = MIN( ide-1, ite )
2313 IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
2314 config_flags%nested) j_start = MAX( jds+1, jts )
2319 IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
2320 config_flags%nested) j_end = MIN( jde-2, jte )
2325 IF ( config_flags%periodic_x ) i_start = its
2330 IF ( config_flags%periodic_x ) i_end = ite
2334 i_end = i_end + ie_ext
2337 DO j=j_start,j_end+1
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
2355 DO j = j_start, j_end
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) )
2383 ! IF ( config_flags%sfs_opt .EQ. 1 ) THEN
2385 ! DO j=j_start,j_end
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) &
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) &
2406 ! DO j=j_start,j_end
2408 ! DO i=i_start,i_end
2409 ! delta = ( dx * dy / rdzw(i,k,j) )**0.33333333
2412 ! m13(i,k,j) = a*( 2.0*sqrt( tkee(i,k,j) )*ss13(i,k,j) &
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) &
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) &
2431 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
2433 Do K2_ADJ =jts-1, jte+1
2435 Do K0_ADJ =its-1, ite+1
2436 a_ss11(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2441 Do K2_ADJ =jts-1, jte+1
2443 Do K0_ADJ =its-1, ite+1
2444 a_ss33(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2449 Do K2_ADJ =jts-1, jte+1
2451 Do K0_ADJ =its-1, ite+1
2452 a_ss12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2457 Do K2_ADJ =jts-1, jte+1
2459 Do K0_ADJ =its-1, ite+1
2460 a_ss13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2465 Do K2_ADJ =jts-1, jte+1
2467 Do K0_ADJ =its-1, ite+1
2468 a_ss23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2473 Do K2_ADJ =jts-1, jte+1
2475 Do K0_ADJ =its-1, ite+1
2476 a_rr12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2481 Do K2_ADJ =jts-1, jte+1
2483 Do K0_ADJ =its-1, ite+1
2484 a_rr13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2489 Do K2_ADJ =jts-1, jte+1
2491 Do K0_ADJ =its-1, ite+1
2492 a_rr23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2497 Do K2_ADJ =jts-1, jte+1
2499 Do K0_ADJ =its-1, ite+1
2500 a_tkee(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2505 Do K2_ADJ =jts-1, jte+1
2507 Do K0_ADJ =its-1, ite+1
2508 a_ss11e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2513 Do K2_ADJ =jts-1, jte+1
2515 Do K0_ADJ =its-1, ite+1
2516 a_ss33e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2521 Do K2_ADJ =jts-1, jte+1
2523 Do K0_ADJ =its-1, ite+1
2524 a_ss12e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2529 Do K2_ADJ =jts-1, jte+1
2531 Do K0_ADJ =its-1, ite+1
2532 a_ss23e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2537 Do K2_ADJ =jts-1, jte+1
2539 Do K0_ADJ =its-1, ite+1
2540 a_rr12e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2545 Do K2_ADJ =jts-1, jte+1
2547 Do K0_ADJ =its-1, ite+1
2548 a_rr23e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2553 Do K2_ADJ =jts-1, jte+1
2555 Do K0_ADJ =its-1, ite+1
2556 a_smnsmne(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
2565 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
2569 IF( config_flags%sfs_opt .EQ. 1 ) THEN
2570 DO j =j_start, j_end
2572 DO i =i_start, i_end
2573 delta =(dx*dy/rdzw(i,k,j))**0.33333333
2575 a =-1.0*(cs*delta)**2
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
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
2594 Tmpv017 =Tmpv008 +Tmpv016
2595 Tmpv401(i,k,j) =Tmpv017
2596 Tmpv018 =a*Tmpv401(i,k,j)
2603 DO j =j_start, j_end
2605 DO i =i_start, i_end
2606 delta =(dx*dy/rdzw(i,k,j))**0.33333333
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
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
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)
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
2648 delta =(dx*dy/rdzw(i,k,j))**0.33333333
2651 a_Tmpv18 =a_m13(i,k,j)
2653 a_a =a_a +Tmpv401(i,k,j)*a_Tmpv18
2654 a_Tmpv17 =a*a_Tmpv18
2657 a_Tmpv15 =c2*a_Tmpv16
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
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
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
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
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
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
2700 DO j =j_end, j_start, -1
2701 DO k =ktf, kts+1, -1
2702 DO i =i_end, i_start, -1
2706 a_Tmpv19 =a_m13(i,k,j)
2708 a_a =a_a +Tmpv405(i,k,j)*a_Tmpv19
2709 a_Tmpv18 =a*a_Tmpv19
2712 a_b =a_b +Tmpv404(i,k,j)*a_Tmpv17
2713 a_Tmpv16 =b*a_Tmpv17
2716 a_Tmpv14 =c2*a_Tmpv15
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
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
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
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
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
2748 a_delta =a_delta -1.0*ce*a_a
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
2762 DO j =j_end, j_start, -1
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
2829 DO k =ktf, kts+1, -1
2830 DO i =i_end, i_start, -1
2831 a_Tmpv4 =a_rr23e(i,k,j)
2833 a_Tmpv3 =0.25*a_Tmpv4
2835 a_rr23(i-1,k,j+1) =a_rr23(i-1,k,j+1) +a_Tmpv3
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)
2842 a_Tmpv3 =0.25*a_Tmpv4
2844 a_ss23(i-1,k,j+1) =a_ss23(i-1,k,j+1) +a_Tmpv3
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)
2851 a_Tmpv5 =0.5*a_Tmpv6
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)
2862 a_Tmpv5 =0.5*a_Tmpv6
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)
2873 a_Tmpv5 =0.5*a_Tmpv6
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)
2884 a_Tmpv5 =0.5*a_Tmpv6
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
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)
2906 a_Tmpv5 =0.5*a_Tmpv6
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
2921 DO j =j_end+1, j_start, -1
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
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)
2948 a_r13(i,k,j) =a_r13(i,k,j) +1.0/2.0*a_rr13(i,k,j)
2950 a_r12(i,k,j) =a_r12(i,k,j) +1.0/2.0*a_rr12(i,k,j)
2952 a_s23(i,k,j) =a_s23(i,k,j) +1.0/2.0*a_ss23(i,k,j)
2954 a_s13(i,k,j) =a_s13(i,k,j) +1.0/2.0*a_ss13(i,k,j)
2956 a_s12(i,k,j) =a_s12(i,k,j) +1.0/2.0*a_ss12(i,k,j)
2958 a_s33(i,k,j) =a_s33(i,k,j) +1.0/2.0*a_ss33(i,k,j)
2960 a_s11(i,k,j) =a_s11(i,k,j) +1.0/2.0*a_ss11(i,k,j)
2969 ! i_end =i_end+ie_ext
2973 ! IF( config_flags%periodic_x ) THEN
2977 ! IF( config_flags%periodic_x ) THEN
2985 ! IF( config_flags%periodic_x ) THEN
2989 ! IF( config_flags%periodic_x ) THEN
2997 ! IF( config_flags%open_ye .OR. config_flags%specified .OR. config_flags%nested) THEN
2998 ! j_end =min(jde-2, jte)
3001 ! IF( config_flags%open_ye .OR. config_flags%specified .OR. &
3002 ! config_flags%nested) THEN
3010 ! IF( config_flags%open_ys .OR. config_flags%specified .OR. config_flags%nested) THEN
3011 ! j_start =max(jds+1, jts)
3014 ! IF( config_flags%open_ys .OR. config_flags%specified .OR. &
3015 ! config_flags%nested) THEN
3023 ! IF( config_flags%open_xe .OR. config_flags%specified .OR. config_flags%nested) THEN
3024 ! i_end =min(ide-1, ite)
3027 ! IF( config_flags%open_xe .OR. config_flags%specified .OR. &
3028 ! config_flags%nested) THEN
3036 ! IF( config_flags%open_xs .OR. config_flags%specified .OR. config_flags%nested) THEN
3037 ! i_start =max(ids+1, its)
3040 ! IF( config_flags%open_xs .OR. config_flags%specified .OR. &
3041 ! config_flags%nested) THEN
3046 ! ktf =min(kte, kde-1)
3050 ! j_end =min(jte, jde-1)
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
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, &
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, &
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) &
3089 REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) &
3091 REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) &
3093 REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) &
3095 REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) &
3097 REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) &
3102 !PART II: CALCULATIONS OF B. S. TRAJECTORY
3106 ktf = MIN( kte, kde-1 )
3108 i_end = MIN( ite, ide-1 )
3113 IF ( config_flags%open_xs .OR. config_flags%specified .OR. &
3114 config_flags%nested) i_start = MAX( ids+1, its )
3119 IF ( config_flags%open_xe .OR. config_flags%specified .OR. &
3120 config_flags%nested) i_end = MIN( ide-2, ite )
3125 IF ( config_flags%open_ys .OR. config_flags%specified .OR. &
3126 config_flags%nested) j_start = MAX( jds+1, jts )
3131 IF ( config_flags%open_ye .OR. config_flags%specified .OR. &
3132 config_flags%nested) j_end = MIN( jde-1, jte )
3137 IF ( config_flags%periodic_x ) i_start = its
3142 IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
3146 j_end = j_end + je_ext
3149 DO j=j_start-1,j_end
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
3167 DO j = j_start, j_end
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 ) )
3195 ! IF ( config_flags%sfs_opt .EQ. 1 ) THEN
3197 ! DO j=j_start,j_end
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) &
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) &
3218 ! DO j=j_start,j_end
3220 ! DO i=i_start,i_end
3221 ! delta = ( dx * dy / rdzw(i,k,j) )**0.33333333
3224 ! m23(i,k,j) = a*( 2.0*sqrt( tkef(i,k,j) )*ss23(i,k,j) &
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) &
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) &
3243 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
3245 Do K2_ADJ =jts-1, jte+1
3247 Do K0_ADJ =its-1, ite+1
3248 a_ss22(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3253 Do K2_ADJ =jts-1, jte+1
3255 Do K0_ADJ =its-1, ite+1
3256 a_ss33(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3261 Do K2_ADJ =jts-1, jte+1
3263 Do K0_ADJ =its-1, ite+1
3264 a_ss12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3269 Do K2_ADJ =jts-1, jte+1
3271 Do K0_ADJ =its-1, ite+1
3272 a_ss13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3277 Do K2_ADJ =jts-1, jte+1
3279 Do K0_ADJ =its-1, ite+1
3280 a_ss23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3285 Do K2_ADJ =jts-1, jte+1
3287 Do K0_ADJ =its-1, ite+1
3288 a_rr12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3293 Do K2_ADJ =jts-1, jte+1
3295 Do K0_ADJ =its-1, ite+1
3296 a_rr13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3301 Do K2_ADJ =jts-1, jte+1
3303 Do K0_ADJ =its-1, ite+1
3304 a_rr23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3309 Do K2_ADJ =jts-1, jte+1
3311 Do K0_ADJ =its-1, ite+1
3312 a_tkef(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3317 Do K2_ADJ =jts-1, jte+1
3319 Do K0_ADJ =its-1, ite+1
3320 a_ss22f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3325 Do K2_ADJ =jts-1, jte+1
3327 Do K0_ADJ =its-1, ite+1
3328 a_ss33f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3333 Do K2_ADJ =jts-1, jte+1
3335 Do K0_ADJ =its-1, ite+1
3336 a_ss12f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3341 Do K2_ADJ =jts-1, jte+1
3343 Do K0_ADJ =its-1, ite+1
3344 a_ss13f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3349 Do K2_ADJ =jts-1, jte+1
3351 Do K0_ADJ =its-1, ite+1
3352 a_rr12f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3357 Do K2_ADJ =jts-1, jte+1
3359 Do K0_ADJ =its-1, ite+1
3360 a_rr13f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3365 Do K2_ADJ =jts-1, jte+1
3367 Do K0_ADJ =its-1, ite+1
3368 a_smnsmnf(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
3377 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
3381 IF( config_flags%sfs_opt .EQ. 1 ) THEN
3382 DO j =j_start, j_end
3384 DO i =i_start, i_end
3385 delta =(dx*dy/rdzw(i,k,j))**0.33333333
3387 a =-1.0*(cs*delta)**2
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
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
3406 Tmpv017 =Tmpv008 +Tmpv016
3407 Tmpv401(i,k,j) =Tmpv017
3408 Tmpv018 =a*Tmpv401(i,k,j)
3415 DO j =j_start, j_end
3417 DO i =i_start, i_end
3418 delta =(dx*dy/rdzw(i,k,j))**0.33333333
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
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
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)
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
3460 delta =(dx*dy/rdzw(i,k,j))**0.33333333
3463 a_Tmpv18 =a_m23(i,k,j)
3465 a_a =a_a +Tmpv401(i,k,j)*a_Tmpv18
3466 a_Tmpv17 =a*a_Tmpv18
3469 a_Tmpv15 =c2*a_Tmpv16
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
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
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
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
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
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
3512 DO j =j_end, j_start, -1
3513 DO k =ktf, kts+1, -1
3514 DO i =i_end, i_start, -1
3518 a_Tmpv19 =a_m23(i,k,j)
3520 a_a =a_a +Tmpv405(i,k,j)*a_Tmpv19
3521 a_Tmpv18 =a*a_Tmpv19
3524 a_b =a_b +Tmpv404(i,k,j)*a_Tmpv17
3525 a_Tmpv16 =b*a_Tmpv17
3528 a_Tmpv14 =c2*a_Tmpv15
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
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
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
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
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
3560 a_delta =a_delta -1.0*ce*a_a
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
3574 DO j =j_end, j_start, -1
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
3641 DO k =ktf, kts+1, -1
3642 DO i =i_end, i_start, -1
3643 a_Tmpv4 =a_rr13f(i,k,j)
3645 a_Tmpv3 =0.25*a_Tmpv4
3647 a_rr13(i+1,k,j) =a_rr13(i+1,k,j) +a_Tmpv3
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)
3654 a_Tmpv3 =0.25*a_Tmpv4
3656 a_ss13(i+1,k,j) =a_ss13(i+1,k,j) +a_Tmpv3
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)
3663 a_Tmpv5 =0.5*a_Tmpv6
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)
3674 a_Tmpv5 =0.5*a_Tmpv6
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)
3685 a_Tmpv5 =0.5*a_Tmpv6
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)
3696 a_Tmpv5 =0.5*a_Tmpv6
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
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)
3718 a_Tmpv5 =0.5*a_Tmpv6
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
3733 DO j =j_end, j_start-1, -1
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
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)
3760 a_r13(i,k,j) =a_r13(i,k,j) +1.0/2.0*a_rr13(i,k,j)
3762 a_r12(i,k,j) =a_r12(i,k,j) +1.0/2.0*a_rr12(i,k,j)
3764 a_s23(i,k,j) =a_s23(i,k,j) +1.0/2.0*a_ss23(i,k,j)
3766 a_s13(i,k,j) =a_s13(i,k,j) +1.0/2.0*a_ss13(i,k,j)
3768 a_s12(i,k,j) =a_s12(i,k,j) +1.0/2.0*a_ss12(i,k,j)
3770 a_s33(i,k,j) =a_s33(i,k,j) +1.0/2.0*a_ss33(i,k,j)
3772 a_s22(i,k,j) =a_s22(i,k,j) +1.0/2.0*a_ss22(i,k,j)
3781 ! j_end =j_end+je_ext
3785 ! IF( config_flags%periodic_x ) THEN
3786 ! i_end =min(ite, ide-1)
3789 ! IF( config_flags%periodic_x ) THEN
3797 ! IF( config_flags%periodic_x ) THEN
3801 ! IF( config_flags%periodic_x ) THEN
3809 ! IF( config_flags%open_ye .OR. config_flags%specified .OR. config_flags%nested) THEN
3810 ! j_end =min(jde-1, jte)
3813 ! IF( config_flags%open_ye .OR. config_flags%specified .OR. &
3814 ! config_flags%nested) THEN
3822 ! IF( config_flags%open_ys .OR. config_flags%specified .OR. config_flags%nested) THEN
3823 ! j_start =max(jds+1, jts)
3826 ! IF( config_flags%open_ys .OR. config_flags%specified .OR. &
3827 ! config_flags%nested) THEN
3835 ! IF( config_flags%open_xe .OR. config_flags%specified .OR. config_flags%nested) THEN
3836 ! i_end =min(ide-2, ite)
3839 ! IF( config_flags%open_xe .OR. config_flags%specified .OR. &
3840 ! config_flags%nested) THEN
3848 ! IF( config_flags%open_xs .OR. config_flags%specified .OR. config_flags%nested) THEN
3849 ! i_start =max(ids+1, its)
3852 ! IF( config_flags%open_xs .OR. config_flags%specified .OR. &
3853 ! config_flags%nested) THEN
3858 ! ktf =min(kte, kde-1)
3860 ! i_end =min(ite, ide-1)
3865 END SUBROUTINE a_calc_m23
3867 END MODULE a_module_sfs_nba