! ====================================================================================== ! This file was generated by the version 4.3.7 of ADG on 08/16/2010. The Adjoint Code ! Generator (ADG) was developed and sponsored by LASG of IAP (1999-2010) ! The Copyright of the ADG system was declared by Walls at LASG, 1999-2010 ! ====================================================================================== MODULE a_module_sfs_nba USE module_configure, ONLY : grid_config_rec_type USE module_sfs_nba, ONLY : c1, c2, c3, ce, cb, cs ! Added by Ning Pan, 2010-08-18 IMPLICIT NONE INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ ! REAL :: c1,c2,c3,ce,cb,cs ! Remarked by Ning Pan, 2010-08-18 ! a_F90 =0.0 CONTAINS ! Remarked by Ning Pan, 2010-08-18 ! SUBROUTINE a_calc_mij_constants() !PART! I: DECLARATION OF VARIABLES ! IMPLICIT NONE ! INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ ! REAL :: sk,pi !PART! II: CALCULATIONS OF B. S. TRAJECTORY !PART! III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS !! a_F90 =0.0 !PART! IV: REVERSE/BACKWARD ACCUMULATIONS !REVISED! BY WALLS !LPB[0] ! sk =0.5 ! pi =3.1415927 ! cb =0.36 ! cs =((8.0*(1.0+cb))/(27.0*pi**2))**0.5 ! c1 =((960.0**0.5)*cb)/(7.0*(1.0+cb)*sk) ! c2 =c1 ! ce =((8.0*pi/27.0)**(1.0/3.0))*cs**(4.0/3.0) ! c3 =((27.0/(8.0*pi))**(1.0/3.0))*cs**(2.0/3.0) ! Return ! END SUBROUTINE a_calc_mij_constants SUBROUTINE a_calc_smnsmn(smnsmn,a_smnsmn,s11,a_s11,s22,a_s22,s33,a_s33,s12, & a_s12,s13,a_s13,s23,a_s23,config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, & kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte) !PART I: DECLARATION OF VARIABLES IMPLICIT NONE INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: smnsmn,a_smnsmn REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s11,a_s11,s22,a_s22,s33,a_s33,s12, & a_s12,s13,a_s13,s23,a_s23 TYPE(grid_config_rec_type) :: config_flags INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, & its,ite,jts,jte,kts,kte REAL :: tmp,a_tmp INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf REAL,DIMENSION(max(jds+1,jts):min(jde-2,jte)) :: Keep_Lpb14_tmp ! REAL,DIMENSION(max(jds+1,jts):min(jde-2,jte)) :: Keep_Lpb15_tmp REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004 REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv300 !PART II: CALCULATIONS OF B. S. TRAJECTORY !LPB[0] ktf = min(kte,kde-1) i_start = its i_end = MIN(ite,ide-1) j_start = jts j_end = MIN(jte,jde-1) !LPB[1] IF ( config_flags%open_xs .or. config_flags%specified .or. & config_flags%nested) i_start = MAX(ids+1,its) !LPB[2] !LPB[3] IF ( config_flags%open_xe .or. config_flags%specified .or. & config_flags%nested) i_end = MIN(ide-2,ite) !LPB[4] !LPB[5] IF ( config_flags%open_ys .or. config_flags%specified .or. & config_flags%nested) j_start = MAX(jds+1,jts) !LPB[6] !LPB[7] IF ( config_flags%open_ye .or. config_flags%specified .or. & config_flags%nested) j_end = MIN(jde-2,jte) !LPB[8] !LPB[9] IF ( config_flags%periodic_x ) i_start = its !LPB[10] !LPB[11] IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) ! Remarked by Ning Pan, 2010-08-18 : LPB[12]-[14] !LPB[12] ! DO j=j_start,j_end ! DO k=kts,ktf ! DO i=i_start,i_end ! smnsmn(i,k,j) = 0.25*( s11(i,k,j)*s11(i,k,j) + & ! s22(i,k,j)*s22(i,k,j) + & ! s33(i,k,j)*s33(i,k,j) ) ! END DO ! END DO ! END DO !LPB[13] ! DO j=j_start,j_end ! DO k=kts,ktf ! DO i=i_start,i_end ! tmp = 0.125*( s12(i ,k,j) + s12(i ,k,j+1) + & ! s12(i+1,k,j) + s12(i+1,k,j+1) ) ! smnsmn(i,k,j) = smnsmn(i,k,j) + 2.0*tmp*tmp ! END DO ! END DO ! END DO !LPB[14] ! DO j=j_start,j_end ! Keep_Lpb14_tmp(j) =tmp ! DO k=kts,ktf ! DO i=i_start,i_end ! tmp = 0.125*( s13(i ,k+1,j) + s13(i ,k,j) + & ! s13(i+1,k+1,j) + s13(i+1,k,j) ) ! smnsmn(i,k,j) = smnsmn(i,k,j) + 2.0*tmp*tmp ! END DO ! END DO ! END DO !!LPB[15] ! DO j=j_start,j_end ! ! Keep_Lpb15_tmp(j) =tmp ! DO k=kts,ktf ! DO i=i_start,i_end ! tmp = 0.125*( s23(i,k+1,j ) + s23(i,k,j ) + & ! s23(i,k+1,j+1) + s23(i,k,j+1) ) ! smnsmn(i,k,j) = smnsmn(i,k,j) + 2.0*tmp*tmp ! END DO ! END DO ! END DO !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS a_tmp =0.0 !PART IV: REVERSE/BACKWARD ACCUMULATIONS !LPB[15] DO j =j_end, j_start, -1 ! tmp =Keep_Lpb15_tmp(j) DO k =kts, ktf DO i =i_start, i_end Tmpv001 =s23(i,k+1,j) +s23(i,k,j) Tmpv002 =Tmpv001 +s23(i,k+1,j+1) Tmpv003 =Tmpv002 +s23(i,k,j+1) Tmpv004 =0.125*Tmpv003 tmp =Tmpv004 Tmpv300(i,k) =tmp ! Remarked by Ning Pan, 2010-08-18 ! Tmpv001 =smnsmn(i,k,j) +2.0*tmp*tmp ! smnsmn(i,k,j) =Tmpv001 ENDDO ENDDO DO k =ktf, kts, -1 DO i =i_end, i_start, -1 tmp =Tmpv300(i,k) ! Added by Ning Pan, 2010-08-18 a_Tmpv1 =a_smnsmn(i,k,j) a_smnsmn(i,k,j) =0.0 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +a_Tmpv1 a_tmp =a_tmp +(2.0*tmp +2.0*tmp)*a_Tmpv1 ! tmp =Tmpv300(i,k) ! Remarked by Ning Pan, 2010-08-18 a_Tmpv4 =a_tmp a_tmp =0.0 a_Tmpv3 =0.125*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_s23(i,k,j+1) =a_s23(i,k,j+1) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_s23(i,k+1,j+1) =a_s23(i,k+1,j+1) +a_Tmpv2 a_s23(i,k+1,j) =a_s23(i,k+1,j) +a_Tmpv1 a_s23(i,k,j) =a_s23(i,k,j) +a_Tmpv1 ENDDO ENDDO ENDDO !LPB[14] DO j =j_end, j_start, -1 ! tmp =Keep_Lpb14_tmp(j) ! Remarked by Ning Pan, 2010-08-18 DO k =kts, ktf DO i =i_start, i_end Tmpv001 =s13(i,k+1,j) +s13(i,k,j) Tmpv002 =Tmpv001 +s13(i+1,k+1,j) Tmpv003 =Tmpv002 +s13(i+1,k,j) Tmpv004 =0.125*Tmpv003 tmp =Tmpv004 Tmpv300(i,k) =tmp ! Remarked by Ning Pan, 2010-08-18 ! Tmpv001 =smnsmn(i,k,j) +2.0*tmp*tmp ! smnsmn(i,k,j) =Tmpv001 ENDDO ENDDO DO k =ktf, kts, -1 DO i =i_end, i_start, -1 tmp =Tmpv300(i,k) ! Added by Ning Pan, 2010-08-18 a_Tmpv1 =a_smnsmn(i,k,j) a_smnsmn(i,k,j) =0.0 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +a_Tmpv1 a_tmp =a_tmp +(2.0*tmp +2.0*tmp)*a_Tmpv1 ! tmp =Tmpv300(i,k) ! Remarked by Ning Pan, 2010-08-18 a_Tmpv4 =a_tmp a_tmp =0.0 a_Tmpv3 =0.125*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_s13(i+1,k,j) =a_s13(i+1,k,j) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_s13(i+1,k+1,j) =a_s13(i+1,k+1,j) +a_Tmpv2 a_s13(i,k+1,j) =a_s13(i,k+1,j) +a_Tmpv1 a_s13(i,k,j) =a_s13(i,k,j) +a_Tmpv1 ENDDO ENDDO ENDDO !LPB[13] DO j =j_end, j_start, -1 DO k =kts, ktf DO i =i_start, i_end Tmpv001 =s12(i,k,j) +s12(i,k,j+1) Tmpv002 =Tmpv001 +s12(i+1,k,j) Tmpv003 =Tmpv002 +s12(i+1,k,j+1) Tmpv004 =0.125*Tmpv003 tmp =Tmpv004 Tmpv300(i,k) =tmp ! Remarked by Ning Pan, 2010-08-18 ! Tmpv001 =smnsmn(i,k,j) +2.0*tmp*tmp ! smnsmn(i,k,j) =Tmpv001 ENDDO ENDDO DO k =ktf, kts, -1 DO i =i_end, i_start, -1 tmp =Tmpv300(i,k) ! Added by Ning Pan, 2010-08-18 a_Tmpv1 =a_smnsmn(i,k,j) a_smnsmn(i,k,j) =0.0 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +a_Tmpv1 a_tmp =a_tmp +(2.0*tmp +2.0*tmp)*a_Tmpv1 ! tmp =Tmpv300(i,k) ! Remarked by Ning Pan, 2010-08-18 a_Tmpv4 =a_tmp a_tmp =0.0 a_Tmpv3 =0.125*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_s12(i+1,k,j+1) =a_s12(i+1,k,j+1) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_s12(i+1,k,j) =a_s12(i+1,k,j) +a_Tmpv2 a_s12(i,k,j) =a_s12(i,k,j) +a_Tmpv1 a_s12(i,k,j+1) =a_s12(i,k,j+1) +a_Tmpv1 ENDDO ENDDO ENDDO !LPB[12] DO j =j_end, j_start, -1 ! DO k =kts, ktf ! DO i =i_start, i_end ! Tmpv001 =s11(i,k,j)*s11(i,k,j) +s22(i,k,j)*s22(i,k,j) ! Tmpv002 =Tmpv001 +s33(i,k,j)*s33(i,k,j) ! Tmpv003 =0.25*Tmpv002 ! smnsmn(i,k,j) =Tmpv003 ! ENDDO ! ENDDO DO k =ktf, kts, -1 DO i =i_end, i_start, -1 a_Tmpv3 =a_smnsmn(i,k,j) a_smnsmn(i,k,j) =0.0 a_Tmpv2 =0.25*a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_s33(i,k,j) =a_s33(i,k,j) +2.0*s33(i,k,j)*a_Tmpv2 a_s11(i,k,j) =a_s11(i,k,j) +2.0*s11(i,k,j)*a_Tmpv1 a_s22(i,k,j) =a_s22(i,k,j) +2.0*s22(i,k,j)*a_Tmpv1 ENDDO ENDDO ENDDO !LPB[11] ! IF( config_flags%periodic_x ) THEN ! i_end =min(ite, ide-1) ! END IF ! IF( config_flags%periodic_x ) THEN ! END IF !LPB[10] !LPB[9] ! IF( config_flags%periodic_x ) THEN ! i_start =its ! END IF ! IF( config_flags%periodic_x ) THEN ! END IF !LPB[8] !LPB[7] ! IF( config_flags%open_ye .or. config_flags%specified .or. config_flags%nested) THEN ! j_end =min(jde-2, jte) ! END IF ! IF( config_flags%open_ye .or. config_flags%specified .or. & ! config_flags%nested) THEN ! END IF !LPB[6] !LPB[5] ! IF( config_flags%open_ys .or. config_flags%specified .or. config_flags%nested) THEN ! j_start =max(jds+1, jts) ! END IF ! IF( config_flags%open_ys .or. config_flags%specified .or. & ! config_flags%nested) THEN ! END IF !LPB[4] !LPB[3] ! IF( config_flags%open_xe .or. config_flags%specified .or. config_flags%nested) THEN ! i_end =min(ide-2, ite) ! END IF ! IF( config_flags%open_xe .or. config_flags%specified .or. & ! config_flags%nested) THEN ! END IF !LPB[2] !LPB[1] ! IF( config_flags%open_xs .or. config_flags%specified .or. config_flags%nested) THEN ! i_start =max(ids+1, its) ! END IF ! IF( config_flags%open_xs .or. config_flags%specified .or. & ! config_flags%nested) THEN ! END IF !LPB[0] ! ktf =min(kte, kde-1) ! i_start =its ! i_end =min(ite, ide-1) ! j_start =jts ! j_end =min(jte, jde-1) Return END SUBROUTINE a_calc_smnsmn SUBROUTINE a_calc_mii(m11,a_m11,m22,a_m22,m33,a_m33,s11,a_s11,s22,a_s22, & s33,a_s33,s12,a_s12,s13,a_s13,s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23, & smnsmn,a_smnsmn,tke,a_tke,rdzw,a_rdzw,dx,dy,config_flags,ids,ide,jds,jde,kds, & kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte) !PART I: DECLARATION OF VARIABLES IMPLICIT NONE INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: m11,a_m11,m22,a_m22,m33,a_m33 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s11,a_s11,s22,a_s22,s33,a_s33,s12, & a_s12,s13,a_s13,s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23,smnsmn, & a_smnsmn,tke,a_tke,rdzw,a_rdzw REAL :: dx,dy TYPE(grid_config_rec_type) :: config_flags INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, & its,ite,jts,jte,kts,kte REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss11,a_ss11,ss22,a_ss22,ss33, & a_ss33,ss12,a_ss12,ss13,a_ss13,ss23,a_ss23,rr12,a_rr12,rr13,a_rr13,rr23,a_rr23 REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss12c,a_ss12c,rr12c,a_rr12c, & ss13c,a_ss13c,rr13c,a_rr13c,ss23c,a_ss23c,rr23c,a_rr23c REAL :: delta,a_delta,a,a_a,b,a_b INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf,is_ext,js_ext REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, & a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9, & Tmpv009,a_Tmpv10,Tmpv010,a_Tmpv11,Tmpv011,a_Tmpv12,Tmpv012,a_Tmpv13,Tmpv013, & a_Tmpv14,Tmpv014 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) & :: Tmpv400 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) & :: Tmpv401 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) & :: Tmpv402 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) & :: Tmpv403 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) & :: Tmpv404 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) & :: Tmpv405 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) & :: Tmpv406 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) & :: Tmpv407 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) & :: Tmpv408 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) & :: Tmpv409 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) & :: Tmpv4010 REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts-1:min(jde-1,jte)) & :: Tmpv4011 REAL :: g_Sqrt !PART II: CALCULATIONS OF B. S. TRAJECTORY !LPB[0] ktf = MIN( kte, kde-1 ) i_start = its i_end = ite j_start = jts j_end = jte !LPB[1] IF ( config_flags%open_xs .OR. config_flags%specified .OR. & config_flags%nested) i_start = MAX( ids+1, its ) !LPB[2] !LPB[3] IF ( config_flags%open_xe .OR. config_flags%specified .OR. & config_flags%nested) i_end = MIN( ide-1, ite ) !LPB[4] !LPB[5] IF ( config_flags%open_ys .OR. config_flags%specified .OR. & config_flags%nested) j_start = MAX( jds+1, jts ) !LPB[6] !LPB[7] IF ( config_flags%open_ye .OR. config_flags%specified .OR. & config_flags%nested) j_end = MIN( jde-1, jte ) !LPB[8] !LPB[9] IF ( config_flags%periodic_x ) i_start = its !LPB[10] !LPB[11] IF ( config_flags%periodic_x ) i_end = ite !LPB[12] is_ext = 1 js_ext = 1 i_start = i_start - is_ext j_start = j_start - js_ext !LPB[13] DO j=j_start,j_end+1 DO k=kts,ktf DO i=i_start,i_end+1 ss11(i,k,j)=s11(i,k,j)/2.0 ss22(i,k,j)=s22(i,k,j)/2.0 ss33(i,k,j)=s33(i,k,j)/2.0 ss12(i,k,j)=s12(i,k,j)/2.0 ss13(i,k,j)=s13(i,k,j)/2.0 ss23(i,k,j)=s23(i,k,j)/2.0 rr12(i,k,j)=r12(i,k,j)/2.0 rr13(i,k,j)=r13(i,k,j)/2.0 rr23(i,k,j)=r23(i,k,j)/2.0 END DO END DO END DO !LPB[14] DO j=j_start,j_end+1 DO i=i_start,i_end+1 ss13(i,kde,j) = 0.0 ss23(i,kde,j) = 0.0 rr13(i,kde,j) = 0.0 rr23(i,kde,j) = 0.0 END DO END DO !LPB[15] DO j = j_start, j_end DO k = kts, ktf DO i = i_start, i_end ss12c(i,k,j) = 0.25*( ss12(i ,k ,j ) + ss12(i ,k ,j+1) + & ss12(i+1,k ,j ) + ss12(i+1,k ,j+1) ) rr12c(i,k,j) = 0.25*( rr12(i ,k ,j ) + rr12(i ,k ,j+1) + & rr12(i+1,k ,j ) + rr12(i+1,k ,j+1) ) ss13c(i,k,j) = 0.25*( ss13(i ,k+1,j ) + ss13(i ,k ,j ) + & ss13(i+1,k+1,j ) + ss13(i+1,k ,j ) ) rr13c(i,k,j) = 0.25*( rr13(i ,k+1,j ) + rr13(i ,k ,j ) + & rr13(i+1,k+1,j ) + rr13(i+1,k ,j ) ) ss23c(i,k,j) = 0.25*( ss23(i ,k+1,j ) + ss23(i ,k ,j ) + & ss23(i ,k+1,j+1) + ss23(i ,k ,j+1) ) rr23c(i,k,j) = 0.25*( rr23(i ,k+1,j ) + rr23(i ,k ,j ) + & rr23(i ,k+1,j+1) + rr23(i ,k ,j+1) ) ENDDO ENDDO ENDDO !LPB[16] !!LPB[17] ! IF ( config_flags%sfs_opt .EQ. 1 ) THEN ! DO j=j_start,j_end ! DO k=kts,ktf ! DO i=i_start,i_end ! delta = ( dx * dy / rdzw(i,k,j) )**0.33333333 ! a = -1.0*( cs*delta )**2 ! m11(i,k,j) = a*( 2.0*sqrt( 2.0*smnsmn(i,k,j) )*ss11(i,k,j) & ! + c1*( ss11(i,k,j) *ss11(i,k,j) & ! + ss12c(i,k,j)*ss12c(i,k,j) & ! + ss13c(i,k,j)*ss13c(i,k,j) & ! - smnsmn(i,k,j)/3.0 & ! ) & ! + c2*( -2.0*( ss12c(i,k,j)*rr12c(i,k,j) & ! + ss13c(i,k,j)*rr13c(i,k,j) & ! ) & ! ) & ! ) ! m22(i,k,j) = a*( 2.0*sqrt( 2.0*smnsmn(i,k,j) )*ss22(i,k,j) & ! + c1*( ss22(i,k,j) *ss22(i,k,j) & ! + ss12c(i,k,j)*ss12c(i,k,j) & ! + ss23c(i,k,j)*ss23c(i,k,j) & ! - smnsmn(i,k,j)/3.0 & ! ) & ! + c2*( 2.0*( ss12c(i,k,j)*rr12c(i,k,j) & ! - ss23c(i,k,j)*rr23c(i,k,j) & ! ) & ! ) & ! ) ! m33(i,k,j) = a*( 2.0*sqrt( 2.0*smnsmn(i,k,j) )*ss33(i,k,j) & ! + c1*( ss33(i,k,j) *ss33(i,k,j) & ! + ss13c(i,k,j)*ss13c(i,k,j) & ! + ss23c(i,k,j)*ss23c(i,k,j) & ! - smnsmn(i,k,j)/3.0 & ! ) & ! + c2*( 2.0*( ss13c(i,k,j)*rr13c(i,k,j) & ! + ss23c(i,k,j)*rr23c(i,k,j) & ! ) & ! ) & ! ) ! ENDDO ! ENDDO ! ENDDO ! ELSE ! DO j=j_start,j_end ! DO k=kts,ktf ! DO i=i_start,i_end ! delta = ( dx * dy / rdzw(i,k,j) )**0.33333333 ! a = -1.0*ce*delta ! b = c3*delta ! m11(i,k,j) = a*( 2.0*sqrt( tke(i,k,j) )*ss11(i,k,j) & ! + b*( & ! c1*( ss11(i,k,j) *ss11(i,k,j) & ! + ss12c(i,k,j)*ss12c(i,k,j) & ! + ss13c(i,k,j)*ss13c(i,k,j) & ! - smnsmn(i,k,j)/3.0 & ! ) & ! + c2*( -2.0*( ss12c(i,k,j)*rr12c(i,k,j) & ! + ss13c(i,k,j)*rr13c(i,k,j) & ! ) & ! ) & ! ) & ! ) ! m22(i,k,j) = a*( 2.0*sqrt( tke(i,k,j) )*ss22(i,k,j) & ! + b*( & ! c1*( ss22(i,k,j) *ss22(i,k,j) & ! + ss12c(i,k,j)*ss12c(i,k,j) & ! + ss23c(i,k,j)*ss23c(i,k,j) & ! - smnsmn(i,k,j)/3.0 & ! ) & ! + c2*( 2.0*( ss12c(i,k,j)*rr12c(i,k,j) & ! - ss23c(i,k,j)*rr23c(i,k,j) & ! ) & ! ) & ! ) & ! ) ! m33(i,k,j) = a*( 2.0*sqrt( tke(i,k,j) )*ss33(i,k,j) & ! + b*( & ! c1*( ss33(i,k,j) *ss33(i,k,j) & ! + ss13c(i,k,j)*ss13c(i,k,j) & ! + ss23c(i,k,j)*ss23c(i,k,j) & ! - smnsmn(i,k,j)/3.0 & ! ) & ! + c2*( 2.0*( ss13c(i,k,j)*rr13c(i,k,j) & ! + ss23c(i,k,j)*rr23c(i,k,j) & ! ) & ! ) & ! ) & ! ) ! ENDDO ! ENDDO ! ENDDO ! ENDIF !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss11(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss22(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss33(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss12c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr12c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss13c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr13c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss23c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr23c(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do a_delta =0.0 a_a =0.0 a_b =0.0 !PART IV: REVERSE/BACKWARD ACCUMULATIONS !LPB[17] IF( config_flags%sfs_opt .EQ. 1 ) THEN DO j =j_start, j_end DO k =kts, ktf DO i =i_start, i_end delta =(dx*dy/rdzw(i,k,j))**0.33333333 a =-1.0*(cs*delta)**2 Tmpv400(i,k,j) =a Tmpv001 =2.0*sqrt(2.0*smnsmn(i,k,j))*ss11(i,k,j) Tmpv002 =ss11(i,k,j)*ss11(i,k,j) +ss12c(i,k,j)*ss12c(i,k,j) Tmpv003 =Tmpv002 +ss13c(i,k,j)*ss13c(i,k,j) Tmpv004 =Tmpv003 -smnsmn(i,k,j)/3.0 Tmpv005 =c1*Tmpv004 Tmpv006 =Tmpv001 +Tmpv005 Tmpv007 =ss12c(i,k,j)*rr12c(i,k,j) Tmpv008 =ss13c(i,k,j)*rr13c(i,k,j) Tmpv009 =Tmpv007 +Tmpv008 Tmpv010 =-2.0*Tmpv009 Tmpv011 =c2*Tmpv010 Tmpv012 =Tmpv006 +Tmpv011 Tmpv401(i,k,j) =Tmpv012 Tmpv013 =a*Tmpv401(i,k,j) m11(i,k,j) =Tmpv013 Tmpv001 =2.0*sqrt(2.0*smnsmn(i,k,j))*ss22(i,k,j) Tmpv002 =ss22(i,k,j)*ss22(i,k,j) +ss12c(i,k,j)*ss12c(i,k,j) Tmpv003 =Tmpv002 +ss23c(i,k,j)*ss23c(i,k,j) Tmpv004 =Tmpv003 -smnsmn(i,k,j)/3.0 Tmpv005 =c1*Tmpv004 Tmpv006 =Tmpv001 +Tmpv005 Tmpv007 =ss12c(i,k,j)*rr12c(i,k,j) Tmpv008 =ss23c(i,k,j)*rr23c(i,k,j) Tmpv009 =Tmpv007 -Tmpv008 Tmpv010 =2.0*Tmpv009 Tmpv011 =c2*Tmpv010 Tmpv012 =Tmpv006 +Tmpv011 Tmpv402(i,k,j) =Tmpv012 Tmpv013 =a*Tmpv402(i,k,j) m22(i,k,j) =Tmpv013 Tmpv001 =2.0*sqrt(2.0*smnsmn(i,k,j))*ss33(i,k,j) Tmpv002 =ss33(i,k,j)*ss33(i,k,j) +ss13c(i,k,j)*ss13c(i,k,j) Tmpv003 =Tmpv002 +ss23c(i,k,j)*ss23c(i,k,j) Tmpv004 =Tmpv003 -smnsmn(i,k,j)/3.0 Tmpv005 =c1*Tmpv004 Tmpv006 =Tmpv001 +Tmpv005 Tmpv007 =ss13c(i,k,j)*rr13c(i,k,j) Tmpv008 =ss23c(i,k,j)*rr23c(i,k,j) Tmpv009 =Tmpv007 +Tmpv008 Tmpv010 =2.0*Tmpv009 Tmpv011 =c2*Tmpv010 Tmpv012 =Tmpv006 +Tmpv011 Tmpv403(i,k,j) =Tmpv012 Tmpv013 =a*Tmpv403(i,k,j) m33(i,k,j) =Tmpv013 ENDDO ENDDO ENDDO ELSE DO j =j_start, j_end DO k =kts, ktf DO i =i_start, i_end delta =(dx*dy/rdzw(i,k,j))**0.33333333 a =-1.0*ce*delta Tmpv404(i,k,j) =a b =c3*delta Tmpv405(i,k,j) =b Tmpv001 =2.0*sqrt(tke(i,k,j))*ss11(i,k,j) Tmpv002 =ss11(i,k,j)*ss11(i,k,j) +ss12c(i,k,j)*ss12c(i,k,j) Tmpv003 =Tmpv002 +ss13c(i,k,j)*ss13c(i,k,j) Tmpv004 =Tmpv003 -smnsmn(i,k,j)/3.0 Tmpv005 =c1*Tmpv004 Tmpv006 =ss12c(i,k,j)*rr12c(i,k,j) Tmpv007 =ss13c(i,k,j)*rr13c(i,k,j) Tmpv008 =Tmpv006 +Tmpv007 Tmpv009 =-2.0*Tmpv008 Tmpv010 =c2*Tmpv009 Tmpv011 =Tmpv005 +Tmpv010 Tmpv406(i,k,j) =Tmpv011 Tmpv012 =b*Tmpv406(i,k,j) Tmpv013 =Tmpv001 +Tmpv012 Tmpv407(i,k,j) =Tmpv013 Tmpv014 =a*Tmpv407(i,k,j) m11(i,k,j) =Tmpv014 Tmpv001 =2.0*sqrt(tke(i,k,j))*ss22(i,k,j) Tmpv002 =ss22(i,k,j)*ss22(i,k,j) +ss12c(i,k,j)*ss12c(i,k,j) Tmpv003 =Tmpv002 +ss23c(i,k,j)*ss23c(i,k,j) Tmpv004 =Tmpv003 -smnsmn(i,k,j)/3.0 Tmpv005 =c1*Tmpv004 Tmpv006 =ss12c(i,k,j)*rr12c(i,k,j) Tmpv007 =ss23c(i,k,j)*rr23c(i,k,j) Tmpv008 =Tmpv006 -Tmpv007 Tmpv009 =2.0*Tmpv008 Tmpv010 =c2*Tmpv009 Tmpv011 =Tmpv005 +Tmpv010 Tmpv408(i,k,j) =Tmpv011 Tmpv012 =b*Tmpv408(i,k,j) Tmpv013 =Tmpv001 +Tmpv012 Tmpv409(i,k,j) =Tmpv013 Tmpv014 =a*Tmpv409(i,k,j) m22(i,k,j) =Tmpv014 Tmpv001 =2.0*sqrt(tke(i,k,j))*ss33(i,k,j) Tmpv002 =ss33(i,k,j)*ss33(i,k,j) +ss13c(i,k,j)*ss13c(i,k,j) Tmpv003 =Tmpv002 +ss23c(i,k,j)*ss23c(i,k,j) Tmpv004 =Tmpv003 -smnsmn(i,k,j)/3.0 Tmpv005 =c1*Tmpv004 Tmpv006 =ss13c(i,k,j)*rr13c(i,k,j) Tmpv007 =ss23c(i,k,j)*rr23c(i,k,j) Tmpv008 =Tmpv006 +Tmpv007 Tmpv009 =2.0*Tmpv008 Tmpv010 =c2*Tmpv009 Tmpv011 =Tmpv005 +Tmpv010 Tmpv4010(i,k,j) =Tmpv011 Tmpv012 =b*Tmpv4010(i,k,j) Tmpv013 =Tmpv001 +Tmpv012 Tmpv4011(i,k,j) =Tmpv013 Tmpv014 =a*Tmpv4011(i,k,j) m33(i,k,j) =Tmpv014 ENDDO ENDDO ENDDO ENDIF IF( config_flags%sfs_opt .EQ. 1 ) THEN DO j =j_end, j_start, -1 DO k =ktf, kts, -1 DO i =i_end, i_start, -1 delta =(dx*dy/rdzw(i,k,j))**0.33333333 a =Tmpv400(i,k,j) a_Tmpv13 =a_m33(i,k,j) a_m33(i,k,j) =0.0 a_a =a_a +Tmpv403(i,k,j)*a_Tmpv13 a_Tmpv12 =a*a_Tmpv13 a_Tmpv6 =a_Tmpv12 a_Tmpv11 =a_Tmpv12 a_Tmpv10 =c2*a_Tmpv11 a_Tmpv9 =2.0*a_Tmpv10 a_Tmpv7 =a_Tmpv9 a_Tmpv8 =a_Tmpv9 a_ss23c(i,k,j) =a_ss23c(i,k,j) +rr23c(i,k,j)*a_Tmpv8 a_rr23c(i,k,j) =a_rr23c(i,k,j) +ss23c(i,k,j)*a_Tmpv8 a_ss13c(i,k,j) =a_ss13c(i,k,j) +rr13c(i,k,j)*a_Tmpv7 a_rr13c(i,k,j) =a_rr13c(i,k,j) +ss13c(i,k,j)*a_Tmpv7 a_Tmpv1 =a_Tmpv6 a_Tmpv5 =a_Tmpv6 a_Tmpv4 =c1*a_Tmpv5 a_Tmpv3 =a_Tmpv4 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss23c(i,k,j) =a_ss23c(i,k,j) +2.0*ss23c(i,k,j)*a_Tmpv3 a_ss33(i,k,j) =a_ss33(i,k,j) +2.0*ss33(i,k,j)*a_Tmpv2 a_ss13c(i,k,j) =a_ss13c(i,k,j) +2.0*ss13c(i,k,j)*a_Tmpv2 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +2.0*g_Sqrt(2.0, 2.0*smnsmn(i,k,j)) & *ss33(i,k,j)*a_Tmpv1 a_ss33(i,k,j) =a_ss33(i,k,j) +2.0*sqrt(2.0*smnsmn(i,k,j))*a_Tmpv1 a_Tmpv13 =a_m22(i,k,j) a_m22(i,k,j) =0.0 a_a =a_a +Tmpv402(i,k,j)*a_Tmpv13 a_Tmpv12 =a*a_Tmpv13 a_Tmpv6 =a_Tmpv12 a_Tmpv11 =a_Tmpv12 a_Tmpv10 =c2*a_Tmpv11 a_Tmpv9 =2.0*a_Tmpv10 a_Tmpv7 =a_Tmpv9 a_Tmpv8 =-a_Tmpv9 a_ss23c(i,k,j) =a_ss23c(i,k,j) +rr23c(i,k,j)*a_Tmpv8 a_rr23c(i,k,j) =a_rr23c(i,k,j) +ss23c(i,k,j)*a_Tmpv8 a_ss12c(i,k,j) =a_ss12c(i,k,j) +rr12c(i,k,j)*a_Tmpv7 a_rr12c(i,k,j) =a_rr12c(i,k,j) +ss12c(i,k,j)*a_Tmpv7 a_Tmpv1 =a_Tmpv6 a_Tmpv5 =a_Tmpv6 a_Tmpv4 =c1*a_Tmpv5 a_Tmpv3 =a_Tmpv4 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss23c(i,k,j) =a_ss23c(i,k,j) +2.0*ss23c(i,k,j)*a_Tmpv3 a_ss22(i,k,j) =a_ss22(i,k,j) +2.0*ss22(i,k,j)*a_Tmpv2 a_ss12c(i,k,j) =a_ss12c(i,k,j) +2.0*ss12c(i,k,j)*a_Tmpv2 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +2.0*g_Sqrt(2.0, 2.0*smnsmn(i,k,j)) & *ss22(i,k,j)*a_Tmpv1 a_ss22(i,k,j) =a_ss22(i,k,j) +2.0*sqrt(2.0*smnsmn(i,k,j))*a_Tmpv1 a_Tmpv13 =a_m11(i,k,j) a_m11(i,k,j) =0.0 a_a =a_a +Tmpv401(i,k,j)*a_Tmpv13 a_Tmpv12 =a*a_Tmpv13 a_Tmpv6 =a_Tmpv12 a_Tmpv11 =a_Tmpv12 a_Tmpv10 =c2*a_Tmpv11 a_Tmpv9 =-2.0*a_Tmpv10 a_Tmpv7 =a_Tmpv9 a_Tmpv8 =a_Tmpv9 a_ss13c(i,k,j) =a_ss13c(i,k,j) +rr13c(i,k,j)*a_Tmpv8 a_rr13c(i,k,j) =a_rr13c(i,k,j) +ss13c(i,k,j)*a_Tmpv8 a_ss12c(i,k,j) =a_ss12c(i,k,j) +rr12c(i,k,j)*a_Tmpv7 a_rr12c(i,k,j) =a_rr12c(i,k,j) +ss12c(i,k,j)*a_Tmpv7 a_Tmpv1 =a_Tmpv6 a_Tmpv5 =a_Tmpv6 a_Tmpv4 =c1*a_Tmpv5 a_Tmpv3 =a_Tmpv4 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss13c(i,k,j) =a_ss13c(i,k,j) +2.0*ss13c(i,k,j)*a_Tmpv3 a_ss11(i,k,j) =a_ss11(i,k,j) +2.0*ss11(i,k,j)*a_Tmpv2 a_ss12c(i,k,j) =a_ss12c(i,k,j) +2.0*ss12c(i,k,j)*a_Tmpv2 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +2.0*g_Sqrt(2.0, 2.0*smnsmn(i,k,j)) & *ss11(i,k,j)*a_Tmpv1 a_ss11(i,k,j) =a_ss11(i,k,j) +2.0*sqrt(2.0*smnsmn(i,k,j))*a_Tmpv1 ! a =Tmpv400(i,k,j) a_delta =a_delta -1.0*2.0*(cs*delta)*cs*a_a a_a =0.0 a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx* & dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta a_delta =0.0 ENDDO ENDDO ENDDO ELSE DO j =j_end, j_start, -1 DO k =ktf, kts, -1 DO i =i_end, i_start, -1 a =Tmpv404(i,k,j) b =Tmpv405(i,k,j) a_Tmpv14 =a_m33(i,k,j) a_m33(i,k,j) =0.0 a_a =a_a +Tmpv4011(i,k,j)*a_Tmpv14 a_Tmpv13 =a*a_Tmpv14 a_Tmpv1 =a_Tmpv13 a_Tmpv12 =a_Tmpv13 a_b =a_b +Tmpv4010(i,k,j)*a_Tmpv12 a_Tmpv11 =b*a_Tmpv12 a_Tmpv5 =a_Tmpv11 a_Tmpv10 =a_Tmpv11 a_Tmpv9 =c2*a_Tmpv10 a_Tmpv8 =2.0*a_Tmpv9 a_Tmpv6 =a_Tmpv8 a_Tmpv7 =a_Tmpv8 a_ss23c(i,k,j) =a_ss23c(i,k,j) +rr23c(i,k,j)*a_Tmpv7 a_rr23c(i,k,j) =a_rr23c(i,k,j) +ss23c(i,k,j)*a_Tmpv7 a_ss13c(i,k,j) =a_ss13c(i,k,j) +rr13c(i,k,j)*a_Tmpv6 a_rr13c(i,k,j) =a_rr13c(i,k,j) +ss13c(i,k,j)*a_Tmpv6 a_Tmpv4 =c1*a_Tmpv5 a_Tmpv3 =a_Tmpv4 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss23c(i,k,j) =a_ss23c(i,k,j) +2.0*ss23c(i,k,j)*a_Tmpv3 a_ss33(i,k,j) =a_ss33(i,k,j) +2.0*ss33(i,k,j)*a_Tmpv2 a_ss13c(i,k,j) =a_ss13c(i,k,j) +2.0*ss13c(i,k,j)*a_Tmpv2 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 a_ss33(i,k,j) =a_ss33(i,k,j) +2.0*sqrt(tke(i,k,j))*a_Tmpv1 a_Tmpv14 =a_m22(i,k,j) a_m22(i,k,j) =0.0 a_a =a_a +Tmpv409(i,k,j)*a_Tmpv14 a_Tmpv13 =a*a_Tmpv14 a_Tmpv1 =a_Tmpv13 a_Tmpv12 =a_Tmpv13 a_b =a_b +Tmpv408(i,k,j)*a_Tmpv12 a_Tmpv11 =b*a_Tmpv12 a_Tmpv5 =a_Tmpv11 a_Tmpv10 =a_Tmpv11 a_Tmpv9 =c2*a_Tmpv10 a_Tmpv8 =2.0*a_Tmpv9 a_Tmpv6 =a_Tmpv8 a_Tmpv7 =-a_Tmpv8 a_ss23c(i,k,j) =a_ss23c(i,k,j) +rr23c(i,k,j)*a_Tmpv7 a_rr23c(i,k,j) =a_rr23c(i,k,j) +ss23c(i,k,j)*a_Tmpv7 a_ss12c(i,k,j) =a_ss12c(i,k,j) +rr12c(i,k,j)*a_Tmpv6 a_rr12c(i,k,j) =a_rr12c(i,k,j) +ss12c(i,k,j)*a_Tmpv6 a_Tmpv4 =c1*a_Tmpv5 a_Tmpv3 =a_Tmpv4 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss23c(i,k,j) =a_ss23c(i,k,j) +2.0*ss23c(i,k,j)*a_Tmpv3 a_ss22(i,k,j) =a_ss22(i,k,j) +2.0*ss22(i,k,j)*a_Tmpv2 a_ss12c(i,k,j) =a_ss12c(i,k,j) +2.0*ss12c(i,k,j)*a_Tmpv2 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 a_ss22(i,k,j) =a_ss22(i,k,j) +2.0*sqrt(tke(i,k,j))*a_Tmpv1 a_Tmpv14 =a_m11(i,k,j) a_m11(i,k,j) =0.0 a_a =a_a +Tmpv407(i,k,j)*a_Tmpv14 a_Tmpv13 =a*a_Tmpv14 a_Tmpv1 =a_Tmpv13 a_Tmpv12 =a_Tmpv13 a_b =a_b +Tmpv406(i,k,j)*a_Tmpv12 a_Tmpv11 =b*a_Tmpv12 a_Tmpv5 =a_Tmpv11 a_Tmpv10 =a_Tmpv11 a_Tmpv9 =c2*a_Tmpv10 a_Tmpv8 =-2.0*a_Tmpv9 a_Tmpv6 =a_Tmpv8 a_Tmpv7 =a_Tmpv8 a_ss13c(i,k,j) =a_ss13c(i,k,j) +rr13c(i,k,j)*a_Tmpv7 a_rr13c(i,k,j) =a_rr13c(i,k,j) +ss13c(i,k,j)*a_Tmpv7 a_ss12c(i,k,j) =a_ss12c(i,k,j) +rr12c(i,k,j)*a_Tmpv6 a_rr12c(i,k,j) =a_rr12c(i,k,j) +ss12c(i,k,j)*a_Tmpv6 a_Tmpv4 =c1*a_Tmpv5 a_Tmpv3 =a_Tmpv4 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) -1.0/3.0*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss13c(i,k,j) =a_ss13c(i,k,j) +2.0*ss13c(i,k,j)*a_Tmpv3 a_ss11(i,k,j) =a_ss11(i,k,j) +2.0*ss11(i,k,j)*a_Tmpv2 a_ss12c(i,k,j) =a_ss12c(i,k,j) +2.0*ss12c(i,k,j)*a_Tmpv2 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 a_ss11(i,k,j) =a_ss11(i,k,j) +2.0*sqrt(tke(i,k,j))*a_Tmpv1 a_delta =a_delta +c3*a_b a_b =0.0 a_delta =a_delta -1.0*ce*a_a a_a =0.0 a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx* & dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta a_delta =0.0 ENDDO ENDDO ENDDO ENDIF !LPB[16] !LPB[15] DO j =j_end, j_start, -1 ! DO k =kts, ktf ! DO i =i_start, i_end ! Tmpv001 =ss12(i,k,j) +ss12(i,k,j+1) ! Tmpv002 =Tmpv001 +ss12(i+1,k,j) ! Tmpv003 =Tmpv002 +ss12(i+1,k,j+1) ! Tmpv004 =0.25*Tmpv003 ! ss12c(i,k,j) =Tmpv004 ! Tmpv001 =rr12(i,k,j) +rr12(i,k,j+1) ! Tmpv002 =Tmpv001 +rr12(i+1,k,j) ! Tmpv003 =Tmpv002 +rr12(i+1,k,j+1) ! Tmpv004 =0.25*Tmpv003 ! rr12c(i,k,j) =Tmpv004 ! Tmpv001 =ss13(i,k+1,j) +ss13(i,k,j) ! Tmpv002 =Tmpv001 +ss13(i+1,k+1,j) ! Tmpv003 =Tmpv002 +ss13(i+1,k,j) ! Tmpv004 =0.25*Tmpv003 ! ss13c(i,k,j) =Tmpv004 ! Tmpv001 =rr13(i,k+1,j) +rr13(i,k,j) ! Tmpv002 =Tmpv001 +rr13(i+1,k+1,j) ! Tmpv003 =Tmpv002 +rr13(i+1,k,j) ! Tmpv004 =0.25*Tmpv003 ! rr13c(i,k,j) =Tmpv004 ! Tmpv001 =ss23(i,k+1,j) +ss23(i,k,j) ! Tmpv002 =Tmpv001 +ss23(i,k+1,j+1) ! Tmpv003 =Tmpv002 +ss23(i,k,j+1) ! Tmpv004 =0.25*Tmpv003 ! ss23c(i,k,j) =Tmpv004 ! Tmpv001 =rr23(i,k+1,j) +rr23(i,k,j) ! Tmpv002 =Tmpv001 +rr23(i,k+1,j+1) ! Tmpv003 =Tmpv002 +rr23(i,k,j+1) ! Tmpv004 =0.25*Tmpv003 ! rr23c(i,k,j) =Tmpv004 ! ENDDO ! ENDDO DO k =ktf, kts, -1 DO i =i_end, i_start, -1 a_Tmpv4 =a_rr23c(i,k,j) a_rr23c(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_rr23(i,k,j+1) =a_rr23(i,k,j+1) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_rr23(i,k+1,j+1) =a_rr23(i,k+1,j+1) +a_Tmpv2 a_rr23(i,k+1,j) =a_rr23(i,k+1,j) +a_Tmpv1 a_rr23(i,k,j) =a_rr23(i,k,j) +a_Tmpv1 a_Tmpv4 =a_ss23c(i,k,j) a_ss23c(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss23(i,k,j+1) =a_ss23(i,k,j+1) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_ss23(i,k+1,j+1) =a_ss23(i,k+1,j+1) +a_Tmpv2 a_ss23(i,k+1,j) =a_ss23(i,k+1,j) +a_Tmpv1 a_ss23(i,k,j) =a_ss23(i,k,j) +a_Tmpv1 a_Tmpv4 =a_rr13c(i,k,j) a_rr13c(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_rr13(i+1,k,j) =a_rr13(i+1,k,j) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_rr13(i+1,k+1,j) =a_rr13(i+1,k+1,j) +a_Tmpv2 a_rr13(i,k+1,j) =a_rr13(i,k+1,j) +a_Tmpv1 a_rr13(i,k,j) =a_rr13(i,k,j) +a_Tmpv1 a_Tmpv4 =a_ss13c(i,k,j) a_ss13c(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss13(i+1,k,j) =a_ss13(i+1,k,j) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_ss13(i+1,k+1,j) =a_ss13(i+1,k+1,j) +a_Tmpv2 a_ss13(i,k+1,j) =a_ss13(i,k+1,j) +a_Tmpv1 a_ss13(i,k,j) =a_ss13(i,k,j) +a_Tmpv1 a_Tmpv4 =a_rr12c(i,k,j) a_rr12c(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_rr12(i+1,k,j+1) =a_rr12(i+1,k,j+1) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_rr12(i+1,k,j) =a_rr12(i+1,k,j) +a_Tmpv2 a_rr12(i,k,j) =a_rr12(i,k,j) +a_Tmpv1 a_rr12(i,k,j+1) =a_rr12(i,k,j+1) +a_Tmpv1 a_Tmpv4 =a_ss12c(i,k,j) a_ss12c(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss12(i+1,k,j+1) =a_ss12(i+1,k,j+1) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_ss12(i+1,k,j) =a_ss12(i+1,k,j) +a_Tmpv2 a_ss12(i,k,j) =a_ss12(i,k,j) +a_Tmpv1 a_ss12(i,k,j+1) =a_ss12(i,k,j+1) +a_Tmpv1 ENDDO ENDDO ENDDO !LPB[14] DO j =j_end+1, j_start, -1 ! DO i =i_start, i_end+1 ! ss13(i,kde,j) =0.0 ! ss23(i,kde,j) =0.0 ! rr13(i,kde,j) =0.0 ! rr23(i,kde,j) =0.0 ! ENDDO DO i =i_end+1, i_start, -1 a_rr23(i,kde,j) =0.0 a_rr13(i,kde,j) =0.0 a_ss23(i,kde,j) =0.0 a_ss13(i,kde,j) =0.0 ENDDO ENDDO !LPB[13] DO j =j_end+1, j_start, -1 ! DO k =kts, ktf ! DO i =i_start, i_end+1 ! ss11(i,k,j) =s11(i,k,j)/2.0 ! ss22(i,k,j) =s22(i,k,j)/2.0 ! ss33(i,k,j) =s33(i,k,j)/2.0 ! ss12(i,k,j) =s12(i,k,j)/2.0 ! ss13(i,k,j) =s13(i,k,j)/2.0 ! ss23(i,k,j) =s23(i,k,j)/2.0 ! rr12(i,k,j) =r12(i,k,j)/2.0 ! rr13(i,k,j) =r13(i,k,j)/2.0 ! rr23(i,k,j) =r23(i,k,j)/2.0 ! ENDDO ! ENDDO DO k =ktf, kts, -1 DO i =i_end+1, i_start, -1 a_r23(i,k,j) =a_r23(i,k,j) +1.0/2.0*a_rr23(i,k,j) a_rr23(i,k,j) =0.0 a_r13(i,k,j) =a_r13(i,k,j) +1.0/2.0*a_rr13(i,k,j) a_rr13(i,k,j) =0.0 a_r12(i,k,j) =a_r12(i,k,j) +1.0/2.0*a_rr12(i,k,j) a_rr12(i,k,j) =0.0 a_s23(i,k,j) =a_s23(i,k,j) +1.0/2.0*a_ss23(i,k,j) a_ss23(i,k,j) =0.0 a_s13(i,k,j) =a_s13(i,k,j) +1.0/2.0*a_ss13(i,k,j) a_ss13(i,k,j) =0.0 a_s12(i,k,j) =a_s12(i,k,j) +1.0/2.0*a_ss12(i,k,j) a_ss12(i,k,j) =0.0 a_s33(i,k,j) =a_s33(i,k,j) +1.0/2.0*a_ss33(i,k,j) a_ss33(i,k,j) =0.0 a_s22(i,k,j) =a_s22(i,k,j) +1.0/2.0*a_ss22(i,k,j) a_ss22(i,k,j) =0.0 a_s11(i,k,j) =a_s11(i,k,j) +1.0/2.0*a_ss11(i,k,j) a_ss11(i,k,j) =0.0 ENDDO ENDDO ENDDO !LPB[12] ! is_ext =1 ! js_ext =1 ! i_start =i_start-is_ext ! j_start =j_start-js_ext !LPB[11] ! IF( config_flags%periodic_x ) THEN ! i_end =ite ! END IF ! IF( config_flags%periodic_x ) THEN ! END IF !LPB[10] !LPB[9] ! IF( config_flags%periodic_x ) THEN ! i_start =its ! END IF ! IF( config_flags%periodic_x ) THEN ! END IF !LPB[8] !LPB[7] ! IF( config_flags%open_ye .OR. config_flags%specified .OR. config_flags%nested) THEN ! j_end =min(jde-1, jte) ! END IF ! IF( config_flags%open_ye .OR. config_flags%specified .OR. & ! config_flags%nested) THEN ! END IF !LPB[6] !LPB[5] ! IF( config_flags%open_ys .OR. config_flags%specified .OR. config_flags%nested) THEN ! j_start =max(jds+1, jts) ! END IF ! IF( config_flags%open_ys .OR. config_flags%specified .OR. & ! config_flags%nested) THEN ! END IF !LPB[4] !LPB[3] ! IF( config_flags%open_xe .OR. config_flags%specified .OR. config_flags%nested) THEN ! i_end =min(ide-1, ite) ! END IF ! IF( config_flags%open_xe .OR. config_flags%specified .OR. & ! config_flags%nested) THEN ! END IF !LPB[2] !LPB[1] ! IF( config_flags%open_xs .OR. config_flags%specified .OR. config_flags%nested) THEN ! i_start =max(ids+1, its) ! END IF ! IF( config_flags%open_xs .OR. config_flags%specified .OR. & ! config_flags%nested) THEN ! END IF !LPB[0] ! ktf =min(kte, kde-1) ! i_start =its ! i_end =ite ! j_start =jts ! j_end =jte Return END SUBROUTINE a_calc_mii SUBROUTINE a_calc_m12(m12,a_m12,s11,a_s11,s22,a_s22,s12,a_s12,s13,a_s13, & s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23,smnsmn,a_smnsmn,tke,a_tke,rdzw, & a_rdzw,dx,dy,config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe, & jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte) !PART I: DECLARATION OF VARIABLES IMPLICIT NONE INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: m12,a_m12 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s11,a_s11,s22,a_s22,s12,a_s12,s13, & a_s13,s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23,smnsmn,a_smnsmn,tke, & a_tke,rdzw,a_rdzw REAL :: dx,dy TYPE(grid_config_rec_type) :: config_flags INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, & its,ite,jts,jte,kts,kte REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss11,a_ss11,ss22,a_ss22,ss12, & a_ss12,ss13,a_ss13,ss23,a_ss23,rr12,a_rr12,rr13,a_rr13,rr23,a_rr23 REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: tked,a_tked,ss11d,a_ss11d, & ss22d,a_ss22d,ss13d,a_ss13d,ss23d,a_ss23d,rr13d,a_rr13d,rr23d,a_rr23d, & smnsmnd,a_smnsmnd REAL :: delta,a_delta,a,a_a,b,a_b INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf,je_ext,ie_ext REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, & a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9, & Tmpv009,a_Tmpv10,Tmpv010,a_Tmpv11,Tmpv011,a_Tmpv12,Tmpv012,a_Tmpv13,Tmpv013, & a_Tmpv14,Tmpv014,a_Tmpv15,Tmpv015,a_Tmpv16,Tmpv016,a_Tmpv17,Tmpv017, & a_Tmpv18,Tmpv018,a_Tmpv19,Tmpv019 REAL,DIMENSION(its:ite+1,kts:min(kte,kde-1),max(jds+1,jts):jte+1) :: Tmpv400 REAL,DIMENSION(its:ite+1,kts:min(kte,kde-1),max(jds+1,jts):jte+1) :: Tmpv401 REAL,DIMENSION(its:ite+1,kts:min(kte,kde-1),max(jds+1,jts):jte+1) :: Tmpv402 REAL,DIMENSION(its:ite+1,kts:min(kte,kde-1),max(jds+1,jts):jte+1) :: Tmpv403 REAL,DIMENSION(its:ite+1,kts:min(kte,kde-1),max(jds+1,jts):jte+1) :: Tmpv404 REAL,DIMENSION(its:ite+1,kts:min(kte,kde-1),max(jds+1,jts):jte+1) :: Tmpv405 REAL :: g_Sqrt !PART II: CALCULATIONS OF B. S. TRAJECTORY !LPB[0] ktf = MIN( kte, kde-1 ) i_start = its i_end = ite j_start = jts j_end = jte !LPB[1] IF ( config_flags%open_xs .OR. config_flags%specified .OR. & config_flags%nested ) i_start = MAX( ids+1, its ) !LPB[2] !LPB[3] IF ( config_flags%open_xe .OR. config_flags%specified .OR. & config_flags%nested ) i_end = MIN( ide-1, ite ) !LPB[4] !LPB[5] IF ( config_flags%open_ys .OR. config_flags%specified .OR. & config_flags%nested ) j_start = MAX( jds+1, jts ) !LPB[6] !LPB[7] IF ( config_flags%open_ye .OR. config_flags%specified .OR. & config_flags%nested ) j_end = MIN( jde-1, jte ) !LPB[8] !LPB[9] IF ( config_flags%periodic_x ) i_start = its !LPB[10] !LPB[11] IF ( config_flags%periodic_x ) i_end = ite !LPB[12] je_ext = 1 ie_ext = 1 i_end = i_end + ie_ext j_end = j_end + je_ext !LPB[13] DO j=j_start-1,j_end DO k=kts,ktf DO i=i_start-1,i_end ss11(i,k,j)=s11(i,k,j)/2.0 ss22(i,k,j)=s22(i,k,j)/2.0 ss12(i,k,j)=s12(i,k,j)/2.0 ss13(i,k,j)=s13(i,k,j)/2.0 ss23(i,k,j)=s23(i,k,j)/2.0 rr12(i,k,j)=r12(i,k,j)/2.0 rr13(i,k,j)=r13(i,k,j)/2.0 rr23(i,k,j)=r23(i,k,j)/2.0 END DO END DO END DO !LPB[14] DO j=j_start-1,j_end DO i=i_start-1,i_end ss13(i,kde,j) = 0.0 ss23(i,kde,j) = 0.0 rr13(i,kde,j) = 0.0 rr23(i,kde,j) = 0.0 END DO END DO !LPB[15] DO j = j_start, j_end DO k = kts, ktf DO i = i_start, i_end tked(i,k,j) = 0.25*( tke(i-1,k ,j ) + tke(i ,k ,j ) + & tke(i-1,k ,j-1) + tke(i ,k ,j-1) ) smnsmnd(i,k,j) = 0.25*( smnsmn(i-1,k ,j ) + smnsmn(i ,k ,j ) + & smnsmn(i-1,k ,j-1) + smnsmn(i ,k ,j-1) ) ss11d(i,k,j) = 0.25*( ss11(i-1,k ,j ) + ss11(i ,k ,j ) + & ss11(i-1,k ,j-1) + ss11(i ,k ,j-1) ) ss22d(i,k,j) = 0.25*( ss22(i-1,k ,j ) + ss22(i ,k ,j ) + & ss22(i-1,k ,j-1) + ss22(i ,k ,j-1) ) ss13d(i,k,j) = 0.25*( ss13(i ,k+1,j ) + ss13(i ,k+1,j-1) + & ss13(i ,k ,j ) + ss13(i ,k ,j-1) ) rr13d(i,k,j) = 0.25*( rr13(i ,k+1,j ) + rr13(i ,k+1,j-1) + & rr13(i ,k ,j ) + rr13(i ,k ,j-1) ) ss23d(i,k,j) = 0.25*( ss23(i ,k+1,j ) + ss23(i-1,k+1,j ) + & ss23(i ,k ,j ) + ss23(i-1,k ,j ) ) rr23d(i,k,j) = 0.25*( rr23(i ,k+1,j ) + rr23(i-1,k+1,j ) + & rr23(i ,k ,j ) + rr23(i-1,k ,j ) ) END DO END DO END DO !LPB[16] !!LPB[17] ! IF ( config_flags%sfs_opt .EQ. 1 ) THEN ! DO j=j_start,j_end ! DO k=kts,ktf ! DO i=i_start,i_end ! delta = ( dx * dy / rdzw(i,k,j) )**0.33333333 ! a = -1.0*( cs*delta )**2 ! m12(i,k,j) = a*( 2.0*sqrt( 2.0*smnsmnd(i,k,j) )*ss12(i,k,j) & ! + c1*( ss11d(i,k,j)*ss12(i,k,j) & ! + ss22d(i,k,j)*ss12(i,k,j) & ! + ss13d(i,k,j)*ss23d(i,k,j) & ! ) & ! + c2*( ss11d(i,k,j)*rr12(i,k,j) & ! - ss13d(i,k,j)*rr23d(i,k,j) & ! - ss22d(i,k,j)*rr12(i,k,j) & ! - ss23d(i,k,j)*rr13d(i,k,j) & ! ) & ! ) ! ENDDO ! ENDDO ! ENDDO ! ELSE ! DO j=j_start,j_end ! DO k=kts,ktf ! DO i=i_start,i_end ! delta = ( dx * dy / rdzw(i,k,j) )**0.33333333 ! a = -1.0*ce*delta ! b = c3*delta ! m12(i,k,j) = a*( 2.0*sqrt( tked(i,k,j) )*s12(i,k,j) & ! + b*( & ! c1*( ss11d(i,k,j)*ss12(i,k,j) & ! + ss22d(i,k,j)*ss12(i,k,j) & ! + ss13d(i,k,j)*ss23d(i,k,j) & ! ) & ! + c2*( ss11d(i,k,j)*rr12(i,k,j) & ! - ss13d(i,k,j)*rr23d(i,k,j) & ! - ss22d(i,k,j)*rr12(i,k,j) & ! - ss23d(i,k,j)*rr13d(i,k,j) & ! ) & ! ) & ! ) ! ENDDO ! ENDDO ! ENDDO ! ENDIF !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss11(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss22(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_tked(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss11d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss22d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss13d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss23d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr13d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr23d(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_smnsmnd(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do a_delta =0.0 a_a =0.0 a_b =0.0 !PART IV: REVERSE/BACKWARD ACCUMULATIONS !LPB[17] IF( config_flags%sfs_opt .EQ. 1 ) THEN DO j =j_start, j_end DO k =kts, ktf DO i =i_start, i_end delta =(dx*dy/rdzw(i,k,j))**0.33333333 a =-1.0*(cs*delta)**2 Tmpv400(i,k,j) =a Tmpv001 =2.0*sqrt(2.0*smnsmnd(i,k,j))*ss12(i,k,j) Tmpv002 =ss11d(i,k,j)*ss12(i,k,j) Tmpv003 =ss22d(i,k,j)*ss12(i,k,j) Tmpv004 =Tmpv002 +Tmpv003 Tmpv005 =ss13d(i,k,j)*ss23d(i,k,j) Tmpv006 =Tmpv004 +Tmpv005 Tmpv007 =c1*Tmpv006 Tmpv008 =Tmpv001 +Tmpv007 Tmpv009 =ss11d(i,k,j)*rr12(i,k,j) Tmpv010 =ss13d(i,k,j)*rr23d(i,k,j) Tmpv011 =Tmpv009 -Tmpv010 Tmpv012 =ss22d(i,k,j)*rr12(i,k,j) Tmpv013 =Tmpv011 -Tmpv012 Tmpv014 =ss23d(i,k,j)*rr13d(i,k,j) Tmpv015 =Tmpv013 -Tmpv014 Tmpv016 =c2*Tmpv015 Tmpv017 =Tmpv008 +Tmpv016 Tmpv401(i,k,j) =Tmpv017 Tmpv018 =a*Tmpv401(i,k,j) m12(i,k,j) =Tmpv018 ENDDO ENDDO ENDDO ELSE DO j =j_start, j_end DO k =kts, ktf DO i =i_start, i_end delta =(dx*dy/rdzw(i,k,j))**0.33333333 a =-1.0*ce*delta Tmpv402(i,k,j) =a b =c3*delta Tmpv403(i,k,j) =b Tmpv001 =2.0*sqrt(tked(i,k,j))*s12(i,k,j) Tmpv002 =ss11d(i,k,j)*ss12(i,k,j) Tmpv003 =ss22d(i,k,j)*ss12(i,k,j) Tmpv004 =Tmpv002 +Tmpv003 Tmpv005 =ss13d(i,k,j)*ss23d(i,k,j) Tmpv006 =Tmpv004 +Tmpv005 Tmpv007 =c1*Tmpv006 Tmpv008 =ss11d(i,k,j)*rr12(i,k,j) Tmpv009 =ss13d(i,k,j)*rr23d(i,k,j) Tmpv010 =Tmpv008 -Tmpv009 Tmpv011 =ss22d(i,k,j)*rr12(i,k,j) Tmpv012 =Tmpv010 -Tmpv011 Tmpv013 =ss23d(i,k,j)*rr13d(i,k,j) Tmpv014 =Tmpv012 -Tmpv013 Tmpv015 =c2*Tmpv014 Tmpv016 =Tmpv007 +Tmpv015 Tmpv404(i,k,j) =Tmpv016 Tmpv017 =b*Tmpv404(i,k,j) Tmpv018 =Tmpv001 +Tmpv017 Tmpv405(i,k,j) =Tmpv018 Tmpv019 =a*Tmpv405(i,k,j) m12(i,k,j) =Tmpv019 ENDDO ENDDO ENDDO ENDIF IF( config_flags%sfs_opt .EQ. 1 ) THEN DO j =j_end, j_start, -1 DO k =ktf, kts, -1 DO i =i_end, i_start, -1 a =Tmpv400(i,k,j) a_Tmpv18 =a_m12(i,k,j) a_m12(i,k,j) =0.0 a_a =a_a +Tmpv401(i,k,j)*a_Tmpv18 a_Tmpv17 =a*a_Tmpv18 a_Tmpv8 =a_Tmpv17 a_Tmpv16 =a_Tmpv17 a_Tmpv15 =c2*a_Tmpv16 a_Tmpv13 =a_Tmpv15 a_Tmpv14 =-a_Tmpv15 a_ss23d(i,k,j) =a_ss23d(i,k,j) +rr13d(i,k,j)*a_Tmpv14 a_rr13d(i,k,j) =a_rr13d(i,k,j) +ss23d(i,k,j)*a_Tmpv14 a_Tmpv11 =a_Tmpv13 a_Tmpv12 =-a_Tmpv13 a_ss22d(i,k,j) =a_ss22d(i,k,j) +rr12(i,k,j)*a_Tmpv12 a_rr12(i,k,j) =a_rr12(i,k,j) +ss22d(i,k,j)*a_Tmpv12 a_Tmpv9 =a_Tmpv11 a_Tmpv10 =-a_Tmpv11 a_ss13d(i,k,j) =a_ss13d(i,k,j) +rr23d(i,k,j)*a_Tmpv10 a_rr23d(i,k,j) =a_rr23d(i,k,j) +ss13d(i,k,j)*a_Tmpv10 a_ss11d(i,k,j) =a_ss11d(i,k,j) +rr12(i,k,j)*a_Tmpv9 a_rr12(i,k,j) =a_rr12(i,k,j) +ss11d(i,k,j)*a_Tmpv9 a_Tmpv1 =a_Tmpv8 a_Tmpv7 =a_Tmpv8 a_Tmpv6 =c1*a_Tmpv7 a_Tmpv4 =a_Tmpv6 a_Tmpv5 =a_Tmpv6 a_ss13d(i,k,j) =a_ss13d(i,k,j) +ss23d(i,k,j)*a_Tmpv5 a_ss23d(i,k,j) =a_ss23d(i,k,j) +ss13d(i,k,j)*a_Tmpv5 a_Tmpv2 =a_Tmpv4 a_Tmpv3 =a_Tmpv4 a_ss22d(i,k,j) =a_ss22d(i,k,j) +ss12(i,k,j)*a_Tmpv3 a_ss12(i,k,j) =a_ss12(i,k,j) +ss22d(i,k,j)*a_Tmpv3 a_ss11d(i,k,j) =a_ss11d(i,k,j) +ss12(i,k,j)*a_Tmpv2 a_ss12(i,k,j) =a_ss12(i,k,j) +ss11d(i,k,j)*a_Tmpv2 a_smnsmnd(i,k,j) =a_smnsmnd(i,k,j) +2.0*g_Sqrt(2.0, 2.0*smnsmnd(i,k,j)) & *ss12(i,k,j)*a_Tmpv1 a_ss12(i,k,j) =a_ss12(i,k,j) +2.0*sqrt(2.0*smnsmnd(i,k,j))*a_Tmpv1 Tmpv001 =2.0*sqrt(2.0*smnsmnd(i,k,j))*ss12(i,k,j) ! a =Tmpv400(i,k,j) !ADDED BY WALLS delta =(dx*dy/rdzw(i,k,j))**0.33333333 a_delta =a_delta -1.0*2.0*(cs*delta)*cs*a_a a_a =0.0 a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx* & dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta a_delta =0.0 ENDDO ENDDO ENDDO ELSE DO j =j_end, j_start, -1 DO k =ktf, kts, -1 DO i =i_end, i_start, -1 a =Tmpv402(i,k,j) b =Tmpv403(i,k,j) a_Tmpv19 =a_m12(i,k,j) a_m12(i,k,j) =0.0 a_a =a_a +Tmpv405(i,k,j)*a_Tmpv19 a_Tmpv18 =a*a_Tmpv19 a_Tmpv1 =a_Tmpv18 a_Tmpv17 =a_Tmpv18 a_b =a_b +Tmpv404(i,k,j)*a_Tmpv17 a_Tmpv16 =b*a_Tmpv17 a_Tmpv7 =a_Tmpv16 a_Tmpv15 =a_Tmpv16 a_Tmpv14 =c2*a_Tmpv15 a_Tmpv12 =a_Tmpv14 a_Tmpv13 =-a_Tmpv14 a_ss23d(i,k,j) =a_ss23d(i,k,j) +rr13d(i,k,j)*a_Tmpv13 a_rr13d(i,k,j) =a_rr13d(i,k,j) +ss23d(i,k,j)*a_Tmpv13 a_Tmpv10 =a_Tmpv12 a_Tmpv11 =-a_Tmpv12 a_ss22d(i,k,j) =a_ss22d(i,k,j) +rr12(i,k,j)*a_Tmpv11 a_rr12(i,k,j) =a_rr12(i,k,j) +ss22d(i,k,j)*a_Tmpv11 a_Tmpv8 =a_Tmpv10 a_Tmpv9 =-a_Tmpv10 a_ss13d(i,k,j) =a_ss13d(i,k,j) +rr23d(i,k,j)*a_Tmpv9 a_rr23d(i,k,j) =a_rr23d(i,k,j) +ss13d(i,k,j)*a_Tmpv9 a_ss11d(i,k,j) =a_ss11d(i,k,j) +rr12(i,k,j)*a_Tmpv8 a_rr12(i,k,j) =a_rr12(i,k,j) +ss11d(i,k,j)*a_Tmpv8 a_Tmpv6 =c1*a_Tmpv7 a_Tmpv4 =a_Tmpv6 a_Tmpv5 =a_Tmpv6 a_ss13d(i,k,j) =a_ss13d(i,k,j) +ss23d(i,k,j)*a_Tmpv5 a_ss23d(i,k,j) =a_ss23d(i,k,j) +ss13d(i,k,j)*a_Tmpv5 a_Tmpv2 =a_Tmpv4 a_Tmpv3 =a_Tmpv4 a_ss22d(i,k,j) =a_ss22d(i,k,j) +ss12(i,k,j)*a_Tmpv3 a_ss12(i,k,j) =a_ss12(i,k,j) +ss22d(i,k,j)*a_Tmpv3 a_ss11d(i,k,j) =a_ss11d(i,k,j) +ss12(i,k,j)*a_Tmpv2 a_ss12(i,k,j) =a_ss12(i,k,j) +ss11d(i,k,j)*a_Tmpv2 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 a_s12(i,k,j) =a_s12(i,k,j) +2.0*sqrt(tked(i,k,j))*a_Tmpv1 ! b =Tmpv403(i,k,j) a_delta =a_delta +c3*a_b a_b =0.0 ! a =Tmpv402(i,k,j) a_delta =a_delta -1.0*ce*a_a a_a =0.0 a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx* & dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta a_delta =0.0 ENDDO ENDDO ENDDO ENDIF !LPB[16] !LPB[15] DO j =j_end, j_start, -1 ! DO k =kts, ktf ! DO i =i_start, i_end ! Tmpv001 =tke(i-1,k,j) +tke(i,k,j) ! Tmpv002 =Tmpv001 +tke(i-1,k,j-1) ! Tmpv003 =Tmpv002 +tke(i,k,j-1) ! Tmpv004 =0.25*Tmpv003 ! tked(i,k,j) =Tmpv004 ! Tmpv001 =smnsmn(i-1,k,j) +smnsmn(i,k,j) ! Tmpv002 =Tmpv001 +smnsmn(i-1,k,j-1) ! Tmpv003 =Tmpv002 +smnsmn(i,k,j-1) ! Tmpv004 =0.25*Tmpv003 ! smnsmnd(i,k,j) =Tmpv004 ! Tmpv001 =ss11(i-1,k,j) +ss11(i,k,j) ! Tmpv002 =Tmpv001 +ss11(i-1,k,j-1) ! Tmpv003 =Tmpv002 +ss11(i,k,j-1) ! Tmpv004 =0.25*Tmpv003 ! ss11d(i,k,j) =Tmpv004 ! Tmpv001 =ss22(i-1,k,j) +ss22(i,k,j) ! Tmpv002 =Tmpv001 +ss22(i-1,k,j-1) ! Tmpv003 =Tmpv002 +ss22(i,k,j-1) ! Tmpv004 =0.25*Tmpv003 ! ss22d(i,k,j) =Tmpv004 ! Tmpv001 =ss13(i,k+1,j) +ss13(i,k+1,j-1) ! Tmpv002 =Tmpv001 +ss13(i,k,j) ! Tmpv003 =Tmpv002 +ss13(i,k,j-1) ! Tmpv004 =0.25*Tmpv003 ! ss13d(i,k,j) =Tmpv004 ! Tmpv001 =rr13(i,k+1,j) +rr13(i,k+1,j-1) ! Tmpv002 =Tmpv001 +rr13(i,k,j) ! Tmpv003 =Tmpv002 +rr13(i,k,j-1) ! Tmpv004 =0.25*Tmpv003 ! rr13d(i,k,j) =Tmpv004 ! Tmpv001 =ss23(i,k+1,j) +ss23(i-1,k+1,j) ! Tmpv002 =Tmpv001 +ss23(i,k,j) ! Tmpv003 =Tmpv002 +ss23(i-1,k,j) ! Tmpv004 =0.25*Tmpv003 ! ss23d(i,k,j) =Tmpv004 ! Tmpv001 =rr23(i,k+1,j) +rr23(i-1,k+1,j) ! Tmpv002 =Tmpv001 +rr23(i,k,j) ! Tmpv003 =Tmpv002 +rr23(i-1,k,j) ! Tmpv004 =0.25*Tmpv003 ! rr23d(i,k,j) =Tmpv004 ! ENDDO ! ENDDO DO k =ktf, kts, -1 DO i =i_end, i_start, -1 a_Tmpv4 =a_rr23d(i,k,j) a_rr23d(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_rr23(i-1,k,j) =a_rr23(i-1,k,j) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_rr23(i,k,j) =a_rr23(i,k,j) +a_Tmpv2 a_rr23(i,k+1,j) =a_rr23(i,k+1,j) +a_Tmpv1 a_rr23(i-1,k+1,j) =a_rr23(i-1,k+1,j) +a_Tmpv1 a_Tmpv4 =a_ss23d(i,k,j) a_ss23d(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss23(i-1,k,j) =a_ss23(i-1,k,j) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_ss23(i,k,j) =a_ss23(i,k,j) +a_Tmpv2 a_ss23(i,k+1,j) =a_ss23(i,k+1,j) +a_Tmpv1 a_ss23(i-1,k+1,j) =a_ss23(i-1,k+1,j) +a_Tmpv1 a_Tmpv4 =a_rr13d(i,k,j) a_rr13d(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_rr13(i,k,j-1) =a_rr13(i,k,j-1) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_rr13(i,k,j) =a_rr13(i,k,j) +a_Tmpv2 a_rr13(i,k+1,j) =a_rr13(i,k+1,j) +a_Tmpv1 a_rr13(i,k+1,j-1) =a_rr13(i,k+1,j-1) +a_Tmpv1 a_Tmpv4 =a_ss13d(i,k,j) a_ss13d(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss13(i,k,j-1) =a_ss13(i,k,j-1) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_ss13(i,k,j) =a_ss13(i,k,j) +a_Tmpv2 a_ss13(i,k+1,j) =a_ss13(i,k+1,j) +a_Tmpv1 a_ss13(i,k+1,j-1) =a_ss13(i,k+1,j-1) +a_Tmpv1 a_Tmpv4 =a_ss22d(i,k,j) a_ss22d(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss22(i,k,j-1) =a_ss22(i,k,j-1) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_ss22(i-1,k,j-1) =a_ss22(i-1,k,j-1) +a_Tmpv2 a_ss22(i-1,k,j) =a_ss22(i-1,k,j) +a_Tmpv1 a_ss22(i,k,j) =a_ss22(i,k,j) +a_Tmpv1 a_Tmpv4 =a_ss11d(i,k,j) a_ss11d(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss11(i,k,j-1) =a_ss11(i,k,j-1) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_ss11(i-1,k,j-1) =a_ss11(i-1,k,j-1) +a_Tmpv2 a_ss11(i-1,k,j) =a_ss11(i-1,k,j) +a_Tmpv1 a_ss11(i,k,j) =a_ss11(i,k,j) +a_Tmpv1 a_Tmpv4 =a_smnsmnd(i,k,j) a_smnsmnd(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_smnsmn(i,k,j-1) =a_smnsmn(i,k,j-1) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_smnsmn(i-1,k,j-1) =a_smnsmn(i-1,k,j-1) +a_Tmpv2 a_smnsmn(i-1,k,j) =a_smnsmn(i-1,k,j) +a_Tmpv1 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +a_Tmpv1 a_Tmpv4 =a_tked(i,k,j) a_tked(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_tke(i,k,j-1) =a_tke(i,k,j-1) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_tke(i-1,k,j-1) =a_tke(i-1,k,j-1) +a_Tmpv2 a_tke(i-1,k,j) =a_tke(i-1,k,j) +a_Tmpv1 a_tke(i,k,j) =a_tke(i,k,j) +a_Tmpv1 ENDDO ENDDO ENDDO !LPB[14] DO j =j_end, j_start-1, -1 ! DO i =i_start-1, i_end ! ss13(i,kde,j) =0.0 ! ss23(i,kde,j) =0.0 ! rr13(i,kde,j) =0.0 ! rr23(i,kde,j) =0.0 ! ENDDO DO i =i_end, i_start-1, -1 a_rr23(i,kde,j) =0.0 a_rr13(i,kde,j) =0.0 a_ss23(i,kde,j) =0.0 a_ss13(i,kde,j) =0.0 ENDDO ENDDO !LPB[13] DO j =j_end, j_start-1, -1 ! DO k =kts, ktf ! DO i =i_start-1, i_end ! ss11(i,k,j) =s11(i,k,j)/2.0 ! ss22(i,k,j) =s22(i,k,j)/2.0 ! ss12(i,k,j) =s12(i,k,j)/2.0 ! ss13(i,k,j) =s13(i,k,j)/2.0 ! ss23(i,k,j) =s23(i,k,j)/2.0 ! rr12(i,k,j) =r12(i,k,j)/2.0 ! rr13(i,k,j) =r13(i,k,j)/2.0 ! rr23(i,k,j) =r23(i,k,j)/2.0 ! ENDDO ! ENDDO DO k =ktf, kts, -1 DO i =i_end, i_start-1, -1 a_r23(i,k,j) =a_r23(i,k,j) +1.0/2.0*a_rr23(i,k,j) a_rr23(i,k,j) =0.0 a_r13(i,k,j) =a_r13(i,k,j) +1.0/2.0*a_rr13(i,k,j) a_rr13(i,k,j) =0.0 a_r12(i,k,j) =a_r12(i,k,j) +1.0/2.0*a_rr12(i,k,j) a_rr12(i,k,j) =0.0 a_s23(i,k,j) =a_s23(i,k,j) +1.0/2.0*a_ss23(i,k,j) a_ss23(i,k,j) =0.0 a_s13(i,k,j) =a_s13(i,k,j) +1.0/2.0*a_ss13(i,k,j) a_ss13(i,k,j) =0.0 a_s12(i,k,j) =a_s12(i,k,j) +1.0/2.0*a_ss12(i,k,j) a_ss12(i,k,j) =0.0 a_s22(i,k,j) =a_s22(i,k,j) +1.0/2.0*a_ss22(i,k,j) a_ss22(i,k,j) =0.0 a_s11(i,k,j) =a_s11(i,k,j) +1.0/2.0*a_ss11(i,k,j) a_ss11(i,k,j) =0.0 ENDDO ENDDO ENDDO !LPB[12] ! je_ext =1 ! ie_ext =1 ! i_end =i_end+ie_ext ! j_end =j_end+je_ext !LPB[11] ! IF( config_flags%periodic_x ) THEN ! i_end =ite ! END IF ! IF( config_flags%periodic_x ) THEN ! END IF !LPB[10] !LPB[9] ! IF( config_flags%periodic_x ) THEN ! i_start =its ! END IF ! IF( config_flags%periodic_x ) THEN ! END IF !LPB[8] !LPB[7] ! IF( config_flags%open_ye .OR. config_flags%specified .OR. config_flags%nested ) THEN ! j_end =min(jde-1, jte) ! END IF ! IF( config_flags%open_ye .OR. config_flags%specified .OR. & ! config_flags%nested ) THEN ! END IF !LPB[6] !LPB[5] ! IF( config_flags%open_ys .OR. config_flags%specified .OR. config_flags%nested ) THEN ! j_start =max(jds+1, jts) ! END IF ! IF( config_flags%open_ys .OR. config_flags%specified .OR. & ! config_flags%nested ) THEN ! END IF !LPB[4] !LPB[3] ! IF( config_flags%open_xe .OR. config_flags%specified .OR. config_flags%nested ) THEN ! i_end =min(ide-1, ite) ! END IF ! IF( config_flags%open_xe .OR. config_flags%specified .OR. & ! config_flags%nested ) THEN ! END IF !LPB[2] !LPB[1] ! IF( config_flags%open_xs .OR. config_flags%specified .OR. config_flags%nested ) THEN ! i_start =max(ids+1, its) ! END IF ! IF( config_flags%open_xs .OR. config_flags%specified .OR. & ! config_flags%nested ) THEN ! END IF !LPB[0] ! ktf =min(kte, kde-1) ! i_start =its ! i_end =ite ! j_start =jts ! j_end =jte Return END SUBROUTINE a_calc_m12 SUBROUTINE a_calc_m13(m13,a_m13,s11,a_s11,s33,a_s33,s12,a_s12,s13,a_s13, & s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23,smnsmn,a_smnsmn,tke,a_tke,rdzw, & a_rdzw,dx,dy,fnm,fnp,config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, & ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte) !PART I: DECLARATION OF VARIABLES IMPLICIT NONE INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: m13,a_m13 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s11,a_s11,s33,a_s33,s12,a_s12,s13, & a_s13,s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23,smnsmn,a_smnsmn,tke, & a_tke,rdzw,a_rdzw REAL :: dx,dy REAL,DIMENSION(kms:kme) :: fnm,fnp TYPE(grid_config_rec_type) :: config_flags INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, & its,ite,jts,jte,kts,kte REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss11,a_ss11,ss33,a_ss33,ss12, & a_ss12,ss13,a_ss13,ss23,a_ss23,rr12,a_rr12,rr13,a_rr13,rr23,a_rr23 REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: tkee,a_tkee,ss11e,a_ss11e, & ss33e,a_ss33e,ss12e,a_ss12e,ss23e,a_ss23e,rr12e,a_rr12e,rr23e,a_rr23e, & smnsmne,a_smnsmne REAL :: delta,a_delta,a,a_a,b,a_b INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf,ie_ext REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, & a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9, & Tmpv009,a_Tmpv10,Tmpv010,a_Tmpv11,Tmpv011,a_Tmpv12,Tmpv012,a_Tmpv13,Tmpv013, & a_Tmpv14,Tmpv014,a_Tmpv15,Tmpv015,a_Tmpv16,Tmpv016,a_Tmpv17,Tmpv017, & a_Tmpv18,Tmpv018,a_Tmpv19,Tmpv019 REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) & :: Tmpv400 REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) & :: Tmpv401 REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) & :: Tmpv402 REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) & :: Tmpv403 REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) & :: Tmpv404 REAL,DIMENSION(its:ite+1,kts+1:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) & :: Tmpv405 REAL :: g_Sqrt !PART II: CALCULATIONS OF B. S. TRAJECTORY !LPB[0] ktf = MIN( kte, kde-1 ) i_start = its i_end = ite j_start = jts j_end = MIN( jte, jde-1 ) !LPB[1] IF ( config_flags%open_xs .OR. config_flags%specified .OR. & config_flags%nested) i_start = MAX( ids+1, its ) !LPB[2] !LPB[3] IF ( config_flags%open_xe .OR. config_flags%specified .OR. & config_flags%nested) i_end = MIN( ide-1, ite ) !LPB[4] !LPB[5] IF ( config_flags%open_ys .OR. config_flags%specified .OR. & config_flags%nested) j_start = MAX( jds+1, jts ) !LPB[6] !LPB[7] IF ( config_flags%open_ye .OR. config_flags%specified .OR. & config_flags%nested) j_end = MIN( jde-2, jte ) !LPB[8] !LPB[9] IF ( config_flags%periodic_x ) i_start = its !LPB[10] !LPB[11] IF ( config_flags%periodic_x ) i_end = ite !LPB[12] ie_ext = 1 i_end = i_end + ie_ext !LPB[13] DO j=j_start,j_end+1 DO k=kts,ktf DO i=i_start-1,i_end ss11(i,k,j)=s11(i,k,j)/2.0 ss33(i,k,j)=s33(i,k,j)/2.0 ss12(i,k,j)=s12(i,k,j)/2.0 ss13(i,k,j)=s13(i,k,j)/2.0 ss23(i,k,j)=s23(i,k,j)/2.0 rr12(i,k,j)=r12(i,k,j)/2.0 rr13(i,k,j)=r13(i,k,j)/2.0 rr23(i,k,j)=r23(i,k,j)/2.0 END DO END DO END DO !LPB[14] DO j = j_start, j_end DO k = kts+1, ktf DO i = i_start, i_end tkee(i,k,j) = 0.5*( fnm(k)*( tke(i,k ,j) + tke(i-1,k ,j) ) + & fnp(k)*( tke(i,k-1,j) + tke(i-1,k-1,j) ) ) smnsmne(i,k,j) = 0.5*( fnm(k)*( smnsmn(i,k ,j) + smnsmn(i-1,k ,j) ) + & fnp(k)*( smnsmn(i,k-1,j) + smnsmn(i-1,k-1,j) ) ) ss11e(i,k,j) = 0.5*( fnm(k)*( ss11(i ,k ,j ) + ss11(i-1,k ,j ) ) + & fnp(k)*( ss11(i ,k-1,j ) + ss11(i-1,k-1,j ) ) ) ss33e(i,k,j) = 0.5*( fnm(k)*( ss33(i ,k ,j ) + ss33(i-1,k ,j ) ) + & fnp(k)*( ss33(i ,k-1,j ) + ss33(i-1,k-1,j ) ) ) ss12e(i,k,j) = 0.5*( fnm(k)*( ss12(i ,k ,j ) + ss12(i ,k ,j+1) ) + & fnp(k)*( ss12(i ,k-1,j ) + ss12(i ,k-1,j+1) ) ) rr12e(i,k,j) = 0.5*( fnm(k)*( rr12(i ,k ,j ) + rr12(i ,k ,j+1) ) + & fnp(k)*( rr12(i ,k-1,j ) + rr12(i ,k-1,j+1) ) ) ss23e(i,k,j) = 0.25*( ss23(i ,k ,j) + ss23(i ,k ,j+1) + & ss23(i-1,k ,j) + ss23(i-1,k ,j+1) ) rr23e(i,k,j) = 0.25*( rr23(i ,k ,j) + rr23(i ,k ,j+1) + & rr23(i-1,k ,j) + rr23(i-1,k ,j+1) ) END DO END DO END DO !LPB[15] !!LPB[16] ! IF ( config_flags%sfs_opt .EQ. 1 ) THEN ! DO j=j_start,j_end ! DO k=kts+1,ktf ! DO i=i_start,i_end ! delta = ( dx * dy / rdzw(i,k,j) )**0.33333333 ! a = -1.0*( cs*delta )**2 ! m13(i,k,j) = a*( 2.0*sqrt( 2.0*smnsmne(i,k,j) )*ss13(i,k,j) & ! + c1*( ss11e(i,k,j)*ss13(i,k,j) & ! + ss12e(i,k,j)*ss23e(i,k,j) & ! + ss13(i,k,j)*ss33e(i,k,j) & ! ) & ! + c2*( ss11e(i,k,j)*rr13(i,k,j) & ! + ss12e(i,k,j)*rr23e(i,k,j) & ! - ss23e(i,k,j)*rr12e(i,k,j) & ! - ss33e(i,k,j)*rr13(i,k,j) & ! ) & ! ) ! ENDDO ! ENDDO ! ENDDO ! ELSE ! DO j=j_start,j_end ! DO k=kts+1,ktf ! DO i=i_start,i_end ! delta = ( dx * dy / rdzw(i,k,j) )**0.33333333 ! a = -1.0*ce*delta ! b = c3*delta ! m13(i,k,j) = a*( 2.0*sqrt( tkee(i,k,j) )*ss13(i,k,j) & ! + b*( & ! c1*( ss11e(i,k,j)*ss13(i,k,j) & ! + ss12e(i,k,j)*ss23e(i,k,j) & ! + ss13(i,k,j)*ss33e(i,k,j) & ! ) & ! + c2*( ss11e(i,k,j)*rr13(i,k,j) & ! + ss12e(i,k,j)*rr23e(i,k,j) & ! - ss23e(i,k,j)*rr12e(i,k,j) & ! - ss33e(i,k,j)*rr13(i,k,j) & ! ) & ! ) & ! ) ! ENDDO ! ENDDO ! ENDDO ! ENDIF !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss11(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss33(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_tkee(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss11e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss33e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss12e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss23e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr12e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr23e(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_smnsmne(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do a_delta =0.0 a_a =0.0 a_b =0.0 !PART IV: REVERSE/BACKWARD ACCUMULATIONS !LPB[16] IF( config_flags%sfs_opt .EQ. 1 ) THEN DO j =j_start, j_end DO k =kts+1, ktf DO i =i_start, i_end delta =(dx*dy/rdzw(i,k,j))**0.33333333 a =-1.0*(cs*delta)**2 Tmpv400(i,k,j) =a Tmpv001 =2.0*sqrt(2.0*smnsmne(i,k,j))*ss13(i,k,j) Tmpv002 =ss11e(i,k,j)*ss13(i,k,j) Tmpv003 =ss12e(i,k,j)*ss23e(i,k,j) Tmpv004 =Tmpv002 +Tmpv003 Tmpv005 =ss13(i,k,j)*ss33e(i,k,j) Tmpv006 =Tmpv004 +Tmpv005 Tmpv007 =c1*Tmpv006 Tmpv008 =Tmpv001 +Tmpv007 Tmpv009 =ss11e(i,k,j)*rr13(i,k,j) Tmpv010 =ss12e(i,k,j)*rr23e(i,k,j) Tmpv011 =Tmpv009 +Tmpv010 Tmpv012 =ss23e(i,k,j)*rr12e(i,k,j) Tmpv013 =Tmpv011 -Tmpv012 Tmpv014 =ss33e(i,k,j)*rr13(i,k,j) Tmpv015 =Tmpv013 -Tmpv014 Tmpv016 =c2*Tmpv015 Tmpv017 =Tmpv008 +Tmpv016 Tmpv401(i,k,j) =Tmpv017 Tmpv018 =a*Tmpv401(i,k,j) m13(i,k,j) =Tmpv018 ENDDO ENDDO ENDDO ELSE DO j =j_start, j_end DO k =kts+1, ktf DO i =i_start, i_end delta =(dx*dy/rdzw(i,k,j))**0.33333333 a =-1.0*ce*delta Tmpv402(i,k,j) =a b =c3*delta Tmpv403(i,k,j) =b Tmpv001 =2.0*sqrt(tkee(i,k,j))*ss13(i,k,j) Tmpv002 =ss11e(i,k,j)*ss13(i,k,j) Tmpv003 =ss12e(i,k,j)*ss23e(i,k,j) Tmpv004 =Tmpv002 +Tmpv003 Tmpv005 =ss13(i,k,j)*ss33e(i,k,j) Tmpv006 =Tmpv004 +Tmpv005 Tmpv007 =c1*Tmpv006 Tmpv008 =ss11e(i,k,j)*rr13(i,k,j) Tmpv009 =ss12e(i,k,j)*rr23e(i,k,j) Tmpv010 =Tmpv008 +Tmpv009 Tmpv011 =ss23e(i,k,j)*rr12e(i,k,j) Tmpv012 =Tmpv010 -Tmpv011 Tmpv013 =ss33e(i,k,j)*rr13(i,k,j) Tmpv014 =Tmpv012 -Tmpv013 Tmpv015 =c2*Tmpv014 Tmpv016 =Tmpv007 +Tmpv015 Tmpv404(i,k,j) =Tmpv016 Tmpv017 =b*Tmpv404(i,k,j) Tmpv018 =Tmpv001 +Tmpv017 Tmpv405(i,k,j) =Tmpv018 Tmpv019 =a*Tmpv405(i,k,j) m13(i,k,j) =Tmpv019 ENDDO ENDDO ENDDO ENDIF IF( config_flags%sfs_opt .EQ. 1 ) THEN DO j =j_end, j_start, -1 DO k =ktf, kts+1, -1 DO i =i_end, i_start, -1 !ADDED BY WALLS delta =(dx*dy/rdzw(i,k,j))**0.33333333 a =Tmpv400(i,k,j) a_Tmpv18 =a_m13(i,k,j) a_m13(i,k,j) =0.0 a_a =a_a +Tmpv401(i,k,j)*a_Tmpv18 a_Tmpv17 =a*a_Tmpv18 a_Tmpv8 =a_Tmpv17 a_Tmpv16 =a_Tmpv17 a_Tmpv15 =c2*a_Tmpv16 a_Tmpv13 =a_Tmpv15 a_Tmpv14 =-a_Tmpv15 a_ss33e(i,k,j) =a_ss33e(i,k,j) +rr13(i,k,j)*a_Tmpv14 a_rr13(i,k,j) =a_rr13(i,k,j) +ss33e(i,k,j)*a_Tmpv14 a_Tmpv11 =a_Tmpv13 a_Tmpv12 =-a_Tmpv13 a_ss23e(i,k,j) =a_ss23e(i,k,j) +rr12e(i,k,j)*a_Tmpv12 a_rr12e(i,k,j) =a_rr12e(i,k,j) +ss23e(i,k,j)*a_Tmpv12 a_Tmpv9 =a_Tmpv11 a_Tmpv10 =a_Tmpv11 a_ss12e(i,k,j) =a_ss12e(i,k,j) +rr23e(i,k,j)*a_Tmpv10 a_rr23e(i,k,j) =a_rr23e(i,k,j) +ss12e(i,k,j)*a_Tmpv10 a_ss11e(i,k,j) =a_ss11e(i,k,j) +rr13(i,k,j)*a_Tmpv9 a_rr13(i,k,j) =a_rr13(i,k,j) +ss11e(i,k,j)*a_Tmpv9 a_Tmpv1 =a_Tmpv8 a_Tmpv7 =a_Tmpv8 a_Tmpv6 =c1*a_Tmpv7 a_Tmpv4 =a_Tmpv6 a_Tmpv5 =a_Tmpv6 a_ss13(i,k,j) =a_ss13(i,k,j) +ss33e(i,k,j)*a_Tmpv5 a_ss33e(i,k,j) =a_ss33e(i,k,j) +ss13(i,k,j)*a_Tmpv5 a_Tmpv2 =a_Tmpv4 a_Tmpv3 =a_Tmpv4 a_ss12e(i,k,j) =a_ss12e(i,k,j) +ss23e(i,k,j)*a_Tmpv3 a_ss23e(i,k,j) =a_ss23e(i,k,j) +ss12e(i,k,j)*a_Tmpv3 a_ss11e(i,k,j) =a_ss11e(i,k,j) +ss13(i,k,j)*a_Tmpv2 a_ss13(i,k,j) =a_ss13(i,k,j) +ss11e(i,k,j)*a_Tmpv2 a_smnsmne(i,k,j) =a_smnsmne(i,k,j) +2.0*g_Sqrt(2.0, 2.0*smnsmne(i,k,j)) & *ss13(i,k,j)*a_Tmpv1 a_ss13(i,k,j) =a_ss13(i,k,j) +2.0*sqrt(2.0*smnsmne(i,k,j))*a_Tmpv1 a_delta =a_delta -1.0*2.0*(cs*delta)*cs*a_a a_a =0.0 a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx* & dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta a_delta =0.0 ENDDO ENDDO ENDDO ELSE DO j =j_end, j_start, -1 DO k =ktf, kts+1, -1 DO i =i_end, i_start, -1 a =Tmpv402(i,k,j) b =Tmpv403(i,k,j) a_Tmpv19 =a_m13(i,k,j) a_m13(i,k,j) =0.0 a_a =a_a +Tmpv405(i,k,j)*a_Tmpv19 a_Tmpv18 =a*a_Tmpv19 a_Tmpv1 =a_Tmpv18 a_Tmpv17 =a_Tmpv18 a_b =a_b +Tmpv404(i,k,j)*a_Tmpv17 a_Tmpv16 =b*a_Tmpv17 a_Tmpv7 =a_Tmpv16 a_Tmpv15 =a_Tmpv16 a_Tmpv14 =c2*a_Tmpv15 a_Tmpv12 =a_Tmpv14 a_Tmpv13 =-a_Tmpv14 a_ss33e(i,k,j) =a_ss33e(i,k,j) +rr13(i,k,j)*a_Tmpv13 a_rr13(i,k,j) =a_rr13(i,k,j) +ss33e(i,k,j)*a_Tmpv13 a_Tmpv10 =a_Tmpv12 a_Tmpv11 =-a_Tmpv12 a_ss23e(i,k,j) =a_ss23e(i,k,j) +rr12e(i,k,j)*a_Tmpv11 a_rr12e(i,k,j) =a_rr12e(i,k,j) +ss23e(i,k,j)*a_Tmpv11 a_Tmpv8 =a_Tmpv10 a_Tmpv9 =a_Tmpv10 a_ss12e(i,k,j) =a_ss12e(i,k,j) +rr23e(i,k,j)*a_Tmpv9 a_rr23e(i,k,j) =a_rr23e(i,k,j) +ss12e(i,k,j)*a_Tmpv9 a_ss11e(i,k,j) =a_ss11e(i,k,j) +rr13(i,k,j)*a_Tmpv8 a_rr13(i,k,j) =a_rr13(i,k,j) +ss11e(i,k,j)*a_Tmpv8 a_Tmpv6 =c1*a_Tmpv7 a_Tmpv4 =a_Tmpv6 a_Tmpv5 =a_Tmpv6 a_ss13(i,k,j) =a_ss13(i,k,j) +ss33e(i,k,j)*a_Tmpv5 a_ss33e(i,k,j) =a_ss33e(i,k,j) +ss13(i,k,j)*a_Tmpv5 a_Tmpv2 =a_Tmpv4 a_Tmpv3 =a_Tmpv4 a_ss12e(i,k,j) =a_ss12e(i,k,j) +ss23e(i,k,j)*a_Tmpv3 a_ss23e(i,k,j) =a_ss23e(i,k,j) +ss12e(i,k,j)*a_Tmpv3 a_ss11e(i,k,j) =a_ss11e(i,k,j) +ss13(i,k,j)*a_Tmpv2 a_ss13(i,k,j) =a_ss13(i,k,j) +ss11e(i,k,j)*a_Tmpv2 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 a_ss13(i,k,j) =a_ss13(i,k,j) +2.0*sqrt(tkee(i,k,j))*a_Tmpv1 a_delta =a_delta +c3*a_b a_b =0.0 a_delta =a_delta -1.0*ce*a_a a_a =0.0 a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx* & dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta a_delta =0.0 ENDDO ENDDO ENDDO ENDIF !LPB[15] !LPB[14] DO j =j_end, j_start, -1 ! DO k =kts+1, ktf ! DO i =i_start, i_end ! Tmpv001 =tke(i,k,j) +tke(i-1,k,j) ! Tmpv002 =fnm(k)*Tmpv001 ! Tmpv003 =tke(i,k-1,j) +tke(i-1,k-1,j) ! Tmpv004 =fnp(k)*Tmpv003 ! Tmpv005 =Tmpv002 +Tmpv004 ! Tmpv006 =0.5*Tmpv005 ! tkee(i,k,j) =Tmpv006 ! Tmpv001 =smnsmn(i,k,j) +smnsmn(i-1,k,j) ! Tmpv002 =fnm(k)*Tmpv001 ! Tmpv003 =smnsmn(i,k-1,j) +smnsmn(i-1,k-1,j) ! Tmpv004 =fnp(k)*Tmpv003 ! Tmpv005 =Tmpv002 +Tmpv004 ! Tmpv006 =0.5*Tmpv005 ! smnsmne(i,k,j) =Tmpv006 ! Tmpv001 =ss11(i,k,j) +ss11(i-1,k,j) ! Tmpv002 =fnm(k)*Tmpv001 ! Tmpv003 =ss11(i,k-1,j) +ss11(i-1,k-1,j) ! Tmpv004 =fnp(k)*Tmpv003 ! Tmpv005 =Tmpv002 +Tmpv004 ! Tmpv006 =0.5*Tmpv005 ! ss11e(i,k,j) =Tmpv006 ! Tmpv001 =ss33(i,k,j) +ss33(i-1,k,j) ! Tmpv002 =fnm(k)*Tmpv001 ! Tmpv003 =ss33(i,k-1,j) +ss33(i-1,k-1,j) ! Tmpv004 =fnp(k)*Tmpv003 ! Tmpv005 =Tmpv002 +Tmpv004 ! Tmpv006 =0.5*Tmpv005 ! ss33e(i,k,j) =Tmpv006 ! Tmpv001 =ss12(i,k,j) +ss12(i,k,j+1) ! Tmpv002 =fnm(k)*Tmpv001 ! Tmpv003 =ss12(i,k-1,j) +ss12(i,k-1,j+1) ! Tmpv004 =fnp(k)*Tmpv003 ! Tmpv005 =Tmpv002 +Tmpv004 ! Tmpv006 =0.5*Tmpv005 ! ss12e(i,k,j) =Tmpv006 ! Tmpv001 =rr12(i,k,j) +rr12(i,k,j+1) ! Tmpv002 =fnm(k)*Tmpv001 ! Tmpv003 =rr12(i,k-1,j) +rr12(i,k-1,j+1) ! Tmpv004 =fnp(k)*Tmpv003 ! Tmpv005 =Tmpv002 +Tmpv004 ! Tmpv006 =0.5*Tmpv005 ! rr12e(i,k,j) =Tmpv006 ! Tmpv001 =ss23(i,k,j) +ss23(i,k,j+1) ! Tmpv002 =Tmpv001 +ss23(i-1,k,j) ! Tmpv003 =Tmpv002 +ss23(i-1,k,j+1) ! Tmpv004 =0.25*Tmpv003 ! ss23e(i,k,j) =Tmpv004 ! Tmpv001 =rr23(i,k,j) +rr23(i,k,j+1) ! Tmpv002 =Tmpv001 +rr23(i-1,k,j) ! Tmpv003 =Tmpv002 +rr23(i-1,k,j+1) ! Tmpv004 =0.25*Tmpv003 ! rr23e(i,k,j) =Tmpv004 ! ENDDO ! ENDDO DO k =ktf, kts+1, -1 DO i =i_end, i_start, -1 a_Tmpv4 =a_rr23e(i,k,j) a_rr23e(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_rr23(i-1,k,j+1) =a_rr23(i-1,k,j+1) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_rr23(i-1,k,j) =a_rr23(i-1,k,j) +a_Tmpv2 a_rr23(i,k,j) =a_rr23(i,k,j) +a_Tmpv1 a_rr23(i,k,j+1) =a_rr23(i,k,j+1) +a_Tmpv1 a_Tmpv4 =a_ss23e(i,k,j) a_ss23e(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss23(i-1,k,j+1) =a_ss23(i-1,k,j+1) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_ss23(i-1,k,j) =a_ss23(i-1,k,j) +a_Tmpv2 a_ss23(i,k,j) =a_ss23(i,k,j) +a_Tmpv1 a_ss23(i,k,j+1) =a_ss23(i,k,j+1) +a_Tmpv1 a_Tmpv6 =a_rr12e(i,k,j) a_rr12e(i,k,j) =0.0 a_Tmpv5 =0.5*a_Tmpv6 a_Tmpv2 =a_Tmpv5 a_Tmpv4 =a_Tmpv5 a_Tmpv3 =fnp(k)*a_Tmpv4 a_rr12(i,k-1,j) =a_rr12(i,k-1,j) +a_Tmpv3 a_rr12(i,k-1,j+1) =a_rr12(i,k-1,j+1) +a_Tmpv3 a_Tmpv1 =fnm(k)*a_Tmpv2 a_rr12(i,k,j) =a_rr12(i,k,j) +a_Tmpv1 a_rr12(i,k,j+1) =a_rr12(i,k,j+1) +a_Tmpv1 a_Tmpv6 =a_ss12e(i,k,j) a_ss12e(i,k,j) =0.0 a_Tmpv5 =0.5*a_Tmpv6 a_Tmpv2 =a_Tmpv5 a_Tmpv4 =a_Tmpv5 a_Tmpv3 =fnp(k)*a_Tmpv4 a_ss12(i,k-1,j) =a_ss12(i,k-1,j) +a_Tmpv3 a_ss12(i,k-1,j+1) =a_ss12(i,k-1,j+1) +a_Tmpv3 a_Tmpv1 =fnm(k)*a_Tmpv2 a_ss12(i,k,j) =a_ss12(i,k,j) +a_Tmpv1 a_ss12(i,k,j+1) =a_ss12(i,k,j+1) +a_Tmpv1 a_Tmpv6 =a_ss33e(i,k,j) a_ss33e(i,k,j) =0.0 a_Tmpv5 =0.5*a_Tmpv6 a_Tmpv2 =a_Tmpv5 a_Tmpv4 =a_Tmpv5 a_Tmpv3 =fnp(k)*a_Tmpv4 a_ss33(i,k-1,j) =a_ss33(i,k-1,j) +a_Tmpv3 a_ss33(i-1,k-1,j) =a_ss33(i-1,k-1,j) +a_Tmpv3 a_Tmpv1 =fnm(k)*a_Tmpv2 a_ss33(i,k,j) =a_ss33(i,k,j) +a_Tmpv1 a_ss33(i-1,k,j) =a_ss33(i-1,k,j) +a_Tmpv1 a_Tmpv6 =a_ss11e(i,k,j) a_ss11e(i,k,j) =0.0 a_Tmpv5 =0.5*a_Tmpv6 a_Tmpv2 =a_Tmpv5 a_Tmpv4 =a_Tmpv5 a_Tmpv3 =fnp(k)*a_Tmpv4 a_ss11(i,k-1,j) =a_ss11(i,k-1,j) +a_Tmpv3 a_ss11(i-1,k-1,j) =a_ss11(i-1,k-1,j) +a_Tmpv3 a_Tmpv1 =fnm(k)*a_Tmpv2 a_ss11(i,k,j) =a_ss11(i,k,j) +a_Tmpv1 a_ss11(i-1,k,j) =a_ss11(i-1,k,j) +a_Tmpv1 a_Tmpv6 =a_smnsmne(i,k,j) a_smnsmne(i,k,j) =0.0 a_Tmpv5 =0.5*a_Tmpv6 a_Tmpv2 =a_Tmpv5 a_Tmpv4 =a_Tmpv5 a_Tmpv3 =fnp(k)*a_Tmpv4 a_smnsmn(i,k-1,j) =a_smnsmn(i,k-1,j) +a_Tmpv3 a_smnsmn(i-1,k-1,j) =a_smnsmn(i-1,k-1,j) +a_Tmpv3 a_Tmpv1 =fnm(k)*a_Tmpv2 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +a_Tmpv1 a_smnsmn(i-1,k,j) =a_smnsmn(i-1,k,j) +a_Tmpv1 a_Tmpv6 =a_tkee(i,k,j) a_tkee(i,k,j) =0.0 a_Tmpv5 =0.5*a_Tmpv6 a_Tmpv2 =a_Tmpv5 a_Tmpv4 =a_Tmpv5 a_Tmpv3 =fnp(k)*a_Tmpv4 a_tke(i,k-1,j) =a_tke(i,k-1,j) +a_Tmpv3 a_tke(i-1,k-1,j) =a_tke(i-1,k-1,j) +a_Tmpv3 a_Tmpv1 =fnm(k)*a_Tmpv2 a_tke(i,k,j) =a_tke(i,k,j) +a_Tmpv1 a_tke(i-1,k,j) =a_tke(i-1,k,j) +a_Tmpv1 ENDDO ENDDO ENDDO !LPB[13] DO j =j_end+1, j_start, -1 ! DO k =kts, ktf ! DO i =i_start-1, i_end ! ss11(i,k,j) =s11(i,k,j)/2.0 ! ss33(i,k,j) =s33(i,k,j)/2.0 ! ss12(i,k,j) =s12(i,k,j)/2.0 ! ss13(i,k,j) =s13(i,k,j)/2.0 ! ss23(i,k,j) =s23(i,k,j)/2.0 ! rr12(i,k,j) =r12(i,k,j)/2.0 ! rr13(i,k,j) =r13(i,k,j)/2.0 ! rr23(i,k,j) =r23(i,k,j)/2.0 ! ENDDO ! ENDDO DO k =ktf, kts, -1 DO i =i_end, i_start-1, -1 a_r23(i,k,j) =a_r23(i,k,j) +1.0/2.0*a_rr23(i,k,j) a_rr23(i,k,j) =0.0 a_r13(i,k,j) =a_r13(i,k,j) +1.0/2.0*a_rr13(i,k,j) a_rr13(i,k,j) =0.0 a_r12(i,k,j) =a_r12(i,k,j) +1.0/2.0*a_rr12(i,k,j) a_rr12(i,k,j) =0.0 a_s23(i,k,j) =a_s23(i,k,j) +1.0/2.0*a_ss23(i,k,j) a_ss23(i,k,j) =0.0 a_s13(i,k,j) =a_s13(i,k,j) +1.0/2.0*a_ss13(i,k,j) a_ss13(i,k,j) =0.0 a_s12(i,k,j) =a_s12(i,k,j) +1.0/2.0*a_ss12(i,k,j) a_ss12(i,k,j) =0.0 a_s33(i,k,j) =a_s33(i,k,j) +1.0/2.0*a_ss33(i,k,j) a_ss33(i,k,j) =0.0 a_s11(i,k,j) =a_s11(i,k,j) +1.0/2.0*a_ss11(i,k,j) a_ss11(i,k,j) =0.0 ENDDO ENDDO ENDDO !LPB[12] ! ie_ext =1 ! i_end =i_end+ie_ext !LPB[11] ! IF( config_flags%periodic_x ) THEN ! i_end =ite ! END IF ! IF( config_flags%periodic_x ) THEN ! END IF !LPB[10] !LPB[9] ! IF( config_flags%periodic_x ) THEN ! i_start =its ! END IF ! IF( config_flags%periodic_x ) THEN ! END IF !LPB[8] !LPB[7] ! IF( config_flags%open_ye .OR. config_flags%specified .OR. config_flags%nested) THEN ! j_end =min(jde-2, jte) ! END IF ! IF( config_flags%open_ye .OR. config_flags%specified .OR. & ! config_flags%nested) THEN ! END IF !LPB[6] !LPB[5] ! IF( config_flags%open_ys .OR. config_flags%specified .OR. config_flags%nested) THEN ! j_start =max(jds+1, jts) ! END IF ! IF( config_flags%open_ys .OR. config_flags%specified .OR. & ! config_flags%nested) THEN ! END IF !LPB[4] !LPB[3] ! IF( config_flags%open_xe .OR. config_flags%specified .OR. config_flags%nested) THEN ! i_end =min(ide-1, ite) ! END IF ! IF( config_flags%open_xe .OR. config_flags%specified .OR. & ! config_flags%nested) THEN ! END IF !LPB[2] !LPB[1] ! IF( config_flags%open_xs .OR. config_flags%specified .OR. config_flags%nested) THEN ! i_start =max(ids+1, its) ! END IF ! IF( config_flags%open_xs .OR. config_flags%specified .OR. & ! config_flags%nested) THEN ! END IF !LPB[0] ! ktf =min(kte, kde-1) ! i_start =its ! i_end =ite ! j_start =jts ! j_end =min(jte, jde-1) Return END SUBROUTINE a_calc_m13 SUBROUTINE a_calc_m23(m23,a_m23,s22,a_s22,s33,a_s33,s12,a_s12,s13,a_s13, & s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23,smnsmn,a_smnsmn,tke,a_tke,rdzw, & a_rdzw,dx,dy,fnm,fnp,config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, & ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte) !PART I: DECLARATION OF VARIABLES IMPLICIT NONE INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: m23,a_m23 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s22,a_s22,s33,a_s33,s12,a_s12,s13, & a_s13,s23,a_s23,r12,a_r12,r13,a_r13,r23,a_r23,smnsmn,a_smnsmn,tke, & a_tke,rdzw,a_rdzw REAL :: dx,dy REAL,DIMENSION(kms:kme) :: fnm,fnp TYPE(grid_config_rec_type) :: config_flags INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, & its,ite,jts,jte,kts,kte REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss22,a_ss22,ss33,a_ss33,ss12, & a_ss12,ss13,a_ss13,ss23,a_ss23,rr12,a_rr12,rr13,a_rr13,rr23,a_rr23 REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: tkef,a_tkef,ss22f,a_ss22f, & ss33f,a_ss33f,ss12f,a_ss12f,ss13f,a_ss13f,rr12f,a_rr12f,rr13f,a_rr13f, & smnsmnf,a_smnsmnf REAL :: delta,a_delta,a,a_a,b,a_b INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf,je_ext REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, & a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9, & Tmpv009,a_Tmpv10,Tmpv010,a_Tmpv11,Tmpv011,a_Tmpv12,Tmpv012,a_Tmpv13,Tmpv013, & a_Tmpv14,Tmpv014,a_Tmpv15,Tmpv015,a_Tmpv16,Tmpv016,a_Tmpv17,Tmpv017, & a_Tmpv18,Tmpv018,a_Tmpv19,Tmpv019 REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) & :: Tmpv400 REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) & :: Tmpv401 REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) & :: Tmpv402 REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) & :: Tmpv403 REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) & :: Tmpv404 REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1),max(jds+1,jts):jte+1) & :: Tmpv405 REAL :: g_Sqrt !PART II: CALCULATIONS OF B. S. TRAJECTORY !LPB[0] ktf = MIN( kte, kde-1 ) i_start = its i_end = MIN( ite, ide-1 ) j_start = jts j_end = jte !LPB[1] IF ( config_flags%open_xs .OR. config_flags%specified .OR. & config_flags%nested) i_start = MAX( ids+1, its ) !LPB[2] !LPB[3] IF ( config_flags%open_xe .OR. config_flags%specified .OR. & config_flags%nested) i_end = MIN( ide-2, ite ) !LPB[4] !LPB[5] IF ( config_flags%open_ys .OR. config_flags%specified .OR. & config_flags%nested) j_start = MAX( jds+1, jts ) !LPB[6] !LPB[7] IF ( config_flags%open_ye .OR. config_flags%specified .OR. & config_flags%nested) j_end = MIN( jde-1, jte ) !LPB[8] !LPB[9] IF ( config_flags%periodic_x ) i_start = its !LPB[10] !LPB[11] IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) !LPB[12] je_ext = 1 j_end = j_end + je_ext !LPB[13] DO j=j_start-1,j_end DO k=kts,ktf DO i=i_start,i_end+1 ss22(i,k,j)=s22(i,k,j)/2.0 ss33(i,k,j)=s33(i,k,j)/2.0 ss12(i,k,j)=s12(i,k,j)/2.0 ss13(i,k,j)=s13(i,k,j)/2.0 ss23(i,k,j)=s23(i,k,j)/2.0 rr12(i,k,j)=r12(i,k,j)/2.0 rr13(i,k,j)=r13(i,k,j)/2.0 rr23(i,k,j)=r23(i,k,j)/2.0 END DO END DO END DO !LPB[14] DO j = j_start, j_end DO k = kts+1, ktf DO i = i_start, i_end tkef(i,k,j) = 0.5*( fnm(k)*( tke(i ,k ,j ) + tke(i ,k ,j-1) ) + & fnp(k)*( tke(i ,k-1,j ) + tke(i ,k-1,j-1) ) ) smnsmnf(i,k,j) = 0.5*( fnm(k)*( smnsmn(i ,k ,j ) + smnsmn(i ,k ,j-1) ) + & fnp(k)*( smnsmn(i ,k-1,j ) + smnsmn(i ,k-1,j-1) ) ) ss22f(i,k,j) = 0.5*( fnm(k)*( ss22(i ,k ,j ) + ss22(i ,k ,j-1) ) + & fnp(k)*( ss22(i ,k-1,j ) + ss22(i ,k-1,j-1) ) ) ss33f(i,k,j) = 0.5*( fnm(k)*( ss33(i ,k ,j ) + ss33(i ,k ,j-1) ) + & fnp(k)*( ss33(i ,k-1,j ) + ss33(i ,k-1,j-1) ) ) ss12f(i,k,j) = 0.5*( fnm(k)*( ss12(i ,k ,j ) + ss12(i+1,k ,j ) ) + & fnp(k)*( ss12(i ,k-1,j ) + ss12(i+1,k-1,j ) ) ) rr12f(i,k,j) = 0.5*( fnm(k)*( rr12(i ,k ,j ) + rr12(i+1,k ,j ) ) + & fnp(k)*( rr12(i ,k-1,j ) + rr12(i+1,k-1,j ) ) ) ss13f(i,k,j) = 0.25*( ss13(i ,k ,j ) + ss13(i ,k ,j-1) + & ss13(i+1,k ,j-1) + ss13(i+1,k ,j ) ) rr13f(i,k,j) = 0.25*( rr13(i ,k ,j ) + rr13(i ,k ,j-1) + & rr13(i+1,k ,j-1) + rr13(i+1,k ,j ) ) END DO END DO END DO !LPB[15] !!LPB[16] ! IF ( config_flags%sfs_opt .EQ. 1 ) THEN ! DO j=j_start,j_end ! DO k=kts+1,ktf ! DO i=i_start,i_end ! delta = ( dx * dy / rdzw(i,k,j) )**0.33333333 ! a = -1.0*( cs*delta )**2 ! m23(i,k,j) = a*( 2.0*sqrt( 2.0*smnsmnf(i,k,j) )*ss23(i,k,j) & ! + c1*( ss12f(i,k,j)*ss13f(i,k,j) & ! + ss22f(i,k,j)*ss23(i,k,j) & ! + ss23(i,k,j) *ss33f(i,k,j) & ! ) & ! + c2*( ss12f(i,k,j)*rr13f(i,k,j) & ! + ss22f(i,k,j)*rr23(i,k,j) & ! + ss13f(i,k,j)*rr12f(i,k,j) & ! - ss33f(i,k,j)*rr23(i,k,j) & ! ) & ! ) ! ENDDO ! ENDDO ! ENDDO ! ELSE ! DO j=j_start,j_end ! DO k=kts+1,ktf ! DO i=i_start,i_end ! delta = ( dx * dy / rdzw(i,k,j) )**0.33333333 ! a = -1.0*ce*delta ! b = c3*delta ! m23(i,k,j) = a*( 2.0*sqrt( tkef(i,k,j) )*ss23(i,k,j) & ! + b*( & ! c1*( ss12f(i,k,j)*ss13f(i,k,j) & ! + ss22f(i,k,j)*ss23(i,k,j) & ! + ss23(i,k,j) *ss33f(i,k,j) & ! ) & ! + c2*( ss12f(i,k,j)*rr13f(i,k,j) & ! + ss22f(i,k,j)*rr23(i,k,j) & ! + ss13f(i,k,j)*rr12f(i,k,j) & ! - ss33f(i,k,j)*rr23(i,k,j) & ! ) & ! ) & ! ) ! ENDDO ! ENDDO ! ENDDO ! ENDIF !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss22(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss33(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr13(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr23(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_tkef(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss22f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss33f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss12f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_ss13f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr12f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_rr13f(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do Do K2_ADJ =jts-1, jte+1 Do K1_ADJ =kms, kme Do K0_ADJ =its-1, ite+1 a_smnsmnf(K0_ADJ,K1_ADJ,K2_ADJ) =0.0 End Do End Do End Do a_delta =0.0 a_a =0.0 a_b =0.0 !PART IV: REVERSE/BACKWARD ACCUMULATIONS !LPB[16] IF( config_flags%sfs_opt .EQ. 1 ) THEN DO j =j_start, j_end DO k =kts+1, ktf DO i =i_start, i_end delta =(dx*dy/rdzw(i,k,j))**0.33333333 a =-1.0*(cs*delta)**2 Tmpv400(i,k,j) =a Tmpv001 =2.0*sqrt(2.0*smnsmnf(i,k,j))*ss23(i,k,j) Tmpv002 =ss12f(i,k,j)*ss13f(i,k,j) Tmpv003 =ss22f(i,k,j)*ss23(i,k,j) Tmpv004 =Tmpv002 +Tmpv003 Tmpv005 =ss23(i,k,j)*ss33f(i,k,j) Tmpv006 =Tmpv004 +Tmpv005 Tmpv007 =c1*Tmpv006 Tmpv008 =Tmpv001 +Tmpv007 Tmpv009 =ss12f(i,k,j)*rr13f(i,k,j) Tmpv010 =ss22f(i,k,j)*rr23(i,k,j) Tmpv011 =Tmpv009 +Tmpv010 Tmpv012 =ss13f(i,k,j)*rr12f(i,k,j) Tmpv013 =Tmpv011 +Tmpv012 Tmpv014 =ss33f(i,k,j)*rr23(i,k,j) Tmpv015 =Tmpv013 -Tmpv014 Tmpv016 =c2*Tmpv015 Tmpv017 =Tmpv008 +Tmpv016 Tmpv401(i,k,j) =Tmpv017 Tmpv018 =a*Tmpv401(i,k,j) m23(i,k,j) =Tmpv018 ENDDO ENDDO ENDDO ELSE DO j =j_start, j_end DO k =kts+1, ktf DO i =i_start, i_end delta =(dx*dy/rdzw(i,k,j))**0.33333333 a =-1.0*ce*delta Tmpv402(i,k,j) =a b =c3*delta Tmpv403(i,k,j) =b Tmpv001 =2.0*sqrt(tkef(i,k,j))*ss23(i,k,j) Tmpv002 =ss12f(i,k,j)*ss13f(i,k,j) Tmpv003 =ss22f(i,k,j)*ss23(i,k,j) Tmpv004 =Tmpv002 +Tmpv003 Tmpv005 =ss23(i,k,j)*ss33f(i,k,j) Tmpv006 =Tmpv004 +Tmpv005 Tmpv007 =c1*Tmpv006 Tmpv008 =ss12f(i,k,j)*rr13f(i,k,j) Tmpv009 =ss22f(i,k,j)*rr23(i,k,j) Tmpv010 =Tmpv008 +Tmpv009 Tmpv011 =ss13f(i,k,j)*rr12f(i,k,j) Tmpv012 =Tmpv010 +Tmpv011 Tmpv013 =ss33f(i,k,j)*rr23(i,k,j) Tmpv014 =Tmpv012 -Tmpv013 Tmpv015 =c2*Tmpv014 Tmpv016 =Tmpv007 +Tmpv015 Tmpv404(i,k,j) =Tmpv016 Tmpv017 =b*Tmpv404(i,k,j) Tmpv018 =Tmpv001 +Tmpv017 Tmpv405(i,k,j) =Tmpv018 Tmpv019 =a*Tmpv405(i,k,j) m23(i,k,j) =Tmpv019 ENDDO ENDDO ENDDO ENDIF IF( config_flags%sfs_opt .EQ. 1 ) THEN DO j =j_end, j_start, -1 DO k =ktf, kts+1, -1 DO i =i_end, i_start, -1 !ADDED BY WALLS delta =(dx*dy/rdzw(i,k,j))**0.33333333 a =Tmpv400(i,k,j) a_Tmpv18 =a_m23(i,k,j) a_m23(i,k,j) =0.0 a_a =a_a +Tmpv401(i,k,j)*a_Tmpv18 a_Tmpv17 =a*a_Tmpv18 a_Tmpv8 =a_Tmpv17 a_Tmpv16 =a_Tmpv17 a_Tmpv15 =c2*a_Tmpv16 a_Tmpv13 =a_Tmpv15 a_Tmpv14 =-a_Tmpv15 a_ss33f(i,k,j) =a_ss33f(i,k,j) +rr23(i,k,j)*a_Tmpv14 a_rr23(i,k,j) =a_rr23(i,k,j) +ss33f(i,k,j)*a_Tmpv14 a_Tmpv11 =a_Tmpv13 a_Tmpv12 =a_Tmpv13 a_ss13f(i,k,j) =a_ss13f(i,k,j) +rr12f(i,k,j)*a_Tmpv12 a_rr12f(i,k,j) =a_rr12f(i,k,j) +ss13f(i,k,j)*a_Tmpv12 a_Tmpv9 =a_Tmpv11 a_Tmpv10 =a_Tmpv11 a_ss22f(i,k,j) =a_ss22f(i,k,j) +rr23(i,k,j)*a_Tmpv10 a_rr23(i,k,j) =a_rr23(i,k,j) +ss22f(i,k,j)*a_Tmpv10 a_ss12f(i,k,j) =a_ss12f(i,k,j) +rr13f(i,k,j)*a_Tmpv9 a_rr13f(i,k,j) =a_rr13f(i,k,j) +ss12f(i,k,j)*a_Tmpv9 a_Tmpv1 =a_Tmpv8 a_Tmpv7 =a_Tmpv8 a_Tmpv6 =c1*a_Tmpv7 a_Tmpv4 =a_Tmpv6 a_Tmpv5 =a_Tmpv6 a_ss23(i,k,j) =a_ss23(i,k,j) +ss33f(i,k,j)*a_Tmpv5 a_ss33f(i,k,j) =a_ss33f(i,k,j) +ss23(i,k,j)*a_Tmpv5 a_Tmpv2 =a_Tmpv4 a_Tmpv3 =a_Tmpv4 a_ss22f(i,k,j) =a_ss22f(i,k,j) +ss23(i,k,j)*a_Tmpv3 a_ss23(i,k,j) =a_ss23(i,k,j) +ss22f(i,k,j)*a_Tmpv3 a_ss12f(i,k,j) =a_ss12f(i,k,j) +ss13f(i,k,j)*a_Tmpv2 a_ss13f(i,k,j) =a_ss13f(i,k,j) +ss12f(i,k,j)*a_Tmpv2 a_smnsmnf(i,k,j) =a_smnsmnf(i,k,j) +2.0*g_Sqrt(2.0, 2.0*smnsmnf(i,k,j)) & *ss23(i,k,j)*a_Tmpv1 a_ss23(i,k,j) =a_ss23(i,k,j) +2.0*sqrt(2.0*smnsmnf(i,k,j))*a_Tmpv1 a_delta =a_delta -1.0*2.0*(cs*delta)*cs*a_a a_a =0.0 a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx* & dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta a_delta =0.0 ENDDO ENDDO ENDDO ELSE DO j =j_end, j_start, -1 DO k =ktf, kts+1, -1 DO i =i_end, i_start, -1 a =Tmpv402(i,k,j) b =Tmpv403(i,k,j) a_Tmpv19 =a_m23(i,k,j) a_m23(i,k,j) =0.0 a_a =a_a +Tmpv405(i,k,j)*a_Tmpv19 a_Tmpv18 =a*a_Tmpv19 a_Tmpv1 =a_Tmpv18 a_Tmpv17 =a_Tmpv18 a_b =a_b +Tmpv404(i,k,j)*a_Tmpv17 a_Tmpv16 =b*a_Tmpv17 a_Tmpv7 =a_Tmpv16 a_Tmpv15 =a_Tmpv16 a_Tmpv14 =c2*a_Tmpv15 a_Tmpv12 =a_Tmpv14 a_Tmpv13 =-a_Tmpv14 a_ss33f(i,k,j) =a_ss33f(i,k,j) +rr23(i,k,j)*a_Tmpv13 a_rr23(i,k,j) =a_rr23(i,k,j) +ss33f(i,k,j)*a_Tmpv13 a_Tmpv10 =a_Tmpv12 a_Tmpv11 =a_Tmpv12 a_ss13f(i,k,j) =a_ss13f(i,k,j) +rr12f(i,k,j)*a_Tmpv11 a_rr12f(i,k,j) =a_rr12f(i,k,j) +ss13f(i,k,j)*a_Tmpv11 a_Tmpv8 =a_Tmpv10 a_Tmpv9 =a_Tmpv10 a_ss22f(i,k,j) =a_ss22f(i,k,j) +rr23(i,k,j)*a_Tmpv9 a_rr23(i,k,j) =a_rr23(i,k,j) +ss22f(i,k,j)*a_Tmpv9 a_ss12f(i,k,j) =a_ss12f(i,k,j) +rr13f(i,k,j)*a_Tmpv8 a_rr13f(i,k,j) =a_rr13f(i,k,j) +ss12f(i,k,j)*a_Tmpv8 a_Tmpv6 =c1*a_Tmpv7 a_Tmpv4 =a_Tmpv6 a_Tmpv5 =a_Tmpv6 a_ss23(i,k,j) =a_ss23(i,k,j) +ss33f(i,k,j)*a_Tmpv5 a_ss33f(i,k,j) =a_ss33f(i,k,j) +ss23(i,k,j)*a_Tmpv5 a_Tmpv2 =a_Tmpv4 a_Tmpv3 =a_Tmpv4 a_ss22f(i,k,j) =a_ss22f(i,k,j) +ss23(i,k,j)*a_Tmpv3 a_ss23(i,k,j) =a_ss23(i,k,j) +ss22f(i,k,j)*a_Tmpv3 a_ss12f(i,k,j) =a_ss12f(i,k,j) +ss13f(i,k,j)*a_Tmpv2 a_ss13f(i,k,j) =a_ss13f(i,k,j) +ss12f(i,k,j)*a_Tmpv2 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 a_ss23(i,k,j) =a_ss23(i,k,j) +2.0*sqrt(tkef(i,k,j))*a_Tmpv1 a_delta =a_delta +c3*a_b a_b =0.0 a_delta =a_delta -1.0*ce*a_a a_a =0.0 a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx*dy/(rdzw(i,k,j)*rdzw(i,k,j))*0.33333333*(dx* & dy/rdzw(i,k,j))**(0.33333333 -1)*a_delta a_delta =0.0 ENDDO ENDDO ENDDO ENDIF !LPB[15] !LPB[14] DO j =j_end, j_start, -1 ! DO k =kts+1, ktf ! DO i =i_start, i_end ! Tmpv001 =tke(i,k,j) +tke(i,k,j-1) ! Tmpv002 =fnm(k)*Tmpv001 ! Tmpv003 =tke(i,k-1,j) +tke(i,k-1,j-1) ! Tmpv004 =fnp(k)*Tmpv003 ! Tmpv005 =Tmpv002 +Tmpv004 ! Tmpv006 =0.5*Tmpv005 ! tkef(i,k,j) =Tmpv006 ! Tmpv001 =smnsmn(i,k,j) +smnsmn(i,k,j-1) ! Tmpv002 =fnm(k)*Tmpv001 ! Tmpv003 =smnsmn(i,k-1,j) +smnsmn(i,k-1,j-1) ! Tmpv004 =fnp(k)*Tmpv003 ! Tmpv005 =Tmpv002 +Tmpv004 ! Tmpv006 =0.5*Tmpv005 ! smnsmnf(i,k,j) =Tmpv006 ! Tmpv001 =ss22(i,k,j) +ss22(i,k,j-1) ! Tmpv002 =fnm(k)*Tmpv001 ! Tmpv003 =ss22(i,k-1,j) +ss22(i,k-1,j-1) ! Tmpv004 =fnp(k)*Tmpv003 ! Tmpv005 =Tmpv002 +Tmpv004 ! Tmpv006 =0.5*Tmpv005 ! ss22f(i,k,j) =Tmpv006 ! Tmpv001 =ss33(i,k,j) +ss33(i,k,j-1) ! Tmpv002 =fnm(k)*Tmpv001 ! Tmpv003 =ss33(i,k-1,j) +ss33(i,k-1,j-1) ! Tmpv004 =fnp(k)*Tmpv003 ! Tmpv005 =Tmpv002 +Tmpv004 ! Tmpv006 =0.5*Tmpv005 ! ss33f(i,k,j) =Tmpv006 ! Tmpv001 =ss12(i,k,j) +ss12(i+1,k,j) ! Tmpv002 =fnm(k)*Tmpv001 ! Tmpv003 =ss12(i,k-1,j) +ss12(i+1,k-1,j) ! Tmpv004 =fnp(k)*Tmpv003 ! Tmpv005 =Tmpv002 +Tmpv004 ! Tmpv006 =0.5*Tmpv005 ! ss12f(i,k,j) =Tmpv006 ! Tmpv001 =rr12(i,k,j) +rr12(i+1,k,j) ! Tmpv002 =fnm(k)*Tmpv001 ! Tmpv003 =rr12(i,k-1,j) +rr12(i+1,k-1,j) ! Tmpv004 =fnp(k)*Tmpv003 ! Tmpv005 =Tmpv002 +Tmpv004 ! Tmpv006 =0.5*Tmpv005 ! rr12f(i,k,j) =Tmpv006 ! Tmpv001 =ss13(i,k,j) +ss13(i,k,j-1) ! Tmpv002 =Tmpv001 +ss13(i+1,k,j-1) ! Tmpv003 =Tmpv002 +ss13(i+1,k,j) ! Tmpv004 =0.25*Tmpv003 ! ss13f(i,k,j) =Tmpv004 ! Tmpv001 =rr13(i,k,j) +rr13(i,k,j-1) ! Tmpv002 =Tmpv001 +rr13(i+1,k,j-1) ! Tmpv003 =Tmpv002 +rr13(i+1,k,j) ! Tmpv004 =0.25*Tmpv003 ! rr13f(i,k,j) =Tmpv004 ! ENDDO ! ENDDO DO k =ktf, kts+1, -1 DO i =i_end, i_start, -1 a_Tmpv4 =a_rr13f(i,k,j) a_rr13f(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_rr13(i+1,k,j) =a_rr13(i+1,k,j) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_rr13(i+1,k,j-1) =a_rr13(i+1,k,j-1) +a_Tmpv2 a_rr13(i,k,j) =a_rr13(i,k,j) +a_Tmpv1 a_rr13(i,k,j-1) =a_rr13(i,k,j-1) +a_Tmpv1 a_Tmpv4 =a_ss13f(i,k,j) a_ss13f(i,k,j) =0.0 a_Tmpv3 =0.25*a_Tmpv4 a_Tmpv2 =a_Tmpv3 a_ss13(i+1,k,j) =a_ss13(i+1,k,j) +a_Tmpv3 a_Tmpv1 =a_Tmpv2 a_ss13(i+1,k,j-1) =a_ss13(i+1,k,j-1) +a_Tmpv2 a_ss13(i,k,j) =a_ss13(i,k,j) +a_Tmpv1 a_ss13(i,k,j-1) =a_ss13(i,k,j-1) +a_Tmpv1 a_Tmpv6 =a_rr12f(i,k,j) a_rr12f(i,k,j) =0.0 a_Tmpv5 =0.5*a_Tmpv6 a_Tmpv2 =a_Tmpv5 a_Tmpv4 =a_Tmpv5 a_Tmpv3 =fnp(k)*a_Tmpv4 a_rr12(i,k-1,j) =a_rr12(i,k-1,j) +a_Tmpv3 a_rr12(i+1,k-1,j) =a_rr12(i+1,k-1,j) +a_Tmpv3 a_Tmpv1 =fnm(k)*a_Tmpv2 a_rr12(i,k,j) =a_rr12(i,k,j) +a_Tmpv1 a_rr12(i+1,k,j) =a_rr12(i+1,k,j) +a_Tmpv1 a_Tmpv6 =a_ss12f(i,k,j) a_ss12f(i,k,j) =0.0 a_Tmpv5 =0.5*a_Tmpv6 a_Tmpv2 =a_Tmpv5 a_Tmpv4 =a_Tmpv5 a_Tmpv3 =fnp(k)*a_Tmpv4 a_ss12(i,k-1,j) =a_ss12(i,k-1,j) +a_Tmpv3 a_ss12(i+1,k-1,j) =a_ss12(i+1,k-1,j) +a_Tmpv3 a_Tmpv1 =fnm(k)*a_Tmpv2 a_ss12(i,k,j) =a_ss12(i,k,j) +a_Tmpv1 a_ss12(i+1,k,j) =a_ss12(i+1,k,j) +a_Tmpv1 a_Tmpv6 =a_ss33f(i,k,j) a_ss33f(i,k,j) =0.0 a_Tmpv5 =0.5*a_Tmpv6 a_Tmpv2 =a_Tmpv5 a_Tmpv4 =a_Tmpv5 a_Tmpv3 =fnp(k)*a_Tmpv4 a_ss33(i,k-1,j) =a_ss33(i,k-1,j) +a_Tmpv3 a_ss33(i,k-1,j-1) =a_ss33(i,k-1,j-1) +a_Tmpv3 a_Tmpv1 =fnm(k)*a_Tmpv2 a_ss33(i,k,j) =a_ss33(i,k,j) +a_Tmpv1 a_ss33(i,k,j-1) =a_ss33(i,k,j-1) +a_Tmpv1 a_Tmpv6 =a_ss22f(i,k,j) a_ss22f(i,k,j) =0.0 a_Tmpv5 =0.5*a_Tmpv6 a_Tmpv2 =a_Tmpv5 a_Tmpv4 =a_Tmpv5 a_Tmpv3 =fnp(k)*a_Tmpv4 a_ss22(i,k-1,j) =a_ss22(i,k-1,j) +a_Tmpv3 a_ss22(i,k-1,j-1) =a_ss22(i,k-1,j-1) +a_Tmpv3 a_Tmpv1 =fnm(k)*a_Tmpv2 a_ss22(i,k,j) =a_ss22(i,k,j) +a_Tmpv1 a_ss22(i,k,j-1) =a_ss22(i,k,j-1) +a_Tmpv1 a_Tmpv6 =a_smnsmnf(i,k,j) a_smnsmnf(i,k,j) =0.0 a_Tmpv5 =0.5*a_Tmpv6 a_Tmpv2 =a_Tmpv5 a_Tmpv4 =a_Tmpv5 a_Tmpv3 =fnp(k)*a_Tmpv4 a_smnsmn(i,k-1,j) =a_smnsmn(i,k-1,j) +a_Tmpv3 a_smnsmn(i,k-1,j-1) =a_smnsmn(i,k-1,j-1) +a_Tmpv3 a_Tmpv1 =fnm(k)*a_Tmpv2 a_smnsmn(i,k,j) =a_smnsmn(i,k,j) +a_Tmpv1 a_smnsmn(i,k,j-1) =a_smnsmn(i,k,j-1) +a_Tmpv1 a_Tmpv6 =a_tkef(i,k,j) a_tkef(i,k,j) =0.0 a_Tmpv5 =0.5*a_Tmpv6 a_Tmpv2 =a_Tmpv5 a_Tmpv4 =a_Tmpv5 a_Tmpv3 =fnp(k)*a_Tmpv4 a_tke(i,k-1,j) =a_tke(i,k-1,j) +a_Tmpv3 a_tke(i,k-1,j-1) =a_tke(i,k-1,j-1) +a_Tmpv3 a_Tmpv1 =fnm(k)*a_Tmpv2 a_tke(i,k,j) =a_tke(i,k,j) +a_Tmpv1 a_tke(i,k,j-1) =a_tke(i,k,j-1) +a_Tmpv1 ENDDO ENDDO ENDDO !LPB[13] DO j =j_end, j_start-1, -1 ! DO k =kts, ktf ! DO i =i_start, i_end+1 ! ss22(i,k,j) =s22(i,k,j)/2.0 ! ss33(i,k,j) =s33(i,k,j)/2.0 ! ss12(i,k,j) =s12(i,k,j)/2.0 ! ss13(i,k,j) =s13(i,k,j)/2.0 ! ss23(i,k,j) =s23(i,k,j)/2.0 ! rr12(i,k,j) =r12(i,k,j)/2.0 ! rr13(i,k,j) =r13(i,k,j)/2.0 ! rr23(i,k,j) =r23(i,k,j)/2.0 ! ENDDO ! ENDDO DO k =ktf, kts, -1 DO i =i_end+1, i_start, -1 a_r23(i,k,j) =a_r23(i,k,j) +1.0/2.0*a_rr23(i,k,j) a_rr23(i,k,j) =0.0 a_r13(i,k,j) =a_r13(i,k,j) +1.0/2.0*a_rr13(i,k,j) a_rr13(i,k,j) =0.0 a_r12(i,k,j) =a_r12(i,k,j) +1.0/2.0*a_rr12(i,k,j) a_rr12(i,k,j) =0.0 a_s23(i,k,j) =a_s23(i,k,j) +1.0/2.0*a_ss23(i,k,j) a_ss23(i,k,j) =0.0 a_s13(i,k,j) =a_s13(i,k,j) +1.0/2.0*a_ss13(i,k,j) a_ss13(i,k,j) =0.0 a_s12(i,k,j) =a_s12(i,k,j) +1.0/2.0*a_ss12(i,k,j) a_ss12(i,k,j) =0.0 a_s33(i,k,j) =a_s33(i,k,j) +1.0/2.0*a_ss33(i,k,j) a_ss33(i,k,j) =0.0 a_s22(i,k,j) =a_s22(i,k,j) +1.0/2.0*a_ss22(i,k,j) a_ss22(i,k,j) =0.0 ENDDO ENDDO ENDDO !LPB[12] ! je_ext =1 ! j_end =j_end+je_ext !LPB[11] ! IF( config_flags%periodic_x ) THEN ! i_end =min(ite, ide-1) ! END IF ! IF( config_flags%periodic_x ) THEN ! END IF !LPB[10] !LPB[9] ! IF( config_flags%periodic_x ) THEN ! i_start =its ! END IF ! IF( config_flags%periodic_x ) THEN ! END IF !LPB[8] !LPB[7] ! IF( config_flags%open_ye .OR. config_flags%specified .OR. config_flags%nested) THEN ! j_end =min(jde-1, jte) ! END IF ! IF( config_flags%open_ye .OR. config_flags%specified .OR. & ! config_flags%nested) THEN ! END IF !LPB[6] !LPB[5] ! IF( config_flags%open_ys .OR. config_flags%specified .OR. config_flags%nested) THEN ! j_start =max(jds+1, jts) ! END IF ! IF( config_flags%open_ys .OR. config_flags%specified .OR. & ! config_flags%nested) THEN ! END IF !LPB[4] !LPB[3] ! IF( config_flags%open_xe .OR. config_flags%specified .OR. config_flags%nested) THEN ! i_end =min(ide-2, ite) ! END IF ! IF( config_flags%open_xe .OR. config_flags%specified .OR. & ! config_flags%nested) THEN ! END IF !LPB[2] !LPB[1] ! IF( config_flags%open_xs .OR. config_flags%specified .OR. config_flags%nested) THEN ! i_start =max(ids+1, its) ! END IF ! IF( config_flags%open_xs .OR. config_flags%specified .OR. & ! config_flags%nested) THEN ! END IF !LPB[0] ! ktf =min(kte, kde-1) ! i_start =its ! i_end =min(ite, ide-1) ! j_start =jts ! j_end =jte Return END SUBROUTINE a_calc_m23 END MODULE a_module_sfs_nba