! ======================================================================================
! This file was generated by the version 5.3.6 of DFT on 08/10/2010. The differentiation
! transforming system(DFT) was jointly developed and sponsored by LASG of IAP(1998-2010)
! and LSEC of ICMSEC, AMSS(2001-2003)
! The copyright of the DFT system was declared by Walls at LASG, 1998-2010
! ======================================================================================

 MODULE g_module_diffusion_em

 USE g_module_bc, only: g_set_physical_bc3d
 USE module_state_description, only: p_m23, p_m13, p_m22, p_m33, p_r23, p_r13, p_r12, p_m12, p_m11
 USE g_module_big_step_utilities_em, only: grid_config_rec_type, param_first_scalar, p_qv, p_qi, p_qc

 USE module_model_constants

 CONTAINS

 SUBROUTINE g_cal_deform_and_div(config_flags,u,g_u,v,g_v,w,g_w,div, &
 g_div,defor11,g_defor11,defor22,g_defor22,defor33,g_defor33,defor12, &
 g_defor12,defor13,g_defor13,defor23,g_defor23,nba_rij,g_nba_rij, &
 n_nba_rij,u_base,v_base,msfux,msfuy,msfvx,msfvy,msftx,msfty,rdx,rdy,dn,dnw,rdz, &
 g_rdz,rdzw,g_rdzw,fnm,fnp,cf1,cf2,cf3,zx,g_zx,zy,g_zy,ids,ide,jds,jde, &
 kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4,Tmpv5, &
 g_Tmpv5,Tmpv6,g_Tmpv6
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 REAL :: rdx,rdy,cf1,cf2,cf3
 REAL,DIMENSION(kms:kme) :: fnm,fnp,dn,dnw,u_base,v_base
 REAL,DIMENSION(ims:ime,jms:jme) :: msfux,msfuy,msfvx,msfvy,msftx,msfty
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: u,g_u,v,g_v,w,g_w,zx,g_zx,zy, &
 g_zy,rdz,g_rdz,rdzw,g_rdzw
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor11,g_defor11,defor22,g_defor22, &
 defor33,g_defor33,defor12,g_defor12,defor13,g_defor13,defor23,g_defor23, &
 div,g_div

 INTEGER :: n_nba_rij

 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_rij) :: nba_rij,g_nba_rij
 INTEGER :: i,j,k,ktf,ktes1,ktes2,i_start,i_end,j_start,j_end
 REAL :: tmp,g_tmp,tmpzx,g_tmpzx,tmpzy,g_tmpzy,tmpzeta_z,g_tmpzeta_z,cft1, &
 g_cft1,cft2,g_cft2
 REAL,DIMENSION(its:ite,jts:jte) :: mm,g_mm,zzavg,g_zzavg,zeta_zd12,g_zeta_zd12
 REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: tmp1,g_tmp1,hat,g_hat, &
 hatavg,g_hatavg

 ktes1 =kte-1

 ktes2 =kte-2

 g_cft2 =0.0
 cft2 =-0.5 *dnw(ktes1)/dn(ktes1)

 g_cft1 =-g_cft2
 cft1 =1.0 -cft2

 ktf =min(kte,kde-1)

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_mm(i,j) =0.0
 mm(i,j) =msftx(i,j) *msfty(i,j)

 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end+1

 g_hat(i,k,j) =g_u(i,k,j)/msfuy(i,j)
 hat(i,k,j) =u(i,k,j)/msfuy(i,j)

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_hatavg(i,k,j) =0.5*(fnm(k)*(g_hat(i,k,j) +g_hat(i+1,k,j)) +fnp(k) &
*(g_hat(i,k-1,j) +g_hat(i+1,k-1,j)))
 hatavg(i,k,j) =0.5*(fnm(k)*(hat(i,k,j) +hat(i+1,k,j)) +fnp(k)*(hat(i,k-1,j) &
 +hat(i+1,k-1,j)))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_hatavg(i,1,j) =0.5*(cf1*g_hat(i,1,j) +cf2*g_hat(i,2,j) +cf3*g_hat(i,3, &
 j) +cf1*g_hat(i+1,1,j) +cf2*g_hat(i+1,2,j) +cf3*g_hat(i+1,3,j))
 hatavg(i,1,j) =0.5*(cf1*hat(i,1,j) +cf2*hat(i,2,j) +cf3*hat(i,3,j) +cf1*hat(i+1,1,j) &
 +cf2*hat(i+1,2,j) +cf3*hat(i+1,3,j))

 g_Tmpv1 =cft1*(g_hat(i,ktes1,j) +g_hat(i+1,ktes1,j)) +g_cft1*(hat(i, &
 ktes1,j) +hat(i+1,ktes1,j)) 
 Tmpv1 =cft1*(hat(i,ktes1,j) +hat(i+1,ktes1,j))

 g_Tmpv2 =cft2*(g_hat(i,ktes2,j) +g_hat(i+1,ktes2,j)) +g_cft2*(hat(i, &
 ktes2,j) +hat(i+1,ktes2,j)) 
 Tmpv2 =cft2*(hat(i,ktes2,j) +hat(i+1,ktes2,j))

 g_hatavg(i,kte,j) =0.5*(g_Tmpv1 +g_Tmpv2)
 hatavg(i,kte,j) =0.5*(Tmpv1 +Tmpv2)

 ENDDO
 ENDDO

!LPB[5]

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tmpzx =0.25*(g_zx(i,k,j) +g_zx(i+1,k,j) +g_zx(i,k+1,j) +g_zx(i+1,k+1,j))
 tmpzx =0.25*(zx(i,k,j) +zx(i+1,k,j) +zx(i,k+1,j) +zx(i+1,k+1,j))

 g_Tmpv1 =(hatavg(i,k+1,j) -hatavg(i,k,j))*g_tmpzx +(g_hatavg(i,k+1,j) &
 -g_hatavg(i,k,j))*tmpzx
 Tmpv1 =(hatavg(i,k+1,j) -hatavg(i,k,j))*tmpzx

 g_Tmpv2 =Tmpv1*g_rdzw(i,k,j) +g_Tmpv1*rdzw(i,k,j)
 Tmpv2 =Tmpv1*rdzw(i,k,j)

 g_tmp1(i,k,j) =g_Tmpv2
 tmp1(i,k,j) =Tmpv2

 ENDDO
 ENDDO
 ENDDO

!LPB[6]

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =mm(i,j)*(rdx*(g_hat(i+1,k,j) -g_hat(i,k,j)) -g_tmp1(i,k,j)) &
 +g_mm(i,j)*(rdx*(hat(i+1,k,j) -hat(i,k,j)) -tmp1(i,k,j)) 
 Tmpv1 =mm(i,j)*(rdx*(hat(i+1,k,j) -hat(i,k,j)) -tmp1(i,k,j))

 g_tmp1(i,k,j) =g_Tmpv1
 tmp1(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_defor11(i,k,j) =2.0*g_tmp1(i,k,j)
 defor11(i,k,j) =2.0*tmp1(i,k,j)

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_div(i,k,j) =g_tmp1(i,k,j)
 div(i,k,j) =tmp1(i,k,j)

 ENDDO
 ENDDO
 ENDDO

!LPB[9]

 DO j =j_start,j_end+1
 DO k =kts,ktf
 DO i =i_start,i_end

 IF((config_flags%polar) .AND. ((j == jds) .OR. (j == jde))) THEN

 g_hat(i,k,j) =0.0
 hat(i,k,j) =0.

 ELSE

 g_hat(i,k,j) =g_v(i,k,j)/msfvx(i,j)
 hat(i,k,j) =v(i,k,j)/msfvx(i,j)

 ENDIF
 ENDDO
 ENDDO
 ENDDO

!LPB[10]

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_hatavg(i,k,j) =0.5*(fnm(k)*(g_hat(i,k,j) +g_hat(i,k,j+1)) +fnp(k) &
*(g_hat(i,k-1,j) +g_hat(i,k-1,j+1)))
 hatavg(i,k,j) =0.5*(fnm(k)*(hat(i,k,j) +hat(i,k,j+1)) +fnp(k)*(hat(i,k-1,j) &
 +hat(i,k-1,j+1)))

 ENDDO
 ENDDO
 ENDDO

!LPB[11]

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_hatavg(i,1,j) =0.5*(cf1*g_hat(i,1,j) +cf2*g_hat(i,2,j) +cf3*g_hat(i,3, &
 j) +cf1*g_hat(i,1,j+1) +cf2*g_hat(i,2,j+1) +cf3*g_hat(i,3,j+1))
 hatavg(i,1,j) =0.5*(cf1*hat(i,1,j) +cf2*hat(i,2,j) +cf3*hat(i,3,j) +cf1*hat(i,1,j+1) &
 +cf2*hat(i,2,j+1) +cf3*hat(i,3,j+1))

 g_Tmpv1 =cft1*(g_hat(i,ktes1,j) +g_hat(i,ktes1,j+1)) +g_cft1*(hat(i, &
 ktes1,j) +hat(i,ktes1,j+1)) 
 Tmpv1 =cft1*(hat(i,ktes1,j) +hat(i,ktes1,j+1))

 g_Tmpv2 =cft2*(g_hat(i,ktes2,j) +g_hat(i,ktes2,j+1)) +g_cft2*(hat(i, &
 ktes2,j) +hat(i,ktes2,j+1)) 
 Tmpv2 =cft2*(hat(i,ktes2,j) +hat(i,ktes2,j+1))

 g_hatavg(i,kte,j) =0.5*(g_Tmpv1 +g_Tmpv2)
 hatavg(i,kte,j) =0.5*(Tmpv1 +Tmpv2)

 ENDDO
 ENDDO

!LPB[12]

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tmpzy =0.25*(g_zy(i,k,j) +g_zy(i,k,j+1) +g_zy(i,k+1,j) +g_zy(i,k+1,j+1))
 tmpzy =0.25*(zy(i,k,j) +zy(i,k,j+1) +zy(i,k+1,j) +zy(i,k+1,j+1))

 g_Tmpv1 =(hatavg(i,k+1,j) -hatavg(i,k,j))*g_tmpzy +(g_hatavg(i,k+1,j) &
 -g_hatavg(i,k,j))*tmpzy
 Tmpv1 =(hatavg(i,k+1,j) -hatavg(i,k,j))*tmpzy

 g_Tmpv2 =Tmpv1*g_rdzw(i,k,j) +g_Tmpv1*rdzw(i,k,j)
 Tmpv2 =Tmpv1*rdzw(i,k,j)

 g_tmp1(i,k,j) =g_Tmpv2
 tmp1(i,k,j) =Tmpv2

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =mm(i,j)*(rdy*(g_hat(i,k,j+1) -g_hat(i,k,j)) -g_tmp1(i,k,j)) &
 +g_mm(i,j)*(rdy*(hat(i,k,j+1) -hat(i,k,j)) -tmp1(i,k,j)) 
 Tmpv1 =mm(i,j)*(rdy*(hat(i,k,j+1) -hat(i,k,j)) -tmp1(i,k,j))

 g_tmp1(i,k,j) =g_Tmpv1
 tmp1(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_defor22(i,k,j) =2.0*g_tmp1(i,k,j)
 defor22(i,k,j) =2.0*tmp1(i,k,j)

 ENDDO
 ENDDO
 ENDDO

!LPB[15]
 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_div(i,k,j) =g_div(i,k,j) +g_tmp1(i,k,j)
 div(i,k,j) =div(i,k,j) +tmp1(i,k,j)

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =(w(i,k+1,j) -w(i,k,j))*g_rdzw(i,k,j) +(g_w(i,k+1,j) -g_w(i,k, &
 j))*rdzw(i,k,j)
 Tmpv1 =(w(i,k+1,j) -w(i,k,j))*rdzw(i,k,j)

 g_tmp1(i,k,j) =g_Tmpv1
 tmp1(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_defor33(i,k,j) =2.0*g_tmp1(i,k,j)
 defor33(i,k,j) =2.0*tmp1(i,k,j)

 ENDDO
 ENDDO
 ENDDO

!LPB[18]
 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_div(i,k,j) =g_div(i,k,j) +g_tmp1(i,k,j)
 div(i,k,j) =div(i,k,j) +tmp1(i,k,j)

 ENDDO
 ENDDO
 ENDDO

!LPB[19]
 i_start =its

 i_end =ite

 j_start =jts

 j_end =jte

 IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
         config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .OR. config_flags%specified .OR.    &
         config_flags%nested) i_end =min(ide-1,ite)

 IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
         config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
         config_flags%nested) j_end =min(jde-1,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =ite

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_mm(i,j) =0.0
 mm(i,j) =0.25 *(msfux(i,j-1)+msfux(i,j)) *(msfvy(i-1,j)+msfvy(i,j))

 ENDDO
 ENDDO

 DO j =j_start-1,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_hat(i,k,j) =g_u(i,k,j)/msfux(i,j)
 hat(i,k,j) =u(i,k,j)/msfux(i,j)

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_hatavg(i,k,j) =0.5*(fnm(k)*(g_hat(i,k,j-1) +g_hat(i,k,j)) +fnp(k) &
*(g_hat(i,k-1,j-1) +g_hat(i,k-1,j)))
 hatavg(i,k,j) =0.5*(fnm(k)*(hat(i,k,j-1) +hat(i,k,j)) +fnp(k)*(hat(i,k-1,j-1) &
 +hat(i,k-1,j)))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_hatavg(i,1,j) =0.5*(cf1*g_hat(i,1,j-1) +cf2*g_hat(i,2,j-1) +cf3*g_hat( &
 i,3,j-1) +cf1*g_hat(i,1,j) +cf2*g_hat(i,2,j) +cf3*g_hat(i,3,j))
 hatavg(i,1,j) =0.5*(cf1*hat(i,1,j-1) +cf2*hat(i,2,j-1) +cf3*hat(i,3,j-1) &
 +cf1*hat(i,1,j) +cf2*hat(i,2,j) +cf3*hat(i,3,j))

 g_Tmpv1 =cft1*(g_hat(i,ktes1,j-1) +g_hat(i,ktes1,j)) +g_cft1*(hat(i, &
 ktes1,j-1) +hat(i,ktes1,j)) 
 Tmpv1 =cft1*(hat(i,ktes1,j-1) +hat(i,ktes1,j))

 g_Tmpv2 =cft2*(g_hat(i,ktes2,j-1) +g_hat(i,ktes2,j)) +g_cft2*(hat(i, &
 ktes2,j-1) +hat(i,ktes2,j)) 
 Tmpv2 =cft2*(hat(i,ktes2,j-1) +hat(i,ktes2,j))

 g_hatavg(i,kte,j) =0.5*(g_Tmpv1 +g_Tmpv2)
 hatavg(i,kte,j) =0.5*(Tmpv1 +Tmpv2)

 ENDDO
 ENDDO

!LPB[35]

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tmpzy =0.25*(g_zy(i-1,k,j) +g_zy(i,k,j) +g_zy(i-1,k+1,j) +g_zy(i,k+1,j))
 tmpzy =0.25*(zy(i-1,k,j) +zy(i,k,j) +zy(i-1,k+1,j) +zy(i,k+1,j))

 g_Tmpv1 =(hatavg(i,k+1,j) -hatavg(i,k,j))*0.25*g_tmpzy +(g_hatavg(i,k+1,j) &
 -g_hatavg(i,k,j))*0.25*tmpzy
 Tmpv1 =(hatavg(i,k+1,j) -hatavg(i,k,j))*0.25*tmpzy

 g_Tmpv2 =Tmpv1*(g_rdzw(i,k,j) +g_rdzw(i-1,k,j) +g_rdzw(i-1,k,j-1) &
 +g_rdzw(i,k,j-1)) +g_Tmpv1*(rdzw(i,k,j) +rdzw(i-1,k,j) +rdzw(i-1,k,j-1) +rdzw(i,k,j-1))
 Tmpv2 =Tmpv1*(rdzw(i,k,j) +rdzw(i-1,k,j) +rdzw(i-1,k,j-1) +rdzw(i,k,j-1))

 g_tmp1(i,k,j) =g_Tmpv2
 tmp1(i,k,j) =Tmpv2

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =mm(i,j)*(rdy*(g_hat(i,k,j) -g_hat(i,k,j-1)) -g_tmp1(i,k,j)) &
 +g_mm(i,j)*(rdy*(hat(i,k,j) -hat(i,k,j-1)) -tmp1(i,k,j)) 
 Tmpv1 =mm(i,j)*(rdy*(hat(i,k,j) -hat(i,k,j-1)) -tmp1(i,k,j))

 g_defor12(i,k,j) =g_Tmpv1
 defor12(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

!LPB[37]
 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start-1,i_end

 g_hat(i,k,j) =g_v(i,k,j)/msfvy(i,j)
 hat(i,k,j) =v(i,k,j)/msfvy(i,j)

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_hatavg(i,k,j) =0.5*(fnm(k)*(g_hat(i-1,k,j) +g_hat(i,k,j)) +fnp(k) &
*(g_hat(i-1,k-1,j) +g_hat(i,k-1,j)))
 hatavg(i,k,j) =0.5*(fnm(k)*(hat(i-1,k,j) +hat(i,k,j)) +fnp(k)*(hat(i-1,k-1,j) &
 +hat(i,k-1,j)))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_hatavg(i,1,j) =0.5*(cf1*g_hat(i-1,1,j) +cf2*g_hat(i-1,2,j) +cf3*g_hat( &
 i-1,3,j) +cf1*g_hat(i,1,j) +cf2*g_hat(i,2,j) +cf3*g_hat(i,3,j))
 hatavg(i,1,j) =0.5*(cf1*hat(i-1,1,j) +cf2*hat(i-1,2,j) +cf3*hat(i-1,3,j) &
 +cf1*hat(i,1,j) +cf2*hat(i,2,j) +cf3*hat(i,3,j))

 g_Tmpv1 =cft1*(g_hat(i,ktes1,j) +g_hat(i-1,ktes1,j)) +g_cft1*(hat(i, &
 ktes1,j) +hat(i-1,ktes1,j)) 
 Tmpv1 =cft1*(hat(i,ktes1,j) +hat(i-1,ktes1,j))

 g_Tmpv2 =cft2*(g_hat(i,ktes2,j) +g_hat(i-1,ktes2,j)) +g_cft2*(hat(i, &
 ktes2,j) +hat(i-1,ktes2,j)) 
 Tmpv2 =cft2*(hat(i,ktes2,j) +hat(i-1,ktes2,j))

 g_hatavg(i,kte,j) =0.5*(g_Tmpv1 +g_Tmpv2)
 hatavg(i,kte,j) =0.5*(Tmpv1 +Tmpv2)

 ENDDO
 ENDDO

!LPB[40]
 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tmpzx =0.25*(g_zx(i,k,j-1) +g_zx(i,k,j) +g_zx(i,k+1,j-1) +g_zx(i,k+1,j))
 tmpzx =0.25*(zx(i,k,j-1) +zx(i,k,j) +zx(i,k+1,j-1) +zx(i,k+1,j))

 g_Tmpv1 =(hatavg(i,k+1,j) -hatavg(i,k,j))*0.25*g_tmpzx +(g_hatavg(i,k+1,j) &
 -g_hatavg(i,k,j))*0.25*tmpzx
 Tmpv1 =(hatavg(i,k+1,j) -hatavg(i,k,j))*0.25*tmpzx

 g_Tmpv2 =Tmpv1*(g_rdzw(i,k,j) +g_rdzw(i,k,j-1) +g_rdzw(i-1,k,j-1) &
 +g_rdzw(i-1,k,j)) +g_Tmpv1*(rdzw(i,k,j) +rdzw(i,k,j-1) +rdzw(i-1,k,j-1) +rdzw(i-1,k,j))
 Tmpv2 =Tmpv1*(rdzw(i,k,j) +rdzw(i,k,j-1) +rdzw(i-1,k,j-1) +rdzw(i-1,k,j))

 g_tmp1(i,k,j) =g_Tmpv2
 tmp1(i,k,j) =Tmpv2

 ENDDO
 ENDDO
 ENDDO

!LPB[42]
 IF( config_flags%sfs_opt .GT. 0 ) THEN

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =mm(i,j)*(rdx*(g_hat(i,k,j) -g_hat(i-1,k,j)) -g_tmp1(i,k,j)) &
 +g_mm(i,j)*(rdx*(hat(i,k,j) -hat(i-1,k,j)) -tmp1(i,k,j)) 
 Tmpv1 =mm(i,j)*(rdx*(hat(i,k,j) -hat(i-1,k,j)) -tmp1(i,k,j))

 g_nba_rij(i,k,j,P_r12) =g_defor12(i,k,j) -g_Tmpv1
 nba_rij(i,k,j,P_r12) =defor12(i,k,j) -Tmpv1

 g_Tmpv1 =mm(i,j)*(rdx*(g_hat(i,k,j) -g_hat(i-1,k,j)) -g_tmp1(i,k,j)) &
 +g_mm(i,j)*(rdx*(hat(i,k,j) -hat(i-1,k,j)) -tmp1(i,k,j)) 
 Tmpv1 =mm(i,j)*(rdx*(hat(i,k,j) -hat(i-1,k,j)) -tmp1(i,k,j))

 g_defor12(i,k,j) =g_defor12(i,k,j) +g_Tmpv1
 defor12(i,k,j) =defor12(i,k,j) +Tmpv1

 ENDDO
 ENDDO
 ENDDO

 IF( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1 ) THEN

 DO j =jts,jte
 DO k =kts,kte

 g_defor12(ids,k,j) =g_defor12(ids+1,k,j)
 defor12(ids,k,j) =defor12(ids+1,k,j)

 g_nba_rij(ids,k,j,P_r12) =g_nba_rij(ids+1,k,j,P_r12)
 nba_rij(ids,k,j,P_r12) =nba_rij(ids+1,k,j,P_r12)

 ENDDO
 ENDDO
 END IF

 IF( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN

 DO k =kts,kte
 DO i =its,ite

 g_defor12(i,k,jds) =g_defor12(i,k,jds+1)
 defor12(i,k,jds) =defor12(i,k,jds+1)

 g_nba_rij(i,k,jds,P_r12) =g_nba_rij(i,k,jds+1,P_r12)
 nba_rij(i,k,jds,P_r12) =nba_rij(i,k,jds+1,P_r12)

 ENDDO
 ENDDO
 END IF

 IF( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN

 DO j =jts,jte
 DO k =kts,kte

 g_defor12(ide,k,j) =g_defor12(ide-1,k,j)
 defor12(ide,k,j) =defor12(ide-1,k,j)

 g_nba_rij(ide,k,j,P_r12) =g_nba_rij(ide-1,k,j,P_r12)
 nba_rij(ide,k,j,P_r12) =nba_rij(ide-1,k,j,P_r12)

 ENDDO
 ENDDO
 END IF

 IF( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN

 DO k =kts,kte
 DO i =its,ite

 g_defor12(i,k,jde) =g_defor12(i,k,jde-1)
 defor12(i,k,jde) =defor12(i,k,jde-1)

 g_nba_rij(i,k,jde,P_r12) =g_nba_rij(i,k,jde-1,P_r12)
 nba_rij(i,k,jde,P_r12) =nba_rij(i,k,jde-1,P_r12)

 ENDDO
 ENDDO
 END IF

 ELSE

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =mm(i,j)*(rdx*(g_hat(i,k,j) -g_hat(i-1,k,j)) -g_tmp1(i,k,j)) &
 +g_mm(i,j)*(rdx*(hat(i,k,j) -hat(i-1,k,j)) -tmp1(i,k,j)) 
 Tmpv1 =mm(i,j)*(rdx*(hat(i,k,j) -hat(i-1,k,j)) -tmp1(i,k,j))

 g_defor12(i,k,j) =g_defor12(i,k,j) +g_Tmpv1
 defor12(i,k,j) =defor12(i,k,j) +Tmpv1

 ENDDO
 ENDDO
 ENDDO

 IF( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1 ) THEN

 DO j =jts,jte
 DO k =kts,kte

 g_defor12(ids,k,j) =g_defor12(ids+1,k,j)
 defor12(ids,k,j) =defor12(ids+1,k,j)

 ENDDO
 ENDDO
 END IF

 IF( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN

 DO k =kts,kte
 DO i =its,ite

 g_defor12(i,k,jds) =g_defor12(i,k,jds+1)
 defor12(i,k,jds) =defor12(i,k,jds+1)

 ENDDO
 ENDDO
 END IF

 IF( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN

 DO j =jts,jte
 DO k =kts,kte

 g_defor12(ide,k,j) =g_defor12(ide-1,k,j)
 defor12(ide,k,j) =defor12(ide-1,k,j)

 ENDDO
 ENDDO
 END IF

 IF( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN

 DO k =kts,kte
 DO i =its,ite

 g_defor12(i,k,jde) =g_defor12(i,k,jde-1)
 defor12(i,k,jde) =defor12(i,k,jde-1)

 ENDDO
 ENDDO
 END IF

 ENDIF

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
         config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
         config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide)

 IF( config_flags%periodic_y ) j_end =min(jte,jde)

 DO j =jts,jte
 DO i =its,ite

 g_mm(i,j) =0.0
 mm(i,j) =msfux(i,j) *msfuy(i,j)

 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,kte
 DO i =i_start,i_end

 g_hat(i,k,j) =g_w(i,k,j)/msfty(i,j)
 hat(i,k,j) =w(i,k,j)/msfty(i,j)

 ENDDO
 ENDDO
 ENDDO

 i =i_start-1

 DO j =j_start,min(jte,jde-1)
 DO k =kts,kte

 g_hat(i,k,j) =g_w(i,k,j)/msfty(i,j)
 hat(i,k,j) =w(i,k,j)/msfty(i,j)

 ENDDO
 ENDDO

 j =j_start-1

 DO k =kts,kte
 DO i =i_start,min(ite,ide-1)

 g_hat(i,k,j) =g_w(i,k,j)/msfty(i,j)
 hat(i,k,j) =w(i,k,j)/msfty(i,j)

 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_hatavg(i,k,j) =0.25*(g_hat(i,k,j) +g_hat(i,k+1,j) +g_hat(i-1,k,j) &
 +g_hat(i-1,k+1,j))
 hatavg(i,k,j) =0.25*(hat(i,k,j) +hat(i,k+1,j) +hat(i-1,k,j) +hat(i-1,k+1,j))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =(hatavg(i,k,j) -hatavg(i,k-1,j))*g_zx(i,k,j) +(g_hatavg(i,k,j) &
 -g_hatavg(i,k-1,j))*zx(i,k,j)
 Tmpv1 =(hatavg(i,k,j) -hatavg(i,k-1,j))*zx(i,k,j)

 g_Tmpv2 =Tmpv1*0.5*(g_rdz(i,k,j) +g_rdz(i-1,k,j)) +g_Tmpv1*0.5*(rdz(i,k, &
 j) +rdz(i-1,k,j))
 Tmpv2 =Tmpv1*0.5*(rdz(i,k,j) +rdz(i-1,k,j))

 g_tmp1(i,k,j) =g_Tmpv2
 tmp1(i,k,j) =Tmpv2

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =mm(i,j)*(rdx*(g_hat(i,k,j) -g_hat(i-1,k,j)) -g_tmp1(i,k,j)) &
 +g_mm(i,j)*(rdx*(hat(i,k,j) -hat(i-1,k,j)) -tmp1(i,k,j)) 
 Tmpv1 =mm(i,j)*(rdx*(hat(i,k,j) -hat(i-1,k,j)) -tmp1(i,k,j))

 g_defor13(i,k,j) =g_Tmpv1
 defor13(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_defor13(i,kts,j) =0.0
 defor13(i,kts,j) =0.0

 g_defor13(i,ktf+1,j) =0.0
 defor13(i,ktf+1,j) =0.0

 ENDDO
 ENDDO

 IF( config_flags%mix_full_fields ) THEN

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =(u(i,k,j) -u(i,k-1,j))*0.5*(g_rdz(i,k,j) +g_rdz(i-1,k,j)) &
 +(g_u(i,k,j) -g_u(i,k-1,j))*0.5*(rdz(i,k,j) +rdz(i-1,k,j))
 Tmpv1 =(u(i,k,j) -u(i,k-1,j))*0.5*(rdz(i,k,j) +rdz(i-1,k,j))

 g_tmp1(i,k,j) =g_Tmpv1
 tmp1(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO
 ELSE

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =(u(i,k,j) -u_base(k) -u(i,k-1,j) +u_base(k-1))*0.5*(g_rdz(i,k,j) &
 +g_rdz(i-1,k,j)) +(g_u(i,k,j) -g_u(i,k-1,j))*0.5*(rdz(i,k,j) +rdz(i-1,k,j))
 Tmpv1 =(u(i,k,j) -u_base(k) -u(i,k-1,j) +u_base(k-1))*0.5*(rdz(i,k,j) +rdz(i-1,k,j))

 g_tmp1(i,k,j) =g_Tmpv1
 tmp1(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO
 END IF

!LPB[66]

 IF( config_flags%sfs_opt .GT. 0 ) THEN

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_nba_rij(i,k,j,P_r13) =g_tmp1(i,k,j) -g_defor13(i,k,j)
 nba_rij(i,k,j,P_r13) =tmp1(i,k,j) -defor13(i,k,j)

 g_defor13(i,k,j) =g_defor13(i,k,j) +g_tmp1(i,k,j)
 defor13(i,k,j) =defor13(i,k,j) +tmp1(i,k,j)

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_nba_rij(i,kts,j,P_r13) =0.0
 nba_rij(i,kts,j,P_r13) =0.0

 g_nba_rij(i,ktf+1,j,P_r13) =0.0
 nba_rij(i,ktf+1,j,P_r13) =0.0

 ENDDO
 ENDDO

 ELSE

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_defor13(i,k,j) =g_defor13(i,k,j) +g_tmp1(i,k,j)
 defor13(i,k,j) =defor13(i,k,j) +tmp1(i,k,j)

 ENDDO
 ENDDO
 ENDDO

 ENDIF

!LPB[67]

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
         config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
         config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%periodic_y ) j_end =min(jte,jde)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide-1)

 DO j =jts,jte
 DO i =its,ite

 g_mm(i,j) =0.0
 mm(i,j) =msfvx(i,j) *msfvy(i,j)

 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,kte
 DO i =i_start,i_end

 g_hat(i,k,j) =g_w(i,k,j)/msftx(i,j)
 hat(i,k,j) =w(i,k,j)/msftx(i,j)

 ENDDO
 ENDDO
 ENDDO

 i =i_start-1

 DO j =j_start,min(jte,jde-1)
 DO k =kts,kte

 g_hat(i,k,j) =g_w(i,k,j)/msftx(i,j)
 hat(i,k,j) =w(i,k,j)/msftx(i,j)

 ENDDO
 ENDDO

 j =j_start-1

 DO k =kts,kte
 DO i =i_start,min(ite,ide-1)

 g_hat(i,k,j) =g_w(i,k,j)/msftx(i,j)
 hat(i,k,j) =w(i,k,j)/msftx(i,j)

 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_hatavg(i,k,j) =0.25*(g_hat(i,k,j) +g_hat(i,k+1,j) +g_hat(i,k,j-1) &
 +g_hat(i,k+1,j-1))
 hatavg(i,k,j) =0.25*(hat(i,k,j) +hat(i,k+1,j) +hat(i,k,j-1) +hat(i,k+1,j-1))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =(hatavg(i,k,j) -hatavg(i,k-1,j))*g_zy(i,k,j) +(g_hatavg(i,k,j) &
 -g_hatavg(i,k-1,j))*zy(i,k,j)
 Tmpv1 =(hatavg(i,k,j) -hatavg(i,k-1,j))*zy(i,k,j)

 g_Tmpv2 =Tmpv1*0.5*(g_rdz(i,k,j) +g_rdz(i,k,j-1)) +g_Tmpv1*0.5*(rdz(i,k, &
 j) +rdz(i,k,j-1))
 Tmpv2 =Tmpv1*0.5*(rdz(i,k,j) +rdz(i,k,j-1))

 g_tmp1(i,k,j) =g_Tmpv2
 tmp1(i,k,j) =Tmpv2

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =mm(i,j)*(rdy*(g_hat(i,k,j) -g_hat(i,k,j-1)) -g_tmp1(i,k,j)) &
 +g_mm(i,j)*(rdy*(hat(i,k,j) -hat(i,k,j-1)) -tmp1(i,k,j)) 
 Tmpv1 =mm(i,j)*(rdy*(hat(i,k,j) -hat(i,k,j-1)) -tmp1(i,k,j))

 g_defor23(i,k,j) =g_Tmpv1
 defor23(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_defor23(i,kts,j) =0.0
 defor23(i,kts,j) =0.0

 g_defor23(i,ktf+1,j) =0.0
 defor23(i,ktf+1,j) =0.0

 ENDDO
 ENDDO

 IF( config_flags%mix_full_fields ) THEN

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =(v(i,k,j) -v(i,k-1,j))*0.5*(g_rdz(i,k,j) +g_rdz(i,k,j-1)) &
 +(g_v(i,k,j) -g_v(i,k-1,j))*0.5*(rdz(i,k,j) +rdz(i,k,j-1))
 Tmpv1 =(v(i,k,j) -v(i,k-1,j))*0.5*(rdz(i,k,j) +rdz(i,k,j-1))

 g_tmp1(i,k,j) =g_Tmpv1
 tmp1(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO
 ELSE

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =(v(i,k,j) -v_base(k) -v(i,k-1,j) +v_base(k-1))*0.5*(g_rdz(i,k,j) &
 +g_rdz(i,k,j-1)) +(g_v(i,k,j) -g_v(i,k-1,j))*0.5*(rdz(i,k,j) +rdz(i,k,j-1))
 Tmpv1 =(v(i,k,j) -v_base(k) -v(i,k-1,j) +v_base(k-1))*0.5*(rdz(i,k,j) +rdz(i,k,j-1))

 g_tmp1(i,k,j) =g_Tmpv1
 tmp1(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO
 END IF

 IF( config_flags%sfs_opt .GT. 0 ) THEN

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_nba_rij(i,k,j,P_r23) =g_tmp1(i,k,j) -g_defor23(i,k,j)
 nba_rij(i,k,j,P_r23) =tmp1(i,k,j) -defor23(i,k,j)

 g_defor23(i,k,j) =g_defor23(i,k,j) +g_tmp1(i,k,j)
 defor23(i,k,j) =defor23(i,k,j) +tmp1(i,k,j)

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_nba_rij(i,kts,j,P_r23) =0.0
 nba_rij(i,kts,j,P_r23) =0.0

 g_nba_rij(i,ktf+1,j,P_r23) =0.0
 nba_rij(i,ktf+1,j,P_r23) =0.0

 ENDDO
 ENDDO

 IF( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1) THEN

 DO j =jts,jte
 DO k =kts,kte

 g_defor13(ids,k,j) =g_defor13(ids+1,k,j)
 defor13(ids,k,j) =defor13(ids+1,k,j)

 g_defor23(ids,k,j) =g_defor23(ids+1,k,j)
 defor23(ids,k,j) =defor23(ids+1,k,j)

 g_nba_rij(ids,k,j,P_r13) =g_nba_rij(ids+1,k,j,P_r13)
 nba_rij(ids,k,j,P_r13) =nba_rij(ids+1,k,j,P_r13)

 g_nba_rij(ids,k,j,P_r23) =g_nba_rij(ids+1,k,j,P_r23)
 nba_rij(ids,k,j,P_r23) =nba_rij(ids+1,k,j,P_r23)

 ENDDO
 ENDDO
 END IF

 IF( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN

 DO k =kts,kte
 DO i =its,ite

 g_defor13(i,k,jds) =g_defor13(i,k,jds+1)
 defor13(i,k,jds) =defor13(i,k,jds+1)

 g_defor23(i,k,jds) =g_defor23(i,k,jds+1)
 defor23(i,k,jds) =defor23(i,k,jds+1)

 g_nba_rij(i,k,jds,P_r13) =g_nba_rij(i,k,jds+1,P_r13)
 nba_rij(i,k,jds,P_r13) =nba_rij(i,k,jds+1,P_r13)

 g_nba_rij(i,k,jds,P_r23) =g_nba_rij(i,k,jds+1,P_r23)
 nba_rij(i,k,jds,P_r23) =nba_rij(i,k,jds+1,P_r23)

 ENDDO
 ENDDO
 END IF

 IF( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN

 DO j =jts,jte
 DO k =kts,kte

 g_defor13(ide,k,j) =g_defor13(ide-1,k,j)
 defor13(ide,k,j) =defor13(ide-1,k,j)

 g_defor23(ide,k,j) =g_defor23(ide-1,k,j)
 defor23(ide,k,j) =defor23(ide-1,k,j)

 g_nba_rij(ide,k,j,P_r13) =g_nba_rij(ide-1,k,j,P_r13)
 nba_rij(ide,k,j,P_r13) =nba_rij(ide-1,k,j,P_r13)

 g_nba_rij(ide,k,j,P_r23) =g_nba_rij(ide-1,k,j,P_r23)
 nba_rij(ide,k,j,P_r23) =nba_rij(ide-1,k,j,P_r23)

 ENDDO
 ENDDO
 END IF

 IF( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN

 DO k =kts,kte
 DO i =its,ite

 g_defor13(i,k,jde) =g_defor13(i,k,jde-1)
 defor13(i,k,jde) =defor13(i,k,jde-1)

 g_defor23(i,k,jde) =g_defor23(i,k,jde-1)
 defor23(i,k,jde) =defor23(i,k,jde-1)

 g_nba_rij(i,k,jde,P_r13) =g_nba_rij(i,k,jde-1,P_r13)
 nba_rij(i,k,jde,P_r13) =nba_rij(i,k,jde-1,P_r13)

 g_nba_rij(i,k,jde,P_r23) =g_nba_rij(i,k,jde-1,P_r23)
 nba_rij(i,k,jde,P_r23) =nba_rij(i,k,jde-1,P_r23)

 ENDDO
 ENDDO
 END IF

 ELSE

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_defor23(i,k,j) =g_defor23(i,k,j) +g_tmp1(i,k,j)
 defor23(i,k,j) =defor23(i,k,j) +tmp1(i,k,j)

 ENDDO
 ENDDO
 ENDDO

 IF( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1) THEN

 DO j =jts,jte
 DO k =kts,kte

 g_defor13(ids,k,j) =g_defor13(ids+1,k,j)
 defor13(ids,k,j) =defor13(ids+1,k,j)

 g_defor23(ids,k,j) =g_defor23(ids+1,k,j)
 defor23(ids,k,j) =defor23(ids+1,k,j)

 ENDDO
 ENDDO
 END IF

 IF( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN

 DO k =kts,kte
 DO i =its,ite

 g_defor13(i,k,jds) =g_defor13(i,k,jds+1)
 defor13(i,k,jds) =defor13(i,k,jds+1)

 g_defor23(i,k,jds) =g_defor23(i,k,jds+1)
 defor23(i,k,jds) =defor23(i,k,jds+1)

 ENDDO
 ENDDO
 END IF

 IF( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN

 DO j =jts,jte
 DO k =kts,kte

 g_defor13(ide,k,j) =g_defor13(ide-1,k,j)
 defor13(ide,k,j) =defor13(ide-1,k,j)

 g_defor23(ide,k,j) =g_defor23(ide-1,k,j)
 defor23(ide,k,j) =defor23(ide-1,k,j)

 ENDDO
 ENDDO
 END IF

 IF( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN

 DO k =kts,kte
 DO i =its,ite

 g_defor13(i,k,jde) =g_defor13(i,k,jde-1)
 defor13(i,k,jde) =defor13(i,k,jde-1)

 g_defor23(i,k,jde) =g_defor23(i,k,jde-1)
 defor23(i,k,jde) =defor23(i,k,jde-1)

 ENDDO
 ENDDO
 END IF

 ENDIF

 END SUBROUTINE g_cal_deform_and_div

 SUBROUTINE g_calculate_km_kh(config_flags,dt,dampcoef,zdamp,damp_opt,xkmh, &
 g_xkmh,xkmv,g_xkmv,xkhh,g_xkhh,xkhv,g_xkhv,BN2,g_BN2,khdif,kvdif,div, &
 g_div,defor11,g_defor11,defor22,g_defor22,defor33,g_defor33,defor12, &
 g_defor12,defor13,g_defor13,defor23,g_defor23,tke,g_tke,p8w,g_p8w,t8w, &
 g_t8w,theta,g_theta,t,g_t,p,g_p,moist,g_moist,dn,dnw,dx,dy,rdz, &
 g_rdz,rdzw,g_rdzw,isotropic,n_moist,cf1,cf2,cf3,warm_rain,mix_upper_bound, &
 msftx,msfty,zx,g_zx,zy,g_zy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: n_moist,damp_opt,isotropic,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
 kme,its,ite,jts,jte,kts,kte
 LOGICAL :: warm_rain
 REAL :: dx,dy,zdamp,dt,dampcoef,cf1,cf2,cf3,khdif,kvdif
 REAL,DIMENSION(kms:kme) :: dnw,dn
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist,g_moist
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkmv,g_xkmv,xkmh,g_xkmh,xkhv, &
 g_xkhv,xkhh,g_xkhh,BN2,g_BN2
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor11,g_defor11,defor22,g_defor22, &
 defor33,g_defor33,defor12,g_defor12,defor13,g_defor13,defor23,g_defor23, &
 div,g_div,rdz,g_rdz,rdzw,g_rdzw,p8w,g_p8w,t8w,g_t8w,theta,g_theta, &
 t,g_t,p,g_p,zx,g_zx,zy,g_zy
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tke,g_tke
 REAL :: mix_upper_bound
 REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
 INTEGER :: i_start,i_end,j_start,j_end,ktf,i,j,k!,km_opt

 ktf =min(kte,kde-1)

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 CALL g_calculate_N2(config_flags,BN2,g_BN2,moist,g_moist,theta,g_theta,t, &
 g_t,p,g_p,p8w,g_p8w,t8w,g_t8w,dnw,dn,rdz,g_rdz,rdzw,g_rdzw,n_moist, &
 cf1,cf2,cf3,warm_rain,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts, &
 jte,kts,kte)

!ALL THE FOLLOWING STRUNCTURE ARE REVISED BY WALLS
!ALL THE FOLLOWING STRUNCTURE ARE REVISED BY WALLS

!km_opt =config_flags%km_opt
!km_opt =3
!PRINT*, 'km_opt =', km_opt

!Select a scheme for calculating diffusion coefficients.
 km_coef: SELECT CASE( config_flags%km_opt )
!km_coef: SELECT CASE( km_opt )

 CASE (1)

 CALL g_isotropic_km(config_flags,xkmh,g_xkmh,xkmv,g_xkmv,xkhh,g_xkhh, &
 xkhv,g_xkhv,khdif,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite, &
 jts,jte,kts,kte)

 CASE (2)

 CALL g_tke_km(config_flags,xkmh,g_xkmh,xkmv,g_xkmv,xkhh,g_xkhh,xkhv, &
 g_xkhv,BN2,g_BN2,tke,g_tke,p8w,g_p8w,t8w,g_t8w,theta,g_theta,rdz, &
 g_rdz,rdzw,g_rdzw,dx,dy,dt,isotropic,mix_upper_bound,msftx,msfty,ids,ide,jds, &
 jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 CASE (3)

 CALL g_smag_km(config_flags,xkmh,g_xkmh,xkmv,g_xkmv,xkhh,g_xkhh,xkhv, &
 g_xkhv,BN2,g_BN2,div,g_div,defor11,g_defor11,defor22,g_defor22, &
 defor33,g_defor33,defor12,g_defor12,defor13,g_defor13,defor23,g_defor23, &
 rdzw,g_rdzw,dx,dy,dt,isotropic,mix_upper_bound,msftx,msfty,ids,ide,jds,jde,kds, &
 kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 CASE (4)

 CALL g_smag2d_km(config_flags,xkmh,g_xkmh,xkmv,g_xkmv,xkhh,g_xkhh,xkhv, &
 g_xkhv,defor11,g_defor11,defor22,g_defor22,defor12,g_defor12,rdzw, &
 g_rdzw,dx,dy,msftx,msfty,zx,g_zx,zy,g_zy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite, &
 jts,jte,kts,kte)

 CASE DEFAULT

!REVISED BY WALLS
!CALL g_wrf_error_fatal('Please choose diffusion coefficient scheme')
 CALL wrf_error_fatal( 'Please choose diffusion coefficient scheme' )

 END SELECT km_coef

 IF( damp_opt .eq. 1 ) THEN

 CALL g_cal_dampkm(config_flags,xkmh,g_xkmh,xkhh,g_xkhh,xkmv,g_xkmv,xkhv, &
 g_xkhv,dx,dy,dt,dampcoef,rdz,g_rdz,rdzw,g_rdzw,zdamp,msftx,msfty,ids,ide, &
 jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 END IF

 END SUBROUTINE g_calculate_km_kh

 SUBROUTINE g_cal_dampkm(config_flags,xkmh,g_xkmh,xkhh,g_xkhh,xkmv,g_xkmv, &
 xkhv,g_xkhv,dx,dy,dt,dampcoef,rdz,g_rdz,rdzw,g_rdzw,zdamp,msftx,msfty,ids, &
 ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4,Tmpv5,g_Tmpv5
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 REAL :: zdamp,dx,dy,dt,dampcoef
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkmh,g_xkmh,xkhh,g_xkhh,xkmv, &
 g_xkmv,xkhv,g_xkhv
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rdz,g_rdz,rdzw,g_rdzw
 REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
 INTEGER :: i_start,i_end,j_start,j_end,ktf,ktfm1,i,j,k
 REAL :: kmmax,kmmvmax,g_kmmvmax,degrad90,dz,g_dz,tmp,g_tmp
 REAL :: ds
 REAL,DIMENSION(its:ite) :: deltaz,g_deltaz
 REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: dampk,g_dampk,dampkv,g_dampkv

 ktf =min(kte,kde-1)

 ktfm1 =ktf-1

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 IF(config_flags%specified .OR. config_flags%nested) THEN

 i_start =max(i_start,ids +config_flags%spec_bdy_width -1)

 i_end =min(i_end,ide -config_flags%spec_bdy_width)

 j_start =max(j_start,jds +config_flags%spec_bdy_width -1)

 j_end =min(j_end,jde -config_flags%spec_bdy_width)
 ENDIF

 kmmax =dx *dx/dt

 degrad90 =DEGRAD *90.

 DO j =j_start,j_end

 k =ktf

 DO i =i_start,i_end

 ds =min(dx/msftx(i,j),dy/msfty(i,j))

 kmmax =ds *ds/dt

 g_dz =-1.*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))
 dz =1./rdzw(i,k,j)

 g_deltaz(i) =0.5*g_dz
 deltaz(i) =0.5*dz

 g_Tmpv1 =2.0*dz*g_dz
 Tmpv1 =dz*dz

 g_kmmvmax =g_Tmpv1/dt
 kmmvmax =Tmpv1/dt

 g_tmp =(g_deltaz(i)/zdamp +0.0 -(g_deltaz(i)/zdamp -0.0)*sign(1.0, deltaz(i) &
/zdamp -(1.)))*0.5
 tmp =min(deltaz(i)/zdamp,1.)

 g_Tmpv1 =2.0*cos(degrad90*tmp)*(-degrad90*g_tmp*sin(degrad90*tmp))
 Tmpv1 =cos(degrad90*tmp)*cos(degrad90*tmp)

 g_dampk(i,k,j) =g_Tmpv1*kmmax*dampcoef
 dampk(i,k,j) =Tmpv1*kmmax*dampcoef

 g_Tmpv1 =2.0*cos(degrad90*tmp)*(-degrad90*g_tmp*sin(degrad90*tmp))
 Tmpv1 =cos(degrad90*tmp)*cos(degrad90*tmp)

 g_Tmpv2 =Tmpv1*g_kmmvmax +g_Tmpv1*kmmvmax
 Tmpv2 =Tmpv1*kmmvmax

 g_dampkv(i,k,j) =g_Tmpv2*dampcoef
 dampkv(i,k,j) =Tmpv2*dampcoef

 g_dampkv(i,k,j) =(g_dampkv(i,k,j) +g_dampk(i,k,j) -(g_dampkv(i,k,j) &
 -g_dampk(i,k,j))*sign(1.0, dampkv(i,k,j) -(dampk(i,k,j))))*0.5
 dampkv(i,k,j) =min(dampkv(i,k,j),dampk(i,k,j))

 ENDDO

 DO k =ktfm1,kts,-1
 DO i =i_start,i_end

 ds =min(dx/msftx(i,j),dy/msfty(i,j))

 kmmax =ds *ds/dt

 g_dz =-1.*g_rdz(i,k,j)/(rdz(i,k,j)*rdz(i,k,j))
 dz =1./rdz(i,k,j)

 g_deltaz(i) =g_deltaz(i) +g_dz
 deltaz(i) =deltaz(i) +dz

 g_dz =-1.*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))
 dz =1./rdzw(i,k,j)

 g_Tmpv1 =2.0*dz*g_dz
 Tmpv1 =dz*dz

 g_kmmvmax =g_Tmpv1/dt
 kmmvmax =Tmpv1/dt

 g_tmp =(g_deltaz(i)/zdamp +0.0 -(g_deltaz(i)/zdamp -0.0)*sign(1.0, deltaz(i) &
/zdamp -(1.)))*0.5
 tmp =min(deltaz(i)/zdamp,1.)

 g_Tmpv1 =2.0*cos(degrad90*tmp)*(-degrad90*g_tmp*sin(degrad90*tmp))
 Tmpv1 =cos(degrad90*tmp)*cos(degrad90*tmp)

 g_dampk(i,k,j) =g_Tmpv1*kmmax*dampcoef
 dampk(i,k,j) =Tmpv1*kmmax*dampcoef

 g_Tmpv1 =2.0*cos(degrad90*tmp)*(-degrad90*g_tmp*sin(degrad90*tmp))
 Tmpv1 =cos(degrad90*tmp)*cos(degrad90*tmp)

 g_Tmpv2 =Tmpv1*g_kmmvmax +g_Tmpv1*kmmvmax
 Tmpv2 =Tmpv1*kmmvmax

 g_dampkv(i,k,j) =g_Tmpv2*dampcoef
 dampkv(i,k,j) =Tmpv2*dampcoef

 g_dampkv(i,k,j) =(g_dampkv(i,k,j) +g_dampk(i,k,j) -(g_dampkv(i,k,j) &
 -g_dampk(i,k,j))*sign(1.0, dampkv(i,k,j) -(dampk(i,k,j))))*0.5
 dampkv(i,k,j) =min(dampkv(i,k,j),dampk(i,k,j))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_xkmh(i,k,j) =(g_xkmh(i,k,j) +g_dampk(i,k,j) +(g_xkmh(i,k,j) &
 -g_dampk(i,k,j))*sign(1.0, xkmh(i,k,j) -(dampk(i,k,j))))*0.5
 xkmh(i,k,j) =max(xkmh(i,k,j),dampk(i,k,j))

 g_xkhh(i,k,j) =(g_xkhh(i,k,j) +g_dampk(i,k,j) +(g_xkhh(i,k,j) &
 -g_dampk(i,k,j))*sign(1.0, xkhh(i,k,j) -(dampk(i,k,j))))*0.5
 xkhh(i,k,j) =max(xkhh(i,k,j),dampk(i,k,j))

 g_xkmv(i,k,j) =(g_xkmv(i,k,j) +g_dampkv(i,k,j) +(g_xkmv(i,k,j) &
 -g_dampkv(i,k,j))*sign(1.0, xkmv(i,k,j) -(dampkv(i,k,j))))*0.5
 xkmv(i,k,j) =max(xkmv(i,k,j),dampkv(i,k,j))

 g_xkhv(i,k,j) =(g_xkhv(i,k,j) +g_dampkv(i,k,j) +(g_xkhv(i,k,j) &
 -g_dampkv(i,k,j))*sign(1.0, xkhv(i,k,j) -(dampkv(i,k,j))))*0.5
 xkhv(i,k,j) =max(xkhv(i,k,j),dampkv(i,k,j))

 ENDDO
 ENDDO
 ENDDO

 END SUBROUTINE g_cal_dampkm

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of calculate_n2 in forward (tangent) mode:
!   variations   of useful results: bn2
!   with respect to varying inputs: p t t8w bn2 theta rdzw rdz
!                moist p8w
!   RW status of diff variables: p:in t:in t8w:in bn2:in-out theta:in
!                rdzw:in rdz:in moist:in p8w:in
SUBROUTINE G_CALCULATE_N2(config_flags, bn2, bn2d, moist, moistd, theta&
&  , thetad, t, td, p, pd, p8w, p8wd, t8w, t8wd, dnw, dn, rdz, rdzd, rdzw&
&  , rdzwd, n_moist, cf1, cf2, cf3, warm_rain, ids, ide, jds, jde, kds, &
&  kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
  IMPLICIT NONE
! end of MARTA/WCS change
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
  INTEGER, INTENT(IN) :: n_moist, ids, ide, jds, jde, kds, kde, ims, ime&
&  , jms, jme, kms, kme, its, ite, jts, jte, kts, kte
  LOGICAL, INTENT(IN) :: warm_rain
  REAL, INTENT(IN) :: cf1, cf2, cf3
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: bn2
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: bn2d
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rdz, rdzw, &
&  theta, t, p, p8w, t8w
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rdzd, rdzwd&
&  , thetad, td, pd, p8wd, t8wd
  REAL, DIMENSION(kms:kme), INTENT(IN) :: dnw, dn
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), INTENT(INOUT) :: &
&  moist
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), INTENT(INOUT) :: &
&  moistd
! Local variables.
  INTEGER :: i, j, k, ktf, ispe, ktes1, ktes2, i_start, i_end, j_start, &
&  j_end
  REAL :: coefa, thetaep1, thetaem1, qc_cr, es, tc, qlpqi, qsw, qsi, &
&  tmpdz, xlvqv, thetaesfc, thetasfc, qvtop, qvsfc, thetatop, thetaetop
  REAL :: coefad, thetaep1d, thetaem1d, esd, tcd, tmpdzd, xlvqvd, &
&  thetaesfcd, thetasfcd, qvsfcd
  REAL, DIMENSION(its:ite, jts:jte) :: tmp1sfc, tmp1top
  REAL, DIMENSION(its:ite, jts:jte) :: tmp1sfcd
  REAL, DIMENSION(its:ite, kts:kte, jts:jte) :: tmp1, qvs, qctmp
  REAL, DIMENSION(its:ite, kts:kte, jts:jte) :: tmp1d, qvsd
  REAL :: arg1
  REAL :: arg1d
  REAL :: pwx1
  REAL :: pwx1d
  REAL :: pwy1
  REAL :: pwr1
  REAL :: pwr1d
! End declarations.
!-----------------------------------------------------------------------
! in Kg/Kg
  qc_cr = 0.00001
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  ktes1 = kte - 1
  ktes2 = kte - 2
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
  IF ((config_flags%open_xs .OR. config_flags%specified) .OR. &
&      config_flags%nested) THEN
    IF (ids + 1 .LT. its) THEN
      i_start = its
    ELSE
      i_start = ids + 1
    END IF
  END IF
  IF ((config_flags%open_xe .OR. config_flags%specified) .OR. &
&      config_flags%nested) THEN
    IF (ide - 2 .GT. ite) THEN
      i_end = ite
    ELSE
      i_end = ide - 2
    END IF
  END IF
  IF ((config_flags%open_ys .OR. config_flags%specified) .OR. &
&      config_flags%nested) THEN
    IF (jds + 1 .LT. jts) THEN
      j_start = jts
    ELSE
      j_start = jds + 1
    END IF
  END IF
  IF ((config_flags%open_ye .OR. config_flags%specified) .OR. &
&      config_flags%nested) THEN
    IF (jde - 2 .GT. jte) THEN
      j_end = jte
    ELSE
      j_end = jde - 2
    END IF
  END IF
  IF (config_flags%periodic_x) i_start = its
  IF (config_flags%periodic_x) THEN
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
  END IF
  IF (p_qc .GT. param_first_scalar) THEN
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
          qctmp(i, k, j) = moist(i, k, j, p_qc)
        END DO
      END DO
    END DO
  ELSE
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
          qctmp(i, k, j) = 0.0
        END DO
      END DO
    END DO
  END IF
  DO j=jts,jte
    DO k=kts,kte
      DO i=its,ite
        tmp1d(i, k, j) = 0.0
        tmp1(i, k, j) = 0.0
      END DO
    END DO
  END DO
  DO j=jts,jte
    DO i=its,ite
      tmp1sfcd(i, j) = 0.0
      tmp1sfc(i, j) = 0.0
      tmp1top(i, j) = 0.0
    END DO
  END DO
  tmp1d = 0.0
  tmp1sfcd = 0.0
  DO ispe=param_first_scalar,n_moist
    IF ((ispe .EQ. p_qv .OR. ispe .EQ. p_qc) .OR. ispe .EQ. p_qi) THEN
      DO j=j_start,j_end
        DO k=kts,ktf
          DO i=i_start,i_end
            tmp1d(i, k, j) = tmp1d(i, k, j) + moistd(i, k, j, ispe)
            tmp1(i, k, j) = tmp1(i, k, j) + moist(i, k, j, ispe)
          END DO
        END DO
      END DO
      DO j=j_start,j_end
        DO i=i_start,i_end
          tmp1sfcd(i, j) = tmp1sfcd(i, j) + cf1*moistd(i, 1, j, ispe) + &
&            cf2*moistd(i, 2, j, ispe) + cf3*moistd(i, 3, j, ispe)
          tmp1sfc(i, j) = tmp1sfc(i, j) + cf1*moist(i, 1, j, ispe) + cf2&
&            *moist(i, 2, j, ispe) + cf3*moist(i, 3, j, ispe)
          tmp1top(i, j) = tmp1top(i, j) + moist(i, ktes1, j, ispe) + (&
&            moist(i, ktes1, j, ispe)-moist(i, ktes2, j, ispe))*0.5*dnw(&
&            ktes1)/dn(ktes1)
        END DO
      END DO
    END IF
  END DO
  qvsd = 0.0
! Calculate saturation mixing ratio.
  DO j=j_start,j_end
    DO k=kts,ktf
      DO i=i_start,i_end
        tcd = td(i, k, j)
        tc = t(i, k, j) - svpt0
        arg1d = (svp2*tcd*(t(i, k, j)-svp3)-svp2*tc*td(i, k, j))/(t(i, k&
&          , j)-svp3)**2
        arg1 = svp2*tc/(t(i, k, j)-svp3)
        esd = 1000.0*svp1*arg1d*EXP(arg1)
        es = 1000.0*svp1*EXP(arg1)
        qvsd(i, k, j) = (ep_2*esd*(p(i, k, j)-es)-ep_2*es*(pd(i, k, j)-&
&          esd))/(p(i, k, j)-es)**2
        qvs(i, k, j) = ep_2*es/(p(i, k, j)-es)
      END DO
    END DO
  END DO
  DO j=j_start,j_end
    DO k=kts+1,ktf-1
      DO i=i_start,i_end
        tmpdzd = -(rdzd(i, k, j)/rdz(i, k, j)**2) - rdzd(i, k+1, j)/rdz(&
&          i, k+1, j)**2
        tmpdz = 1.0/rdz(i, k, j) + 1.0/rdz(i, k+1, j)
        IF (moist(i, k, j, p_qv) .GE. qvs(i, k, j) .OR. qctmp(i, k, j) &
&            .GE. qc_cr) THEN
          xlvqvd = xlv*moistd(i, k, j, p_qv)
          xlvqv = xlv*moist(i, k, j, p_qv)
          coefad = (((xlvqvd*t(i, k, j)/r_d-xlvqv*td(i, k, j)/r_d)*(1.0+&
&            xlv*xlvqv/cp/r_v/t(i, k, j)/t(i, k, j))/t(i, k, j)**2-(1.0+&
&            xlvqv/r_d/t(i, k, j))*((xlv*xlvqvd*t(i, k, j)/(cp*r_v)-xlv*&
&            xlvqv*td(i, k, j)/(cp*r_v))/t(i, k, j)-xlv*xlvqv*td(i, k, j)&
&            /(cp*r_v*t(i, k, j)))/t(i, k, j)**2)*theta(i, k, j)/(1.0+xlv&
&            *xlvqv/cp/r_v/t(i, k, j)/t(i, k, j))**2-(1.0+xlvqv/r_d/t(i, &
&            k, j))*thetad(i, k, j)/(1.0+xlv*xlvqv/cp/r_v/t(i, k, j)/t(i&
&            , k, j)))/theta(i, k, j)**2
          coefa = (1.0+xlvqv/r_d/t(i, k, j))/(1.0+xlv*xlvqv/cp/r_v/t(i, &
&            k, j)/t(i, k, j))/theta(i, k, j)
          thetaep1d = thetad(i, k+1, j)*(1.0+xlv*qvs(i, k+1, j)/cp/t(i, &
&            k+1, j)) + theta(i, k+1, j)*(xlv*qvsd(i, k+1, j)*t(i, k+1, j&
&            )/cp-xlv*qvs(i, k+1, j)*td(i, k+1, j)/cp)/t(i, k+1, j)**2
          thetaep1 = theta(i, k+1, j)*(1.0+xlv*qvs(i, k+1, j)/cp/t(i, k+&
&            1, j))
          thetaem1d = thetad(i, k-1, j)*(1.0+xlv*qvs(i, k-1, j)/cp/t(i, &
&            k-1, j)) + theta(i, k-1, j)*(xlv*qvsd(i, k-1, j)*t(i, k-1, j&
&            )/cp-xlv*qvs(i, k-1, j)*td(i, k-1, j)/cp)/t(i, k-1, j)**2
          thetaem1 = theta(i, k-1, j)*(1.0+xlv*qvs(i, k-1, j)/cp/t(i, k-&
&            1, j))
          bn2d(i, k, j) = g*(((coefad*(thetaep1-thetaem1)+coefa*(&
&            thetaep1d-thetaem1d))*tmpdz-coefa*(thetaep1-thetaem1)*tmpdzd&
&            )/tmpdz**2-((tmp1d(i, k+1, j)-tmp1d(i, k-1, j))*tmpdz-(tmp1(&
&            i, k+1, j)-tmp1(i, k-1, j))*tmpdzd)/tmpdz**2)
          bn2(i, k, j) = g*(coefa*(thetaep1-thetaem1)/tmpdz-(tmp1(i, k+1&
&            , j)-tmp1(i, k-1, j))/tmpdz)
        ELSE
          bn2d(i, k, j) = g*((((thetad(i, k+1, j)-thetad(i, k-1, j))*&
&            theta(i, k, j)-(theta(i, k+1, j)-theta(i, k-1, j))*thetad(i&
&            , k, j))*tmpdz/theta(i, k, j)**2-(theta(i, k+1, j)-theta(i, &
&            k-1, j))*tmpdzd/theta(i, k, j))/tmpdz**2+(1.61*(moistd(i, k+&
&            1, j, p_qv)-moistd(i, k-1, j, p_qv))*tmpdz-1.61*(moist(i, k+&
&            1, j, p_qv)-moist(i, k-1, j, p_qv))*tmpdzd)/tmpdz**2-((tmp1d&
&            (i, k+1, j)-tmp1d(i, k-1, j))*tmpdz-(tmp1(i, k+1, j)-tmp1(i&
&            , k-1, j))*tmpdzd)/tmpdz**2)
          bn2(i, k, j) = g*((theta(i, k+1, j)-theta(i, k-1, j))/theta(i&
&            , k, j)/tmpdz+1.61*(moist(i, k+1, j, p_qv)-moist(i, k-1, j, &
&            p_qv))/tmpdz-(tmp1(i, k+1, j)-tmp1(i, k-1, j))/tmpdz)
        END IF
      END DO
    END DO
  END DO
  k = kts
  DO j=j_start,j_end
    DO i=i_start,i_end
      tmpdzd = -(rdzd(i, k+1, j)/rdz(i, k+1, j)**2) - 0.5*rdzwd(i, k, j)&
&        /rdzw(i, k, j)**2
      tmpdz = 1.0/rdz(i, k+1, j) + 0.5/rdzw(i, k, j)
      pwx1d = p8wd(i, k, j)/p1000mb
      pwx1 = p8w(i, k, j)/p1000mb
      pwy1 = r_d/cp
      IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pwy1 .EQ. INT(pwy1))) &
&      THEN
        pwr1d = pwy1*pwx1**(pwy1-1)*pwx1d
      ELSE IF (pwx1 .EQ. 0.0 .AND. pwy1 .EQ. 1.0) THEN
        pwr1d = pwx1d
      ELSE
        pwr1d = 0.0
      END IF
      pwr1 = pwx1**pwy1
      thetasfcd = (t8wd(i, kts, j)*pwr1-t8w(i, kts, j)*pwr1d)/pwr1**2
      thetasfc = t8w(i, kts, j)/pwr1
      IF (moist(i, k, j, p_qv) .GE. qvs(i, k, j) .OR. qctmp(i, k, j) &
&          .GE. qc_cr) THEN
        qvsfcd = cf1*qvsd(i, 1, j) + cf2*qvsd(i, 2, j) + cf3*qvsd(i, 3, &
&          j)
        qvsfc = cf1*qvs(i, 1, j) + cf2*qvs(i, 2, j) + cf3*qvs(i, 3, j)
        xlvqvd = xlv*moistd(i, k, j, p_qv)
        xlvqv = xlv*moist(i, k, j, p_qv)
        coefad = (((xlvqvd*t(i, k, j)/r_d-xlvqv*td(i, k, j)/r_d)*(1.0+&
&          xlv*xlvqv/cp/r_v/t(i, k, j)/t(i, k, j))/t(i, k, j)**2-(1.0+&
&          xlvqv/r_d/t(i, k, j))*((xlv*xlvqvd*t(i, k, j)/(cp*r_v)-xlv*&
&          xlvqv*td(i, k, j)/(cp*r_v))/t(i, k, j)-xlv*xlvqv*td(i, k, j)/(&
&          cp*r_v*t(i, k, j)))/t(i, k, j)**2)*theta(i, k, j)/(1.0+xlv*&
&          xlvqv/cp/r_v/t(i, k, j)/t(i, k, j))**2-(1.0+xlvqv/r_d/t(i, k, &
&          j))*thetad(i, k, j)/(1.0+xlv*xlvqv/cp/r_v/t(i, k, j)/t(i, k, j&
&          )))/theta(i, k, j)**2
        coefa = (1.0+xlvqv/r_d/t(i, k, j))/(1.0+xlv*xlvqv/cp/r_v/t(i, k&
&          , j)/t(i, k, j))/theta(i, k, j)
        thetaep1d = thetad(i, k+1, j)*(1.0+xlv*qvs(i, k+1, j)/cp/t(i, k+&
&          1, j)) + theta(i, k+1, j)*(xlv*qvsd(i, k+1, j)*t(i, k+1, j)/cp&
&          -xlv*qvs(i, k+1, j)*td(i, k+1, j)/cp)/t(i, k+1, j)**2
        thetaep1 = theta(i, k+1, j)*(1.0+xlv*qvs(i, k+1, j)/cp/t(i, k+1&
&          , j))
        thetaesfcd = thetasfcd*(1.0+xlv*qvsfc/cp/t8w(i, kts, j)) + &
&          thetasfc*(xlv*qvsfcd*t8w(i, kts, j)/cp-xlv*qvsfc*t8wd(i, kts, &
&          j)/cp)/t8w(i, kts, j)**2
        thetaesfc = thetasfc*(1.0+xlv*qvsfc/cp/t8w(i, kts, j))
        bn2d(i, k, j) = g*(((coefad*(thetaep1-thetaesfc)+coefa*(&
&          thetaep1d-thetaesfcd))*tmpdz-coefa*(thetaep1-thetaesfc)*tmpdzd&
&          )/tmpdz**2-((tmp1d(i, k+1, j)-tmp1sfcd(i, j))*tmpdz-(tmp1(i, k&
&          +1, j)-tmp1sfc(i, j))*tmpdzd)/tmpdz**2)
        bn2(i, k, j) = g*(coefa*(thetaep1-thetaesfc)/tmpdz-(tmp1(i, k+1&
&          , j)-tmp1sfc(i, j))/tmpdz)
      ELSE
        qvsfcd = cf1*moistd(i, 1, j, p_qv) + cf2*moistd(i, 2, j, p_qv) +&
&          cf3*moistd(i, 3, j, p_qv)
        qvsfc = cf1*moist(i, 1, j, p_qv) + cf2*moist(i, 2, j, p_qv) + &
&          cf3*moist(i, 3, j, p_qv)
!        BN2(i,k,j) = g * ( ( theta(i,k+1,j) - thetasfc ) /  &
!                     theta(i,k,j) / tmpdz +  &
!                     1.61 * ( moist(i,k+1,j,P_QV) - qvsfc ) /  &
!                     tmpdz -  &
!                     ( tmp1(i,k+1,j) - tmp1sfc(i,j) ) / tmpdz  )
!...... MARTA: change in computation of BN2 at the surface, WCS 040331
! controlare come calcola rdzw
        tmpdzd = -(rdzwd(i, k, j)/rdzw(i, k, j)**2)
        tmpdz = 1./rdzw(i, k, j)
        bn2d(i, k, j) = g*((((thetad(i, k+1, j)-thetad(i, k, j))*theta(i&
&          , k, j)-(theta(i, k+1, j)-theta(i, k, j))*thetad(i, k, j))*&
&          tmpdz/theta(i, k, j)**2-(theta(i, k+1, j)-theta(i, k, j))*&
&          tmpdzd/theta(i, k, j))/tmpdz**2+(1.61*(moistd(i, k+1, j, p_qv)&
&          -qvsfcd)*tmpdz-1.61*(moist(i, k+1, j, p_qv)-qvsfc)*tmpdzd)/&
&          tmpdz**2-((tmp1d(i, k+1, j)-tmp1sfcd(i, j))*tmpdz-(tmp1(i, k+1&
&          , j)-tmp1sfc(i, j))*tmpdzd)/tmpdz**2)
        bn2(i, k, j) = g*((theta(i, k+1, j)-theta(i, k, j))/theta(i, k, &
&          j)/tmpdz+1.61*(moist(i, k+1, j, p_qv)-qvsfc)/tmpdz-(tmp1(i, k+&
&          1, j)-tmp1sfc(i, j))/tmpdz)
! end of MARTA/WCS change
      END IF
    END DO
  END DO
!...... MARTA: change in computation of BN2 at the top, WCS 040331
  DO j=j_start,j_end
    DO i=i_start,i_end
      bn2d(i, ktf, j) = bn2d(i, ktf-1, j)
      bn2(i, ktf, j) = bn2(i, ktf-1, j)
    END DO
  END DO
END SUBROUTINE G_CALCULATE_N2

 SUBROUTINE g_isotropic_km(config_flags,xkmh,g_xkmh,xkmv,g_xkmv,xkhh, &
 g_xkhh,xkhv,g_xkhv,khdif,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
 its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 REAL :: khdif,kvdif
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkmh,g_xkmh,xkmv,g_xkmv,xkhh, &
 g_xkhh,xkhv,g_xkhv
 INTEGER :: i_start,i_end,j_start,j_end,ktf,i,j,k
 REAL :: khdif3,kvdif3

 ktf =kte

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 khdif3 =khdif/prandtl

 kvdif3 =kvdif/prandtl

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_xkmh(i,k,j) =0.0
 xkmh(i,k,j) =khdif

 g_xkmv(i,k,j) =0.0
 xkmv(i,k,j) =kvdif

 g_xkhh(i,k,j) =0.0
 xkhh(i,k,j) =khdif3

 g_xkhv(i,k,j) =0.0
 xkhv(i,k,j) =kvdif3

 ENDDO
 ENDDO
 ENDDO

 END SUBROUTINE g_isotropic_km

 SUBROUTINE g_smag_km(config_flags,xkmh,g_xkmh,xkmv,g_xkmv,xkhh,g_xkhh, &
 xkhv,g_xkhv,BN2,g_BN2,div,g_div,defor11,g_defor11,defor22,g_defor22, &
 defor33,g_defor33,defor12,g_defor12,defor13,g_defor13,defor23,g_defor23, &
 rdzw,g_rdzw,dx,dy,dt,isotropic,mix_upper_bound,msftx,msfty,ids,ide,jds,jde,kds, &
 kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4,Tmpv5,g_Tmpv5

   REAL :: g_Sqrt
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 INTEGER :: isotropic
 REAL :: dx,dy,dt,mix_upper_bound
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: BN2,g_BN2,rdzw,g_rdzw
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkmh,g_xkmh,xkmv,g_xkmv,xkhh, &
 g_xkhh,xkhv,g_xkhv
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor11,g_defor11,defor22,g_defor22, &
 defor33,g_defor33,defor12,g_defor12,defor13,g_defor13,defor23,g_defor23, &
 div,g_div
 REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
 INTEGER :: i_start,i_end,j_start,j_end,ktf,i,j,k
 REAL :: deltas,g_deltas,tmp,g_tmp,pr,g_pr,mlen_h,g_mlen_h,mlen_v, &
 g_mlen_v,c_s,g_c_s
 REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: def2,g_def2

 ktf =min(kte,kde-1)

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .or. config_flags%specified .or.   &
        config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .or. config_flags%specified .or.   &
        config_flags%nested) i_end =min(ide-2,ite)

 IF( config_flags%open_ys .or. config_flags%specified .or.   &
        config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .or. config_flags%specified .or.   &
        config_flags%nested) j_end =min(jde-2,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide-1)

 g_pr =0.0
 pr =prandtl

!REVISED BY WALLS
!g_c_s =g_config_flags%c_s
 g_c_s =0.0
 c_s =config_flags%c_s

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =2.0*defor11(i,k,j)*g_defor11(i,k,j) 
 Tmpv1 =defor11(i,k,j)*defor11(i,k,j)

 g_Tmpv2 =2.0*defor22(i,k,j)*g_defor22(i,k,j) 
 Tmpv2 =defor22(i,k,j)*defor22(i,k,j)

 g_Tmpv3 =2.0*defor33(i,k,j)*g_defor33(i,k,j) 
 Tmpv3 =defor33(i,k,j)*defor33(i,k,j)

 g_def2(i,k,j) =0.5*(g_Tmpv1 +g_Tmpv2 +g_Tmpv3)
 def2(i,k,j) =0.5*(Tmpv1 +Tmpv2 +Tmpv3)

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tmp =0.25*(g_defor12(i,k,j) +g_defor12(i,k,j+1) +g_defor12(i+1,k,j) &
 +g_defor12(i+1,k,j+1))
 tmp =0.25*(defor12(i,k,j) +defor12(i,k,j+1) +defor12(i+1,k,j) +defor12(i+1,k,j+1))

 g_Tmpv1 =2.0*tmp*g_tmp 
 Tmpv1 =tmp*tmp

 g_def2(i,k,j) =g_def2(i,k,j) +g_Tmpv1
 def2(i,k,j) =def2(i,k,j) +Tmpv1

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tmp =0.25*(g_defor13(i,k+1,j) +g_defor13(i,k,j) +g_defor13(i+1,k+1,j) &
 +g_defor13(i+1,k,j))
 tmp =0.25*(defor13(i,k+1,j) +defor13(i,k,j) +defor13(i+1,k+1,j) +defor13(i+1,k,j))

 g_Tmpv1 =2.0*tmp*g_tmp 
 Tmpv1 =tmp*tmp

 g_def2(i,k,j) =g_def2(i,k,j) +g_Tmpv1
 def2(i,k,j) =def2(i,k,j) +Tmpv1

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tmp =0.25*(g_defor23(i,k+1,j) +g_defor23(i,k,j) +g_defor23(i,k+1,j+1) &
 +g_defor23(i,k,j+1))
 tmp =0.25*(defor23(i,k+1,j) +defor23(i,k,j) +defor23(i,k+1,j+1) +defor23(i,k,j+1))

 g_Tmpv1 =2.0*tmp*g_tmp 
 Tmpv1 =tmp*tmp

 g_def2(i,k,j) =g_def2(i,k,j) +g_Tmpv1
 def2(i,k,j) =def2(i,k,j) +Tmpv1

 ENDDO
 ENDDO
 ENDDO

 IF(isotropic .EQ. 0) THEN

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_mlen_h =0.0
 mlen_h =sqrt(dx/msftx(i,j) *dy/msfty(i,j))

 g_mlen_v =-1.*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))
 mlen_v =1./rdzw(i,k,j)

 g_Tmpv1 =(g_BN2(i,k,j)*pr -g_pr*BN2(i,k,j))/(pr*pr) 
 Tmpv1 =BN2(i,k,j)/pr

 g_tmp =(0.0 +(g_def2(i,k,j) -g_Tmpv1) +(0.0 -(g_def2(i,k,j) -g_Tmpv1)) &
*sign(1.0, 0. -(def2(i,k,j) -Tmpv1)))*0.5
 tmp =max(0.,def2(i,k,j) -Tmpv1)

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!REVISED AND ADDED BY WALLS
 IF(tmp.NE.0.0) THEN
   g_tmp =0.5*g_tmp*tmp**(0.5 -1.0)
 ELSE
! Reivsed by Ning Pan, 2010-08-18
   g_tmp =0.0
!   g_tmp =0.5*g_tmp/(tmp**0.5+1.e-10)
 ENDIF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

 tmp =tmp**0.5

 g_Tmpv1 =2.0*c_s*g_c_s 
 Tmpv1 =c_s*c_s

 g_Tmpv2 =Tmpv1*g_mlen_h +g_Tmpv1*mlen_h 
 Tmpv2 =Tmpv1*mlen_h

 g_Tmpv3 =Tmpv2*g_mlen_h +g_Tmpv2*mlen_h 
 Tmpv3 =Tmpv2*mlen_h

 g_Tmpv4 =Tmpv3*g_tmp +g_Tmpv3*tmp 
 Tmpv4 =Tmpv3*tmp

 g_Tmpv5 =1.0E-6*mlen_h*g_mlen_h +1.0E-6*g_mlen_h*mlen_h 
 Tmpv5 =1.0E-6*mlen_h*mlen_h

 g_xkmh(i,k,j) =(g_Tmpv4 +g_Tmpv5 +(g_Tmpv4 -g_Tmpv5)*sign(1.0, Tmpv4 - &
(Tmpv5)))*0.5
 xkmh(i,k,j) =max(Tmpv4,Tmpv5)

 g_Tmpv1 =mix_upper_bound*mlen_h*g_mlen_h +mix_upper_bound*g_mlen_h*mlen_h 
 Tmpv1 =mix_upper_bound*mlen_h*mlen_h

 g_xkmh(i,k,j) =(g_xkmh(i,k,j) +(g_Tmpv1/dt) -(g_xkmh(i,k,j) &
 -(g_Tmpv1/dt))*sign(1.0, xkmh(i,k,j) -(Tmpv1/dt)))*0.5
 xkmh(i,k,j) =min(xkmh(i,k,j),Tmpv1/dt)

 g_Tmpv1 =2.0*c_s*g_c_s 
 Tmpv1 =c_s*c_s

 g_Tmpv2 =Tmpv1*g_mlen_v +g_Tmpv1*mlen_v 
 Tmpv2 =Tmpv1*mlen_v

 g_Tmpv3 =Tmpv2*g_mlen_v +g_Tmpv2*mlen_v 
 Tmpv3 =Tmpv2*mlen_v

 g_Tmpv4 =Tmpv3*g_tmp +g_Tmpv3*tmp 
 Tmpv4 =Tmpv3*tmp

 g_Tmpv5 =1.0E-6*mlen_v*g_mlen_v +1.0E-6*g_mlen_v*mlen_v 
 Tmpv5 =1.0E-6*mlen_v*mlen_v

 g_xkmv(i,k,j) =(g_Tmpv4 +g_Tmpv5 +(g_Tmpv4 -g_Tmpv5)*sign(1.0, Tmpv4 - &
(Tmpv5)))*0.5
 xkmv(i,k,j) =max(Tmpv4,Tmpv5)

 g_Tmpv1 =mix_upper_bound*mlen_v*g_mlen_v +mix_upper_bound*g_mlen_v*mlen_v 
 Tmpv1 =mix_upper_bound*mlen_v*mlen_v

 g_xkmv(i,k,j) =(g_xkmv(i,k,j) +(g_Tmpv1/dt) -(g_xkmv(i,k,j) &
 -(g_Tmpv1/dt))*sign(1.0, xkmv(i,k,j) -(Tmpv1/dt)))*0.5
 xkmv(i,k,j) =min(xkmv(i,k,j),Tmpv1/dt)

 g_Tmpv1 =(g_xkmh(i,k,j)*pr -g_pr*xkmh(i,k,j))/(pr*pr) 
 Tmpv1 =xkmh(i,k,j)/pr

 g_xkhh(i,k,j) =g_Tmpv1
 xkhh(i,k,j) =Tmpv1

 g_Tmpv1 =mix_upper_bound*mlen_h*g_mlen_h +mix_upper_bound*g_mlen_h*mlen_h 
 Tmpv1 =mix_upper_bound*mlen_h*mlen_h

 g_xkhh(i,k,j) =(g_xkhh(i,k,j) +(g_Tmpv1/dt) -(g_xkhh(i,k,j) &
 -(g_Tmpv1/dt))*sign(1.0, xkhh(i,k,j) -(Tmpv1/dt)))*0.5
 xkhh(i,k,j) =min(xkhh(i,k,j),Tmpv1/dt)

 g_Tmpv1 =(g_xkmv(i,k,j)*pr -g_pr*xkmv(i,k,j))/(pr*pr) 
 Tmpv1 =xkmv(i,k,j)/pr

 g_xkhv(i,k,j) =g_Tmpv1
 xkhv(i,k,j) =Tmpv1

 g_Tmpv1 =mix_upper_bound*mlen_v*g_mlen_v +mix_upper_bound*g_mlen_v*mlen_v 
 Tmpv1 =mix_upper_bound*mlen_v*mlen_v

 g_xkhv(i,k,j) =(g_xkhv(i,k,j) +(g_Tmpv1/dt) -(g_xkhv(i,k,j) &
 -(g_Tmpv1/dt))*sign(1.0, xkhv(i,k,j) -(Tmpv1/dt)))*0.5
 xkhv(i,k,j) =min(xkhv(i,k,j),Tmpv1/dt)

 ENDDO
 ENDDO
 ENDDO
 ELSE

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_deltas =0.33333333*(-dx/msftx(i,j) *dy/msfty(i,j)*g_rdzw(i,k,j)/(rdzw(i,k,j) &
*rdzw(i,k,j)))*(dx/msftx(i,j) *dy/msfty(i,j)/rdzw(i,k,j))**(0.33333333 -1.0)
 deltas =(dx/msftx(i,j) *dy/msfty(i,j)/rdzw(i,k,j))**0.33333333

 g_Tmpv1 =(g_BN2(i,k,j)*pr -g_pr*BN2(i,k,j))/(pr*pr) 
 Tmpv1 =BN2(i,k,j)/pr

 g_tmp =(0.0 +(g_def2(i,k,j) -g_Tmpv1) +(0.0 -(g_def2(i,k,j) -g_Tmpv1)) &
*sign(1.0, 0. -(def2(i,k,j) -Tmpv1)))*0.5
 tmp =max(0.,def2(i,k,j) -Tmpv1)

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!REVISED AND ADDED BY WALLS
 IF(tmp.NE.0.0) THEN
   g_tmp =0.5*g_tmp*tmp**(0.5 -1.0)
 ELSE
! Revised by Ning Pan, 2010-08-18
   g_tmp =0.0
!   g_tmp =0.5*g_tmp/(tmp**0.5+1.e-10)
 ENDIF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 tmp =tmp**0.5  ! Added by Ning Pan, 2010-08-18

 g_Tmpv1 =2.0*c_s*g_c_s 
 Tmpv1 =c_s*c_s

 g_Tmpv2 =Tmpv1*g_deltas +g_Tmpv1*deltas 
 Tmpv2 =Tmpv1*deltas

 g_Tmpv3 =Tmpv2*g_deltas +g_Tmpv2*deltas 
 Tmpv3 =Tmpv2*deltas

 g_Tmpv4 =Tmpv3*g_tmp +g_Tmpv3*tmp 
 Tmpv4 =Tmpv3*tmp

 g_Tmpv5 =1.0E-6*deltas*g_deltas +1.0E-6*g_deltas*deltas 
 Tmpv5 =1.0E-6*deltas*deltas

 g_xkmh(i,k,j) =(g_Tmpv4 +g_Tmpv5 +(g_Tmpv4 -g_Tmpv5)*sign(1.0, Tmpv4 - &
(Tmpv5)))*0.5
 xkmh(i,k,j) =max(Tmpv4,Tmpv5)

 g_xkmh(i,k,j) =(g_xkmh(i,k,j) +0.0 -(g_xkmh(i,k,j) -0.0)*sign(1.0, xkmh(i,k, &
 j) -(mix_upper_bound *dx/msftx(i,j) *dy/msfty(i,j)/dt)))*0.5
 xkmh(i,k,j) =min(xkmh(i,k,j),mix_upper_bound *dx/msftx(i,j) *dy/msfty(i,j)/dt)

 g_xkmv(i,k,j) =g_xkmh(i,k,j)
 xkmv(i,k,j) =xkmh(i,k,j)

 g_Tmpv1 =((-mix_upper_bound*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))) &
*rdzw(i,k,j) -g_rdzw(i,k,j)*mix_upper_bound/rdzw(i,k,j))/(rdzw(i,k,j)*rdzw(i,k,j))
 Tmpv1 =mix_upper_bound/rdzw(i,k,j)/rdzw(i,k,j)

 g_xkmv(i,k,j) =(g_xkmv(i,k,j) +(g_Tmpv1/dt) -(g_xkmv(i,k,j) &
 -(g_Tmpv1/dt))*sign(1.0, xkmv(i,k,j) -(Tmpv1/dt)))*0.5
 xkmv(i,k,j) =min(xkmv(i,k,j),Tmpv1/dt)

 g_Tmpv1 =(g_xkmh(i,k,j)*pr -g_pr*xkmh(i,k,j))/(pr*pr)
 Tmpv1 =xkmh(i,k,j)/pr

 g_xkhh(i,k,j) =g_Tmpv1
 xkhh(i,k,j) =Tmpv1

 g_xkhh(i,k,j) =(g_xkhh(i,k,j) +0.0 -(g_xkhh(i,k,j) -0.0)*sign(1.0, xkhh(i,k, &
 j) -(mix_upper_bound *dx/msftx(i,j) *dy/msfty(i,j)/dt)))*0.5
 xkhh(i,k,j) =min(xkhh(i,k,j),mix_upper_bound *dx/msftx(i,j) *dy/msfty(i,j)/dt)

 g_Tmpv1 =(g_xkmv(i,k,j)*pr -g_pr*xkmv(i,k,j))/(pr*pr)
 Tmpv1 =xkmv(i,k,j)/pr

 g_xkhv(i,k,j) =g_Tmpv1
 xkhv(i,k,j) =Tmpv1

 g_Tmpv1 =((-mix_upper_bound*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))) &
*rdzw(i,k,j) -g_rdzw(i,k,j)*mix_upper_bound/rdzw(i,k,j))/(rdzw(i,k,j)*rdzw(i,k,j))
 Tmpv1 =mix_upper_bound/rdzw(i,k,j)/rdzw(i,k,j)

 g_xkhv(i,k,j) =(g_xkhv(i,k,j) +(g_Tmpv1/dt) -(g_xkhv(i,k,j) &
 -(g_Tmpv1/dt))*sign(1.0, xkhv(i,k,j) -(Tmpv1/dt)))*0.5
 xkhv(i,k,j) =min(xkhv(i,k,j),Tmpv1/dt)

 ENDDO
 ENDDO
 ENDDO
 ENDIF

 END SUBROUTINE g_smag_km

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.10 (r5363) -  9 Sep 2014 09:54
!
!  Differentiation of smag2d_km in forward (tangent) mode:
!   variations   of useful results: xkmh xkmv xkhh xkhv
!   with respect to varying inputs: defor11 defor12 zx zy xkmh
!                defor22 xkmv rdzw xkhh xkhv
!   RW status of diff variables: defor11:in defor12:in zx:in zy:in
!                xkmh:in-out defor22:in xkmv:in-out rdzw:in xkhh:in-out
!                xkhv:in-out
SUBROUTINE G_SMAG2D_KM(config_flags, xkmh, xkmhd, xkmv, xkmvd, xkhh, &
&  xkhhd, xkhv, xkhvd, defor11, defor11d, defor22, defor22d, defor12, &
&  defor12d, rdzw, rdzwd, dx, dy, msftx, msfty, zx, zxd, zy, zyd, ids, &
&  ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, &
&  jte, kts, kte)
  IMPLICIT NONE
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  REAL, INTENT(IN) :: dx, dy
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rdzw, zx, zy
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rdzwd, zxd, &
&  zyd
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: xkmh, &
&  xkmv, xkhh, xkhv
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: xkmhd, &
&  xkmvd, xkhhd, xkhvd
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: defor11, &
&  defor22, defor12
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: defor11d, &
&  defor22d, defor12d
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msftx, msfty
! LOCAL VARS
  INTEGER :: i_start, i_end, j_start, j_end, ktf, i, j, k
  REAL :: deltas, tmp, pr, mlen_h, c_s
  REAL :: tmpd
  REAL :: dxm, dym, tmpzx, tmpzy, alpha, def_limit
  REAL :: tmpzxd, tmpzyd, alphad
  REAL, DIMENSION(its:ite, kts:kte, jts:jte) :: def2
  REAL, DIMENSION(its:ite, kts:kte, jts:jte) :: def2d
  REAL :: arg1
  REAL :: arg1d
  REAL :: abs1d
  REAL :: abs4d
  REAL :: abs7d
  REAL :: x1
  REAL :: abs0d
  REAL :: abs3d
  REAL :: abs6d
  REAL :: x1d
  REAL :: abs7
  REAL :: abs6
  REAL :: abs5
  REAL :: abs4
  REAL :: abs3
  REAL :: abs2
  REAL :: abs2d
  REAL :: abs1
  REAL :: abs0
  REAL :: abs5d
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
  IF ((config_flags%open_xs .OR. config_flags%specified) .OR. &
&      config_flags%nested) THEN
    IF (ids + 1 .LT. its) THEN
      i_start = its
    ELSE
      i_start = ids + 1
    END IF
  END IF
  IF ((config_flags%open_xe .OR. config_flags%specified) .OR. &
&      config_flags%nested) THEN
    IF (ide - 2 .GT. ite) THEN
      i_end = ite
    ELSE
      i_end = ide - 2
    END IF
  END IF
  IF ((config_flags%open_ys .OR. config_flags%specified) .OR. &
&      config_flags%nested) THEN
    IF (jds + 1 .LT. jts) THEN
      j_start = jts
    ELSE
      j_start = jds + 1
    END IF
  END IF
  IF ((config_flags%open_ye .OR. config_flags%specified) .OR. &
&      config_flags%nested) THEN
    IF (jde - 2 .GT. jte) THEN
      j_end = jte
    ELSE
      j_end = jde - 2
    END IF
  END IF
  IF (config_flags%periodic_x) i_start = its
  IF (config_flags%periodic_x) THEN
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
  END IF
  pr = prandtl
  c_s = config_flags%c_s
  def2d = 0.0_8
  DO j=j_start,j_end
    DO k=kts,ktf
      DO i=i_start,i_end
        def2d(i, k, j) = 0.25*((defor11d(i, k, j)-defor22d(i, k, j))*(&
&          defor11(i, k, j)-defor22(i, k, j))+(defor11(i, k, j)-defor22(i&
&          , k, j))*(defor11d(i, k, j)-defor22d(i, k, j)))
        def2(i, k, j) = 0.25*((defor11(i, k, j)-defor22(i, k, j))*(&
&          defor11(i, k, j)-defor22(i, k, j)))
        tmpd = 0.25*(defor12d(i, k, j)+defor12d(i, k, j+1)+defor12d(i+1&
&          , k, j)+defor12d(i+1, k, j+1))
        tmp = 0.25*(defor12(i, k, j)+defor12(i, k, j+1)+defor12(i+1, k, &
&          j)+defor12(i+1, k, j+1))
        def2d(i, k, j) = def2d(i, k, j) + tmpd*tmp + tmp*tmpd
        def2(i, k, j) = def2(i, k, j) + tmp*tmp
      END DO
    END DO
  END DO
!
  DO j=j_start,j_end
    DO k=kts,ktf
      DO i=i_start,i_end
        arg1 = dx/msftx(i, j)*dy/msfty(i, j)
        mlen_h = SQRT(arg1)
        IF (def2(i, k, j) .EQ. 0.0_8) THEN
          tmpd = 0.0_8
        ELSE
          tmpd = def2d(i, k, j)/(2.0*SQRT(def2(i, k, j)))
        END IF
        tmp = SQRT(def2(i, k, j))
!        xkmh(i,k,j)=max(c_s*c_s*mlen_h*mlen_h*tmp, 1.0E-6*mlen_h*mlen_h )
        xkmhd(i, k, j) = c_s**2*mlen_h**2*tmpd
        xkmh(i, k, j) = c_s*c_s*mlen_h*mlen_h*tmp
        IF (xkmh(i, k, j) .GT. 10.*mlen_h) THEN
          xkmhd(i, k, j) = 0.0_8
          xkmh(i, k, j) = 10.*mlen_h
        ELSE
          xkmh(i, k, j) = xkmh(i, k, j)
        END IF
        xkmvd(i, k, j) = 0.0_8
        xkmv(i, k, j) = 0.
        xkhhd(i, k, j) = xkmhd(i, k, j)/pr
        xkhh(i, k, j) = xkmh(i, k, j)/pr
        xkhvd(i, k, j) = 0.0_8
        xkhv(i, k, j) = 0.
        IF (config_flags%diff_opt .EQ. 2) THEN
! jd: reduce diffusion coefficient by slope factor (modified by JB August 2014)
          dxm = dx/msftx(i, j)
          dym = dy/msfty(i, j)
          IF (zx(i, k, j) .GE. 0.0_8) THEN
            abs0d = zxd(i, k, j)
            abs0 = zx(i, k, j)
          ELSE
            abs0d = -zxd(i, k, j)
            abs0 = -zx(i, k, j)
          END IF
          IF (zx(i+1, k, j) .GE. 0.0_8) THEN
            abs2d = zxd(i+1, k, j)
            abs2 = zx(i+1, k, j)
          ELSE
            abs2d = -zxd(i+1, k, j)
            abs2 = -zx(i+1, k, j)
          END IF
          IF (zx(i, k+1, j) .GE. 0.0_8) THEN
            abs4d = zxd(i, k+1, j)
            abs4 = zx(i, k+1, j)
          ELSE
            abs4d = -zxd(i, k+1, j)
            abs4 = -zx(i, k+1, j)
          END IF
          IF (zx(i+1, k+1, j) .GE. 0.0_8) THEN
            abs6d = zxd(i+1, k+1, j)
            abs6 = zx(i+1, k+1, j)
          ELSE
            abs6d = -zxd(i+1, k+1, j)
            abs6 = -zx(i+1, k+1, j)
          END IF
          tmpzxd = 0.25*dxm*((abs0d+abs2d+abs4d+abs6d)*rdzw(i, k, j)+(&
&           abs0+abs2+abs4+abs6)*rdzwd(i, k, j))
          tmpzx = 0.25*(abs0+abs2+abs4+abs6)*rdzw(i, k, j)*dxm
          IF (zy(i, k, j) .GE. 0.0_8) THEN
            abs1d = zyd(i, k, j)
            abs1 = zy(i, k, j)
          ELSE
            abs1d = -zyd(i, k, j)
            abs1 = -zy(i, k, j)
          END IF
          IF (zy(i, k, j+1) .GE. 0.0_8) THEN
            abs3d = zyd(i, k, j+1)
            abs3 = zy(i, k, j+1)
          ELSE
            abs3d = -zyd(i, k, j+1)
            abs3 = -zy(i, k, j+1)
          END IF
          IF (zy(i, k+1, j) .GE. 0.0_8) THEN
            abs5d = zyd(i, k+1, j)
            abs5 = zy(i, k+1, j)
          ELSE
            abs5d = -zyd(i, k+1, j)
            abs5 = -zy(i, k+1, j)
          END IF
          IF (zy(i, k+1, j+1) .GE. 0.0_8) THEN
            abs7d = zyd(i, k+1, j+1)
            abs7 = zy(i, k+1, j+1)
          ELSE
            abs7d = -zyd(i, k+1, j+1)
            abs7 = -zy(i, k+1, j+1)
          END IF
          tmpzyd = 0.25*dym*((abs1d+abs3d+abs5d+abs7d)*rdzw(i, k, j)+(&
&            abs1+abs3+abs5+abs7)*rdzwd(i, k, j))
          tmpzy = 0.25*(abs1+abs3+abs5+abs7)*rdzw(i, k, j)*dym
          arg1d = tmpzxd*tmpzx + tmpzx*tmpzxd + tmpzyd*tmpzy + tmpzy*&
&            tmpzyd
          arg1 = tmpzx*tmpzx + tmpzy*tmpzy
          IF (arg1 .EQ. 0.0_8) THEN
            x1d = 0.0_8
          ELSE
            x1d = arg1d/(2.0*SQRT(arg1))
          END IF
          x1 = SQRT(arg1)
          IF (x1 .LT. 1.0) THEN
            alpha = 1.0
            alphad = 0.0_8
          ELSE
            alphad = x1d
            alpha = x1
          END IF
          IF (10.0/mlen_h .LT. 1.e-3) THEN
            def_limit = 1.e-3
          ELSE
            def_limit = 10.0/mlen_h
          END IF
          IF (tmp .GT. def_limit) THEN
            xkmhd(i, k, j) = (xkmhd(i, k, j)*alpha**2-xkmh(i, k, j)*(&
&             alphad*alpha+alpha*alphad))/(alpha*alpha)**2
            xkmh(i, k, j) = xkmh(i, k, j)/(alpha*alpha)
          ELSE
            xkmhd(i, k, j) = (xkmhd(i, k, j)*alpha-xkmh(i, k, j)*alphad)&
&             /alpha**2
            xkmh(i, k, j) = xkmh(i, k, j)/alpha
          END IF
          xkhhd(i, k, j) = xkmhd(i, k, j)/pr
          xkhh(i, k, j) = xkmh(i, k, j)/pr
        END IF
      END DO
    END DO
  END DO
END SUBROUTINE G_SMAG2D_KM

 SUBROUTINE g_phy_bc(config_flags,div,g_div,defor11,g_defor11,defor22, &
 g_defor22,defor33,g_defor33,defor12,g_defor12,defor13,g_defor13,defor23, &
 g_defor23,xkmh,g_xkmh,xkmv,g_xkmv,xkhh,g_xkhh,xkhv,g_xkhv,tke, &
 g_tke,RUBLTEN,g_RUBLTEN,RVBLTEN,g_RVBLTEN,RUCUTEN,g_RUCUTEN,RVCUTEN,g_RVCUTEN,&
 RUSHTEN,g_RUSHTEN,RVSHTEN,g_RVSHTEN,ids,ide,jds,jde,kds,kde,ims,ime, &
 jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1
 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(ims:ime,kms:kme,jms:jme) :: RUBLTEN,g_RUBLTEN,RVBLTEN,g_RVBLTEN, &
 RUCUTEN,g_RUCUTEN,RVCUTEN,g_RVCUTEN, RUSHTEN,g_RUSHTEN,RVSHTEN,g_RVSHTEN, &
 defor11,g_defor11,defor22,g_defor22,defor33,g_defor33,defor12,g_defor12, &
 defor13,g_defor13,defor23,g_defor23,xkmh,g_xkmh,xkmv,g_xkmv,xkhh, &
 g_xkhh,xkhv,g_xkhv,tke,g_tke,div,g_div

 IF(config_flags%bl_pbl_physics .GT. 0) THEN

 CALL g_set_physical_bc3d(RUBLTEN,g_RUBLTEN,'t',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)

 CALL g_set_physical_bc3d(RVBLTEN,g_RVBLTEN,'t',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)
 ENDIF

!Tiedtke ZCX&YQW
 IF(config_flags%cu_physics .GT. 0) THEN

 CALL g_set_physical_bc3d(RUCUTEN,g_RUCUTEN,'t',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)

 CALL g_set_physical_bc3d(RVCUTEN,g_RVCUTEN,'t',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)
 ENDIF

   IF(config_flags%shcu_physics .GT. 0) THEN

        CALL g_set_physical_bc3d( RUSHTEN, g_RUSHTEN,'t', 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              )

        CALL g_set_physical_bc3d( RVSHTEN, g_RVSHTEN,'t', 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              )

   ENDIF

 CALL g_set_physical_bc3d(xkmh,g_xkmh,'t',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)

 CALL g_set_physical_bc3d(xkhh,g_xkhh,'t',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)

 IF(config_flags%diff_opt .eq. 2) THEN

 CALL g_set_physical_bc3d(xkmv,g_xkmv,'t',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)

 CALL g_set_physical_bc3d(xkhv,g_xkhv,'t',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)

 CALL g_set_physical_bc3d(div,g_div,'t',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)

 CALL g_set_physical_bc3d(defor11,g_defor11,'t',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)

 CALL g_set_physical_bc3d(defor22,g_defor22,'t',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)

 CALL g_set_physical_bc3d(defor33,g_defor33,'t',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)

 CALL g_set_physical_bc3d(defor12,g_defor12,'d',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)

 CALL g_set_physical_bc3d(defor13,g_defor13,'e',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)

 CALL g_set_physical_bc3d(defor23,g_defor23,'f',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)
 ENDIF

 END SUBROUTINE g_phy_bc

 SUBROUTINE g_tke_km(config_flags,xkmh,g_xkmh,xkmv,g_xkmv,xkhh,g_xkhh, &
 xkhv,g_xkhv,bn2,g_bn2,tke,g_tke,p8w,g_p8w,t8w,g_t8w,theta,g_theta, &
 rdz,g_rdz,rdzw,g_rdzw,dx,dy,dt,isotropic,mix_upper_bound,msftx,msfty,ids,ide, &
 jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4,Tmpv5, &
 g_Tmpv5,Tmpv6,g_Tmpv6

 REAL :: g_Sqrt
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 INTEGER :: isotropic
 REAL :: dx,dy,dt
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tke,g_tke,p8w,g_p8w,t8w,g_t8w, &
 theta,g_theta,rdz,g_rdz,rdzw,g_rdzw,bn2,g_bn2
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkmh,g_xkmh,xkmv,g_xkmv,xkhh, &
 g_xkhh,xkhv,g_xkhv
 REAL :: mix_upper_bound
 REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
 REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: l_scale,g_l_scale
 REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: dthrdn,g_dthrdn
 REAL :: deltas,g_deltas,tmp,g_tmp,mlen_s,g_mlen_s,mlen_h,g_mlen_h,mlen_v, &
 g_mlen_v,tmpdz,g_tmpdz,thetasfc,g_thetasfc,thetatop,g_thetatop,minkx, &
 g_minkx,pr_inv,g_pr_inv,pr_inv_h,g_pr_inv_h,pr_inv_v,g_pr_inv_v,c_k,g_c_k
 INTEGER :: i_start,i_end,j_start,j_end,ktf,i,j,k
 REAL,PARAMETER :: tke_seed_value =1.e-06
 REAL :: tke_seed
 REAL,PARAMETER :: epsilon =1.e-10

 ktf =min(kte,kde-1)

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
         config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
         config_flags%nested) i_end =min(ide-2,ite)

 IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
         config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
         config_flags%nested) j_end =min(jde-2,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide-1)

!REVISED BY WALLS
 g_c_k =0.0
 c_k =config_flags%c_k

 tke_seed =tke_seed_value

 if( (config_flags%tke_drag_coefficient .gt. epsilon) .or.    &
        (config_flags%tke_heat_flux .gt. epsilon)  ) tke_seed =0.

 DO j =j_start,j_end
 DO k =kts+1,ktf-1
 DO i =i_start,i_end

 g_tmpdz = -(g_rdz(i,k+1,j)/(rdz(i,k+1,j)*rdz(i,k+1,j))) - &
&   g_rdz(i,k,j)/(rdz(i,k,j)*rdz(i,k,j))
 tmpdz = 1.0/rdz(i,k+1,j) + 1.0/rdz(i,k,j)

 g_Tmpv1 = ((g_theta(i,k+1,j)-g_theta(i,k-1,j))*tmpdz- &
&   g_tmpdz*(theta(i,k+1,j)-theta(i,k-1,j)))/(tmpdz*tmpdz)
 Tmpv1 = (theta(i,k+1,j)-theta(i,k-1,j))/tmpdz

 g_dthrdn(i,k,j) =g_Tmpv1
 dthrdn(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 k =kts

 DO j =j_start,j_end
 DO i =i_start,i_end

  g_tmpdz = -(g_rdzw(i,k+1,j)/(rdzw(i,k+1,j)*rdzw(i,k+1,j))) - &
&    g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))
  tmpdz = 1.0/rdzw(i,k+1,j) + 1.0/rdzw(i,k,j)

 g_Tmpv1 =(g_T8w(i,kts,j)*(p8w(i,k,j)/p1000mb)**(R_d/Cp) -(R_d/Cp) &
*(g_p8w(i,k,j)/p1000mb)*(p8w(i,k,j)/p1000mb)**((R_d/Cp) -1.0)*T8w(i,kts,j)) &
/((p8w(i,k,j)/p1000mb)**(R_d/Cp)*(p8w(i,k,j)/p1000mb)**(R_d/Cp)) 
 Tmpv1 =T8w(i,kts,j)/(p8w(i,k,j)/p1000mb)**(R_d/Cp)

 g_thetasfc =g_Tmpv1
 thetasfc =Tmpv1

 g_Tmpv1 =((g_theta(i,k+1,j) -g_thetasfc)*tmpdz -g_tmpdz*(theta(i,k+1,j) &
 -thetasfc))/(tmpdz*tmpdz) 
 Tmpv1 =(theta(i,k+1,j) -thetasfc)/tmpdz

 g_dthrdn(i,k,j) =g_Tmpv1
 dthrdn(i,k,j) =Tmpv1

 ENDDO
 ENDDO

 k =ktf

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_tmpdz =-1.0*g_rdz(i,k,j)/(rdz(i,k,j)*rdz(i,k,j)) +(-0.5*g_rdzw(i,k,j) &
/(rdzw(i,k,j)*rdzw(i,k,j)))
 tmpdz =1.0/rdz(i,k,j)+0.5/rdzw(i,k,j)

 g_Tmpv1 =(g_T8w(i,kde,j)*(p8w(i,kde,j)/p1000mb)**(R_d/Cp) -(R_d/Cp) &
*(g_p8w(i,kde,j)/p1000mb)*(p8w(i,kde,j)/p1000mb)**((R_d/Cp) -1.0)*T8w(i,kde,j)) &
/((p8w(i,kde,j)/p1000mb)**(R_d/Cp)*(p8w(i,kde,j)/p1000mb)**(R_d/Cp)) 
 Tmpv1 =T8w(i,kde,j)/(p8w(i,kde,j)/p1000mb)**(R_d/Cp)

 g_thetatop =g_Tmpv1
 thetatop =Tmpv1

 g_Tmpv1 =((g_thetatop -g_theta(i,k-1,j))*tmpdz -g_tmpdz*(thetatop - &
 theta(i,k-1,j)))/(tmpdz*tmpdz) 
 Tmpv1 =(thetatop -theta(i,k-1,j))/tmpdz

 g_dthrdn(i,k,j) =g_Tmpv1
 dthrdn(i,k,j) =Tmpv1

 ENDDO
 ENDDO

!ADDED BY WALLS
!isotropic=1

 IF( isotropic .EQ. 0 ) THEN

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_mlen_h =0.0
 mlen_h =sqrt(dx/msftx(i,j) *dy/msfty(i,j))

 g_tmp =g_Sqrt((g_tke(i,k,j) +0.0 +(g_tke(i,k,j) -0.0)*sign(1.0, tke(i,k, &
 j) -(tke_seed)))*0.5, max(tke(i,k,j),tke_seed))
 tmp =sqrt(max(tke(i,k,j),tke_seed))

 g_deltas =-1.0*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))
 deltas =1.0/rdzw(i,k,j)

 g_mlen_v =g_deltas
 mlen_v =deltas

 IF( dthrdn(i,k,j) .GT. 0.) THEN

 g_Tmpv1 =g/theta(i,k,j)*g_dthrdn(i,k,j) +(-g*g_theta(i,k,j)/(theta(i,k,j) &
*theta(i,k,j)))*dthrdn(i,k,j) 
 Tmpv1 =g/theta(i,k,j)*dthrdn(i,k,j)

 g_Tmpv2 =(0.76*g_tmp*(abs(Tmpv1))**0.5 -0.5*(sign(1.0, Tmpv1)*g_Tmpv1) &
*(abs(Tmpv1))**(0.5 -1.0)*0.76*tmp)/((abs(Tmpv1))**0.5*(abs(Tmpv1))**0.5) 
 Tmpv2 =0.76*tmp/(abs(Tmpv1))**0.5

 g_mlen_s =g_Tmpv2
 mlen_s =Tmpv2

 g_mlen_v =(g_mlen_v +g_mlen_s -(g_mlen_v -g_mlen_s)*sign(1.0, mlen_v - &
(mlen_s)))*0.5
 mlen_v =min(mlen_v,mlen_s)

 END IF

 g_Tmpv1 =c_k*g_tmp +g_c_k*tmp 
 Tmpv1 =c_k*tmp

 g_Tmpv2 =Tmpv1*g_mlen_h +g_Tmpv1*mlen_h 
 Tmpv2 =Tmpv1*mlen_h

 g_Tmpv3 =1.0E-6*mlen_h*g_mlen_h +1.0E-6*g_mlen_h*mlen_h 
 Tmpv3 =1.0E-6*mlen_h*mlen_h

 g_xkmh(i,k,j) =(g_Tmpv2 +g_Tmpv3 +(g_Tmpv2 -g_Tmpv3)*sign(1.0, Tmpv2 - &
(Tmpv3)))*0.5
 xkmh(i,k,j) =max(Tmpv2,Tmpv3)

 g_Tmpv1 =mix_upper_bound*mlen_h*g_mlen_h +mix_upper_bound*g_mlen_h*mlen_h 
 Tmpv1 =mix_upper_bound*mlen_h*mlen_h

 g_xkmh(i,k,j) =(g_xkmh(i,k,j) +(g_Tmpv1/dt) -(g_xkmh(i,k,j) &
 -(g_Tmpv1/dt))*sign(1.0, xkmh(i,k,j) -(Tmpv1/dt)))*0.5
 xkmh(i,k,j) =min(xkmh(i,k,j),Tmpv1/dt)

 g_Tmpv1 =c_k*g_tmp +g_c_k*tmp 
 Tmpv1 =c_k*tmp

 g_Tmpv2 =Tmpv1*g_mlen_v +g_Tmpv1*mlen_v 
 Tmpv2 =Tmpv1*mlen_v

 g_Tmpv3 =1.0E-6*deltas*g_deltas +1.0E-6*g_deltas*deltas 
 Tmpv3 =1.0E-6*deltas*deltas

 g_xkmv(i,k,j) =(g_Tmpv2 +g_Tmpv3 +(g_Tmpv2 -g_Tmpv3)*sign(1.0, Tmpv2 - &
(Tmpv3)))*0.5
 xkmv(i,k,j) =max(Tmpv2,Tmpv3)

 g_Tmpv1 =mix_upper_bound*deltas*g_deltas +mix_upper_bound*g_deltas*deltas 
 Tmpv1 =mix_upper_bound*deltas*deltas

 g_xkmv(i,k,j) =(g_xkmv(i,k,j) +(g_Tmpv1/dt) -(g_xkmv(i,k,j) &
 -(g_Tmpv1/dt))*sign(1.0, xkmv(i,k,j) -(Tmpv1/dt)))*0.5
 xkmv(i,k,j) =min(xkmv(i,k,j),Tmpv1/dt)

 g_pr_inv_h =0.0
 pr_inv_h =1./prandtl

 g_Tmpv1 =(2.0*g_mlen_v*deltas -g_deltas*2.0*mlen_v)/(deltas*deltas) 
 Tmpv1 =2.0*mlen_v/deltas

 g_pr_inv_v =g_Tmpv1
 pr_inv_v =1.0 +Tmpv1

 g_Tmpv1 =xkmh(i,k,j)*g_pr_inv_h +g_xkmh(i,k,j)*pr_inv_h 
 Tmpv1 =xkmh(i,k,j)*pr_inv_h

 g_xkhh(i,k,j) =g_Tmpv1
 xkhh(i,k,j) =Tmpv1

 g_Tmpv1 =xkmv(i,k,j)*g_pr_inv_v +g_xkmv(i,k,j)*pr_inv_v 
 Tmpv1 =xkmv(i,k,j)*pr_inv_v

 g_xkhv(i,k,j) =g_Tmpv1
 xkhv(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO
 ELSE

 CALL g_calc_l_scale(config_flags,tke,g_tke,BN2,g_BN2,l_scale,g_l_scale, &
 i_start,i_end,ktf,j_start,j_end,dx,dy,rdzw,g_rdzw,msftx,msfty,ids,ide,jds,jde,kds, &
 kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tmp =g_Sqrt((g_tke(i,k,j) +0.0 +(g_tke(i,k,j) -0.0)*sign(1.0, tke(i,k, &
 j) -(tke_seed)))*0.5, max(tke(i,k,j),tke_seed))
 tmp =sqrt(max(tke(i,k,j),tke_seed))

 g_deltas =0.33333333*(-dx/msftx(i,j) *dy/msfty(i,j)*g_rdzw(i,k,j)/(rdzw(i,k,j) &
*rdzw(i,k,j)))*(dx/msftx(i,j) *dy/msfty(i,j)/rdzw(i,k,j))**(0.33333333 -1.0)
 deltas =(dx/msftx(i,j) *dy/msfty(i,j)/rdzw(i,k,j))**0.33333333

 g_Tmpv1 =c_k*g_tmp +g_c_k*tmp 
 Tmpv1 =c_k*tmp

 g_Tmpv2 =Tmpv1*g_l_scale(i,k,j) +g_Tmpv1*l_scale(i,k,j) 
 Tmpv2 =Tmpv1*l_scale(i,k,j)

 g_xkmh(i,k,j) =g_Tmpv2
 xkmh(i,k,j) =Tmpv2

 g_xkmh(i,k,j) =(0.0 +g_xkmh(i,k,j) -(0.0 -g_xkmh(i,k,j))*sign(1.0, &
 mix_upper_bound *dx/msftx(i,j) *dy/msfty(i,j)/dt -(xkmh(i,k,j))))*0.5
 xkmh(i,k,j) =min(mix_upper_bound *dx/msftx(i,j) *dy/msfty(i,j)/dt,xkmh(i,k,j))

 g_Tmpv1 =c_k*g_tmp +g_c_k*tmp 
 Tmpv1 =c_k*tmp

 g_Tmpv2 =Tmpv1*g_l_scale(i,k,j) +g_Tmpv1*l_scale(i,k,j) 
 Tmpv2 =Tmpv1*l_scale(i,k,j)

 g_xkmv(i,k,j) =g_Tmpv2
 xkmv(i,k,j) =Tmpv2

 g_Tmpv1 =((-mix_upper_bound*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))) &
*rdzw(i,k,j) -g_rdzw(i,k,j)*mix_upper_bound/rdzw(i,k,j))/(rdzw(i,k,j)*rdzw(i,k,j))

! Added by Ning Pan, 2010-08-13
 Tmpv1 =mix_upper_bound/rdzw(i,k,j)/rdzw(i,k,j)
 g_xkmv(i,k,j) =(g_Tmpv1/dt +g_xkmv(i,k,j) -(g_Tmpv1/dt -g_xkmv(i,k,j)) &
*sign(1.0, Tmpv1/dt -(xkmv(i,k,j))))*0.5

 xkmv(i,k,j) =min(mix_upper_bound/rdzw(i,k,j)/rdzw(i,k,j)/dt,xkmv(i,k,j))

 g_Tmpv1 =(2.0*g_l_scale(i,k,j)*deltas -g_deltas*2.0*l_scale(i,k,j))/(deltas*deltas) 
 Tmpv1 =2.0*l_scale(i,k,j)/deltas

 g_pr_inv =g_Tmpv1
 pr_inv =1.0 +Tmpv1

 g_Tmpv1 =xkmh(i,k,j)*g_pr_inv +g_xkmh(i,k,j)*pr_inv
 Tmpv1 =xkmh(i,k,j)*pr_inv

 g_xkhh(i,k,j) =(0.0 +g_Tmpv1 -(0.0 -g_Tmpv1)*sign(1.0, mix_upper_bound *dx/ &
 msftx(i,j) *dy/msfty(i,j)/dt -(Tmpv1)))*0.5
 xkhh(i,k,j) =min(mix_upper_bound *dx/msftx(i,j) *dy/msfty(i,j)/dt,Tmpv1)

 g_Tmpv1 =((-mix_upper_bound*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))) &
*rdzw(i,k,j) -g_rdzw(i,k,j)*mix_upper_bound/rdzw(i,k,j))/(rdzw(i,k,j)*rdzw(i,k,j))
 Tmpv1 =mix_upper_bound/rdzw(i,k,j)/rdzw(i,k,j)

 g_Tmpv2 =xkmv(i,k,j)*g_pr_inv +g_xkmv(i,k,j)*pr_inv
 Tmpv2 =xkmv(i,k,j)*pr_inv

 g_xkhv(i,k,j) =(g_Tmpv1/dt +g_Tmpv2 -(g_Tmpv1/dt -g_Tmpv2) &
*sign(1.0, Tmpv1/dt -(Tmpv2)))*0.5
 xkhv(i,k,j) =min(Tmpv1/dt,Tmpv2)

 ENDDO
 ENDDO
 ENDDO
 END IF

 END SUBROUTINE g_tke_km

 SUBROUTINE g_tke_rhs(tendency,g_tendency,BN2,g_BN2,config_flags,defor11, &
 g_defor11,defor22,g_defor22,defor33,g_defor33,defor12,g_defor12,defor13, &
 g_defor13,defor23,g_defor23,u,g_u,v,g_v,w,g_w,div,g_div,tke, &
 g_tke,mu,g_mu,theta,g_theta,p,g_p,p8w,g_p8w,t8w,g_t8w,z,g_z,fnm, &
 fnp,cf1,cf2,cf3,msftx,msfty,xkmh,g_xkmh,xkmv,g_xkmv,xkhv,g_xkhv,rdx,rdy,dx, &
 dy,dt,zx,g_zx,zy,g_zy,rdz,g_rdz,rdzw,g_rdzw,dn,dnw,isotropic,hfx, &
 g_hfx,qfx,g_qfx,qv,g_qv,ust,g_ust,rho,g_rho,ids,ide,jds,jde,kds,kde, &
 ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 INTEGER :: isotropic
 REAL :: cf1,cf2,cf3,dt,rdx,rdy,dx,dy
 REAL,DIMENSION(kms:kme) :: fnm,fnp,dnw,dn
 REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,g_tendency
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor11,g_defor11,defor22,g_defor22, &
 defor33,g_defor33,defor12,g_defor12,defor13,g_defor13,defor23,g_defor23, &
 div,g_div,BN2,g_BN2,tke,g_tke,xkmh,g_xkmh,xkmv,g_xkmv,xkhv,g_xkhv, &
 zx,g_zx,zy,g_zy,u,g_u,v,g_v,w,g_w,theta,g_theta,p,g_p,p8w, &
 g_p8w,t8w,g_t8w,z,g_z,rdz,g_rdz,rdzw,g_rdzw
 REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 REAL,DIMENSION(ims:ime,jms:jme) :: hfx,g_hfx,ust,g_ust,qfx,g_qfx
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: qv,g_qv,rho,g_rho
 INTEGER :: i,j,k,ktf,i_start,i_end,j_start,j_end

 CALL g_tke_shear(tendency,g_tendency,config_flags,defor11,g_defor11,defor22, &
 g_defor22,defor33,g_defor33,defor12,g_defor12,defor13,g_defor13,defor23, &
 g_defor23,u,g_u,v,g_v,w,g_w,tke,g_tke,ust,g_ust,mu,g_mu,fnm,fnp, &
 cf1,cf2,cf3,msftx,msfty,xkmh,g_xkmh,xkmv,g_xkmv,rdx,rdy,zx,g_zx,zy,g_zy, &
 rdz,g_rdz,rdzw,g_rdzw,dnw,dn,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
 its,ite,jts,jte,kts,kte)

 CALL g_tke_buoyancy(tendency,g_tendency,config_flags,mu,g_mu,tke,g_tke, &
 xkhv,g_xkhv,BN2,g_BN2,theta,g_theta,dt,hfx,g_hfx,qfx,g_qfx,qv,g_qv, &
 rho,g_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 CALL g_tke_dissip(tendency,g_tendency,config_flags,mu,g_mu,tke,g_tke,bn2, &
 g_bn2,theta,g_theta,p8w,g_p8w,t8w,g_t8w,z,g_z,dx,dy,rdz,g_rdz,rdzw, &
 g_rdzw,isotropic,msftx,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its, &
 ite,jts,jte,kts,kte)

 ktf =min(kte,kde-1)

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .or. config_flags%specified .or.   &
         config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .or. config_flags%specified .or.   &
         config_flags%nested) i_end =min(ide-2,ite)

 IF( config_flags%open_ys .or. config_flags%specified .or.   &
         config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .or. config_flags%specified .or.   &
         config_flags%nested) j_end =min(jde-2,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide-1)

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =-mu(i,j)*(0.0 +g_tke(i,k,j) +(0.0 -g_tke(i,k,j))*sign(1.0, 0.0 -( &
 tke(i,k,j))))*0.5 -g_mu(i,j)*max(0.0,tke(i,k,j)) 
 Tmpv1 =-mu(i,j)*max(0.0,tke(i,k,j))

 g_tendency(i,k,j) =(g_tendency(i,k,j) +(g_Tmpv1/dt) +(g_tendency(i,k,j) &
 -(g_Tmpv1/dt))*sign(1.0, tendency(i,k,j) -(Tmpv1/dt)))*0.5
 tendency(i,k,j) =max(tendency(i,k,j),Tmpv1/dt)

 ENDDO
 ENDDO
 ENDDO

 END SUBROUTINE g_tke_rhs

 SUBROUTINE g_calc_l_scale(config_flags,tke,g_tke,BN2,g_BN2,l_scale, &
 g_l_scale,i_start,i_end,ktf,j_start,j_end,dx,dy,rdzw,g_rdzw,msftx,msfty,ids, &
 ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4

   REAL :: g_Sqrt
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: i_start,i_end,ktf,j_start,j_end,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
 kms,kme,its,ite,jts,jte,kts,kte
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: BN2,g_BN2,tke,g_tke,rdzw,g_rdzw
 REAL :: dx,dy
 REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: l_scale,g_l_scale
 REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
 INTEGER :: i,j,k
 REAL :: deltas,g_deltas,tmp,g_tmp

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_deltas =0.33333333*(-dx/msftx(i,j) *dy/msfty(i,j)*g_rdzw(i,k,j)/(rdzw(i,k,j) &
*rdzw(i,k,j)))*(dx/msftx(i,j) *dy/msfty(i,j)/rdzw(i,k,j))**(0.33333333 -1.0)
 deltas =(dx/msftx(i,j) *dy/msfty(i,j)/rdzw(i,k,j))**0.33333333

 g_l_scale(i,k,j) =g_deltas
 l_scale(i,k,j) =deltas

 IF( BN2(i,k,j) .gt. 1.0e-6 ) THEN

 g_tmp =g_Sqrt((g_tke(i,k,j) +0.0 +(g_tke(i,k,j) -0.0)*sign(1.0, tke(i,k, &
 j) -(1.0e-6)))*0.5, max(tke(i,k,j),1.0e-6))
 tmp =sqrt(max(tke(i,k,j),1.0e-6))

 g_Tmpv1 =(0.76*g_tmp*sqrt(BN2(i,k,j)) -g_Sqrt(g_BN2(i,k,j), BN2(i,k,j)) &
*0.76*tmp)/(sqrt(BN2(i,k,j))*sqrt(BN2(i,k,j))) 
 Tmpv1 =0.76*tmp/sqrt(BN2(i,k,j))

 g_l_scale(i,k,j) =g_Tmpv1
 l_scale(i,k,j) =Tmpv1

 g_l_scale(i,k,j) =(g_l_scale(i,k,j) +g_deltas -(g_l_scale(i,k,j) &
 -g_deltas)*sign(1.0, l_scale(i,k,j) -(deltas)))*0.5
 l_scale(i,k,j) =min(l_scale(i,k,j),deltas)

 g_l_scale(i,k,j) =(g_l_scale(i,k,j) +0.001*g_deltas +(g_l_scale(i,k,j) &
 -0.001*g_deltas)*sign(1.0, l_scale(i,k,j) -(0.001*deltas)))*0.5
 l_scale(i,k,j) =max(l_scale(i,k,j),0.001*deltas)

 END IF
 ENDDO
 ENDDO
 ENDDO

 END SUBROUTINE g_calc_l_scale

 SUBROUTINE g_tke_buoyancy(tendency,g_tendency,config_flags,mu,g_mu,tke, &
 g_tke,xkhv,g_xkhv,BN2,g_BN2,theta,g_theta,dt,hfx,g_hfx,qfx,g_qfx, &
 qv,g_qv,rho,g_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts, &
 jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 REAL :: dt
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,g_tendency
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkhv,g_xkhv,tke,g_tke,BN2,g_BN2, &
 theta,g_theta
 REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: qv,g_qv,rho,g_rho
 REAL,DIMENSION(ims:ime,jms:jme) :: hfx,g_hfx,qfx,g_qfx
 INTEGER :: i,j,k,ktf
 INTEGER :: i_start,i_end,j_start,j_end
 REAL :: heat_flux,g_heat_flux,heat_flux0,g_heat_flux0
 REAL :: cpm,g_cpm

 ktf =min(kte,kde-1)

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
         config_flags%nested ) i_start =max(ids+1,its)

 IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
         config_flags%nested ) i_end =min(ide-2,ite)

 IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
         config_flags%nested ) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
         config_flags%nested ) j_end =min(jde-2,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide-1)

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =mu(i,j)*g_xkhv(i,k,j) +g_mu(i,j)*xkhv(i,k,j) 
 Tmpv1 =mu(i,j)*xkhv(i,k,j)

 g_Tmpv2 =Tmpv1*g_BN2(i,k,j) +g_Tmpv1*BN2(i,k,j) 
 Tmpv2 =Tmpv1*BN2(i,k,j)

 g_tendency(i,k,j) =g_tendency(i,k,j) -g_Tmpv2
 tendency(i,k,j) =tendency(i,k,j) -Tmpv2

 ENDDO
 ENDDO
 ENDDO

! Added by Ning Pan, 2010-08-12
 tl_hflux: SELECT CASE( config_flags%isfflx )
 CASE (0,2)

! g_heat_flux0 =g_config_flags%tke_heat_flux  ! Remarked by Ning Pan, 2010-08-12
 heat_flux0 =config_flags%tke_heat_flux

 K =KTS

 DO j =j_start,j_end
 DO i =i_start,i_end

! g_heat_flux =g_heat_flux0  ! Remarked by Ning Pan, 2010-08-12
 heat_flux =heat_flux0

 g_Tmpv1 =xkhv(i,k,j)*g_BN2(i,k,j) +g_xkhv(i,k,j)*BN2(i,k,j) 
 Tmpv1 =xkhv(i,k,j)*BN2(i,k,j)

! Revised by Ning Pan, 2010-08-12
! g_Tmpv2 =(g/theta(i,k,j))*g_heat_flux +(-g*g_theta(i,k,j)/(theta(i,k,j) &
!*theta(i,k,j)))*heat_flux 
 g_Tmpv2 =(-g*g_theta(i,k,j)/(theta(i,k,j) &
*theta(i,k,j)))*heat_flux 
 Tmpv2 =(g/theta(i,k,j))*heat_flux

 g_Tmpv3 =mu(i,j)*((g_Tmpv1) -g_Tmpv2) +g_mu(i,j)*((Tmpv1) -Tmpv2) 
 Tmpv3 =mu(i,j)*((Tmpv1) -Tmpv2)

 g_tendency(i,k,j) =g_tendency(i,k,j) -(g_Tmpv3/2.)
 tendency(i,k,j) =tendency(i,k,j) -Tmpv3/2.

 ENDDO
 ENDDO

 CASE (1)  ! Added by Ning Pan, 2010-08-12 

 K =KTS

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_cpm =cp*(0.8*g_qv(i,k,j))
 cpm =cp*(1. +0.8*qv(i,k,j))

 g_Tmpv1 =(g_hfx(i,j)*cpm -g_cpm*hfx(i,j))/(cpm*cpm) 
 Tmpv1 =hfx(i,j)/cpm

 g_Tmpv2 =((g_Tmpv1)*rho(i,k,j) -g_rho(i,k,j)*(Tmpv1))/(rho(i,k,j)*rho(i,k,j)) 
 Tmpv2 =(Tmpv1)/rho(i,k,j)

 g_heat_flux =g_Tmpv2
 heat_flux =Tmpv2

 g_Tmpv1 =xkhv(i,k,j)*g_BN2(i,k,j) +g_xkhv(i,k,j)*BN2(i,k,j) 
 Tmpv1 =xkhv(i,k,j)*BN2(i,k,j)

 g_Tmpv2 =(g/theta(i,k,j))*g_heat_flux +(-g*g_theta(i,k,j)/(theta(i,k,j) &
*theta(i,k,j)))*heat_flux 
 Tmpv2 =(g/theta(i,k,j))*heat_flux

 g_Tmpv3 =mu(i,j)*((g_Tmpv1) -g_Tmpv2) +g_mu(i,j)*((Tmpv1) -Tmpv2) 
 Tmpv3 =mu(i,j)*((Tmpv1) -Tmpv2)

 g_tendency(i,k,j) =g_tendency(i,k,j) -(g_Tmpv3/2.)
 tendency(i,k,j) =tendency(i,k,j) -Tmpv3/2.

 ENDDO
 ENDDO

 CASE DEFAULT  ! Added by Ning Pan, 2010-08-12
! Revised by Ning Pan, 2010-08-12
! CALL g_wrf_error_fatal('isfflx value invalid for diff_opt=2')
 CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' )
 END SELECT tl_hflux  ! Added by Ning Pan, 2010-08-12

 END SUBROUTINE g_tke_buoyancy

 SUBROUTINE g_tke_dissip(tendency,g_tendency,config_flags,mu,g_mu,tke, &
 g_tke,bn2,g_bn2,theta,g_theta,p8w,g_p8w,t8w,g_t8w,z,g_z,dx,dy,rdz, &
 g_rdz,rdzw,g_rdzw,isotropic,msftx,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms, &
 jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 INTEGER :: isotropic
 REAL :: dx,dy
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,g_tendency
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tke,g_tke,bn2,g_bn2,theta, &
 g_theta,p8w,g_p8w,t8w,g_t8w,z,g_z,rdz,g_rdz,rdzw,g_rdzw
 REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
 REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: dthrdn,g_dthrdn
 REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: l_scale,g_l_scale
 REAL,DIMENSION(its:ite) :: sumtke,g_sumtke,sumtkez,g_sumtkez
 INTEGER :: i,j,k,ktf,i_start,i_end,j_start,j_end
 REAL :: disp_len,g_disp_len,deltas,g_deltas,coefc,g_coefc,tmpdz,g_tmpdz, &
 len_s,g_len_s,thetasfc,g_thetasfc,thetatop,g_thetatop,len_0,g_len_0, &
 tketmp,g_tketmp,tmp,g_tmp,ce1,g_ce1,ce2,g_ce2,c_k,g_c_k

! g_c_k =g_config_flags%c_k  ! Remarked by Ning Pan, 2010-08-12
 c_k =config_flags%c_k

! g_ce1 =(g_c_k/0.10)*0.19  ! Remarked by Ning Pan, 2010-08-12
 ce1 =(c_k/0.10)*0.19

! g_ce2 =(0.0 +-g_ce1 +(0.0 --g_ce1)*sign(1.0, 0.0 -(0.93 -ce1)))*0.5  ! Remarked by Ning Pan, 2010-08-12
 ce2 =max(0.0,0.93 -ce1)

 ktf =min(kte,kde-1)

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
         config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
         config_flags%nested) i_end =min(ide-2,ite)

 IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
         config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
         config_flags%nested) j_end =min(jde-2,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide-1)

 CALL g_calc_l_scale(config_flags,tke,g_tke,BN2,g_BN2,l_scale,g_l_scale, &
 i_start,i_end,ktf,j_start,j_end,dx,dy,rdzw,g_rdzw,msftx,msfty,ids,ide,jds,jde,kds, &
 kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_deltas =0.33333333*(-dx/msftx(i,j) *dy/msfty(i,j)*g_rdzw(i,k,j)/(rdzw(i,k,j) &
*rdzw(i,k,j)))*(dx/msftx(i,j) *dy/msfty(i,j)/rdzw(i,k,j))**(0.33333333 -1.0)
 deltas =(dx/msftx(i,j) *dy/msfty(i,j)/rdzw(i,k,j))**0.33333333

 g_tketmp =(g_tke(i,k,j) +0.0 +(g_tke(i,k,j) -0.0)*sign(1.0, tke(i,k,j) &
 -(1.0e-6)))*0.5
 tketmp =max(tke(i,k,j),1.0e-6)

 IF( k .eq. kts .or. k .eq. ktf ) THEN

 g_coefc =0.0
 coefc =3.9

 ELSE

! Revised by Ning Pan, 2010-08-12
! g_Tmpv1 =ce2*g_l_scale(i,k,j) +g_ce2*l_scale(i,k,j) 
 g_Tmpv1 =ce2*g_l_scale(i,k,j)
 Tmpv1 =ce2*l_scale(i,k,j)

 g_Tmpv2 =(g_Tmpv1*deltas -g_deltas*Tmpv1)/(deltas*deltas) 
 Tmpv2 =Tmpv1/deltas

! Revised by Ning Pan, 2010-08-12
! g_coefc =g_ce1 +g_Tmpv2
 g_coefc =g_Tmpv2
 coefc =ce1 +Tmpv2

 END IF

 g_Tmpv1 =mu(i,j)*g_coefc +g_mu(i,j)*coefc 
 Tmpv1 =mu(i,j)*coefc

 g_Tmpv2 =Tmpv1*1.5*g_tketmp*tketmp**(1.5 -1.0) +g_Tmpv1*tketmp**1.5 
 Tmpv2 =Tmpv1*tketmp**1.5

 g_Tmpv3 =(g_Tmpv2*l_scale(i,k,j) -g_l_scale(i,k,j)*Tmpv2)/(l_scale(i,k,j) &
*l_scale(i,k,j)) 
 Tmpv3 =Tmpv2/l_scale(i,k,j)

 g_tendency(i,k,j) =g_tendency(i,k,j) -g_Tmpv3
 tendency(i,k,j) =tendency(i,k,j) -Tmpv3

 ENDDO
 ENDDO
 ENDDO

 END SUBROUTINE g_tke_dissip

 SUBROUTINE g_tke_shear(tendency,g_tendency,config_flags,defor11,g_defor11, &
 defor22,g_defor22,defor33,g_defor33,defor12,g_defor12,defor13,g_defor13, &
 defor23,g_defor23,u,g_u,v,g_v,w,g_w,tke,g_tke,ust,g_ust,mu,g_mu, &
 fnm,fnp,cf1,cf2,cf3,msftx,msfty,xkmh,g_xkmh,xkmv,g_xkmv,rdx,rdy,zx,g_zx,zy, &
 g_zy,rdz,g_rdz,rdzw,g_rdzw,dn,dnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
 kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4

   REAL :: g_Sqrt
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 REAL :: cf1,cf2,cf3,rdx,rdy
 REAL,DIMENSION(kms:kme) :: fnm,fnp,dn,dnw
 REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,g_tendency
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor11,g_defor11,defor22,g_defor22, &
 defor33,g_defor33,defor12,g_defor12,defor13,g_defor13,defor23,g_defor23, &
 tke,g_tke,xkmh,g_xkmh,xkmv,g_xkmv,zx,g_zx,zy,g_zy,u,g_u,v,g_v,w, &
 g_w,rdz,g_rdz,rdzw,g_rdzw
 REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 REAL,DIMENSION(ims:ime,jms:jme) :: ust,g_ust
 INTEGER :: i,j,k,ktf,ktes1,ktes2,i_start,i_end,j_start,j_end,is_ext,ie_ext,js_ext,je_ext
 REAL :: mtau,g_mtau
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: avg,g_avg,titau,g_titau, &
 tmp2,g_tmp2
 REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: titau12,g_titau12,tmp1,g_tmp1,zxavg, &
 g_zxavg,zyavg,g_zyavg
 REAL :: absU,g_absU,cd0,g_cd0,Cd,g_Cd

 ktf =min(kte,kde-1)

 ktes1 =kte-1

 ktes2 =kte-2

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
         config_flags%nested ) i_start =max(ids+1,its)

 IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
         config_flags%nested ) i_end =min(ide-2,ite)

 IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
         config_flags%nested ) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
         config_flags%nested ) j_end =min(jde-2,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide-1)

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_zxavg(i,k,j) =0.25*(g_zx(i,k,j) +g_zx(i+1,k,j) +g_zx(i,k+1,j) &
 +g_zx(i+1,k+1,j))
 zxavg(i,k,j) =0.25*(zx(i,k,j) +zx(i+1,k,j) +zx(i,k+1,j) +zx(i+1,k+1,j))

 g_zyavg(i,k,j) =0.25*(g_zy(i,k,j) +g_zy(i,k,j+1) +g_zy(i,k+1,j) &
 +g_zy(i,k+1,j+1))
 zyavg(i,k,j) =0.25*(zy(i,k,j) +zy(i,k,j+1) +zy(i,k+1,j) +zy(i,k+1,j+1))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =0.5*mu(i,j)*g_xkmh(i,k,j) +0.5*g_mu(i,j)*xkmh(i,k,j) 
 Tmpv1 =0.5*mu(i,j)*xkmh(i,k,j)

 g_Tmpv2 =Tmpv1*(2.0*(g_defor11(i,k,j))*(defor11(i,k,j))) +g_Tmpv1*(( &
 defor11(i,k,j))**2) 
 Tmpv2 =Tmpv1*((defor11(i,k,j))**2)

 g_tendency(i,k,j) =g_tendency(i,k,j) +g_Tmpv2
 tendency(i,k,j) =tendency(i,k,j) +Tmpv2

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =0.5*mu(i,j)*g_xkmh(i,k,j) +0.5*g_mu(i,j)*xkmh(i,k,j) 
 Tmpv1 =0.5*mu(i,j)*xkmh(i,k,j)

 g_Tmpv2 =Tmpv1*(2.0*(g_defor22(i,k,j))*(defor22(i,k,j))) +g_Tmpv1*(( &
 defor22(i,k,j))**2) 
 Tmpv2 =Tmpv1*((defor22(i,k,j))**2)

 g_tendency(i,k,j) =g_tendency(i,k,j) +g_Tmpv2
 tendency(i,k,j) =tendency(i,k,j) +Tmpv2

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =0.5*mu(i,j)*g_xkmv(i,k,j) +0.5*g_mu(i,j)*xkmv(i,k,j) 
 Tmpv1 =0.5*mu(i,j)*xkmv(i,k,j)

 g_Tmpv2 =Tmpv1*(2.0*(g_defor33(i,k,j))*(defor33(i,k,j))) +g_Tmpv1*(( &
 defor33(i,k,j))**2) 
 Tmpv2 =Tmpv1*((defor33(i,k,j))**2)

 g_tendency(i,k,j) =g_tendency(i,k,j) +g_Tmpv2
 tendency(i,k,j) =tendency(i,k,j) +Tmpv2

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_avg(i,k,j) =0.25*((2.0*g_defor12(i,k,j)*defor12(i,k,j)) +(2.0*g_defor12(i, &
 k,j+1)*defor12(i,k,j+1)) +(2.0*g_defor12(i+1,k,j)*defor12(i+1,k,j)) +(2.0* &
 g_defor12(i+1,k,j+1)*defor12(i+1,k,j+1)))
 avg(i,k,j) =0.25*((defor12(i,k,j)**2) +(defor12(i,k,j+1)**2) +(defor12(i+1,k,j)**2) &
 +(defor12(i+1,k,j+1)**2))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =mu(i,j)*g_xkmh(i,k,j) +g_mu(i,j)*xkmh(i,k,j) 
 Tmpv1 =mu(i,j)*xkmh(i,k,j)

 g_Tmpv2 =Tmpv1*g_avg(i,k,j) +g_Tmpv1*avg(i,k,j) 
 Tmpv2 =Tmpv1*avg(i,k,j)

 g_tendency(i,k,j) =g_tendency(i,k,j) +g_Tmpv2
 tendency(i,k,j) =tendency(i,k,j) +Tmpv2

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end+1

 g_tmp2(i,k,j) =g_defor13(i,k,j)
 tmp2(i,k,j) =defor13(i,k,j)

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end+1

 g_tmp2(i,kts,j) =0.0
 tmp2(i,kts,j) =0.0

 g_tmp2(i,ktf+1,j) =0.0
 tmp2(i,ktf+1,j) =0.0

 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_avg(i,k,j) =0.25*((2.0*g_tmp2(i,k+1,j)*tmp2(i,k+1,j)) +(2.0*g_tmp2(i,k,j) &
*tmp2(i,k,j)) +(2.0*g_tmp2(i+1,k+1,j)*tmp2(i+1,k+1,j)) +(2.0*g_tmp2(i+1,k,j) &
*tmp2(i+1,k,j)))
 avg(i,k,j) =0.25*((tmp2(i,k+1,j)**2) +(tmp2(i,k,j)**2) +(tmp2(i+1,k+1,j)**2) &
 +(tmp2(i+1,k,j)**2))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =mu(i,j)*g_xkmv(i,k,j) +g_mu(i,j)*xkmv(i,k,j) 
 Tmpv1 =mu(i,j)*xkmv(i,k,j)

 g_Tmpv2 =Tmpv1*g_avg(i,k,j) +g_Tmpv1*avg(i,k,j) 
 Tmpv2 =Tmpv1*avg(i,k,j)

 g_tendency(i,k,j) =g_tendency(i,k,j) +g_Tmpv2
 tendency(i,k,j) =tendency(i,k,j) +Tmpv2

 ENDDO
 ENDDO
 ENDDO

 K =KTS

! Added by Ning Pan, 2010-08-12
 tl_uflux: SELECT CASE( config_flags%isfflx )
 CASE (0)

! g_cd0 =g_config_flags%tke_drag_coefficient  ! Remarked by Ning Pan, 2010-08-12
 cd0 =config_flags%tke_drag_coefficient

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_absU =0.5*g_Sqrt(2.0*(g_u(i,k,j) +g_u(i+1,k,j))*(u(i,k,j) +u(i+1,k,j)) &
 +2.0*(g_v(i,k,j) +g_v(i,k,j+1))*(v(i,k,j) +v(i,k,j+1)), (u(i,k,j) +u(i+1,k,j)) &
**2 +(v(i,k,j) +v(i,k,j+1))**2)
 absU =0.5*sqrt((u(i,k,j) +u(i+1,k,j))**2 +(v(i,k,j) +v(i,k,j+1))**2)

! Revised by Ning Pan, 2010-08-12
! g_Cd =g_cd0
 g_Cd =0.0
 Cd =cd0

 g_Tmpv1 =(u(i,k,j) +u(i+1,k,j))*0.5*g_Cd +(g_u(i,k,j) +g_u(i+1,k,j))*0.5*Cd 
 Tmpv1 =(u(i,k,j) +u(i+1,k,j))*0.5*Cd

 g_Tmpv2 =Tmpv1*g_absU +g_Tmpv1*absU 
 Tmpv2 =Tmpv1*absU

 g_Tmpv3 =Tmpv2*(g_defor13(i,kts+1,j) +g_defor13(i+1,kts+1,j)) &
 +g_Tmpv2*(defor13(i,kts+1,j) +defor13(i+1,kts+1,j)) 
 Tmpv3 =Tmpv2*(defor13(i,kts+1,j) +defor13(i+1,kts+1,j))

 g_Tmpv4 =mu(i,j)*(g_Tmpv3*0.5) +g_mu(i,j)*(Tmpv3*0.5) 
 Tmpv4 =mu(i,j)*(Tmpv3*0.5)

 g_tendency(i,k,j) =g_tendency(i,k,j) +g_Tmpv4
 tendency(i,k,j) =tendency(i,k,j) +Tmpv4

 ENDDO
 ENDDO

 CASE (1,2)  ! Added by Ning Pan, 2010-08-12

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_absU =0.5*g_Sqrt(2.0*(g_u(i,k,j) +g_u(i+1,k,j))*(u(i,k,j) +u(i+1,k,j)) &
 +2.0*(g_v(i,k,j) +g_v(i,k,j+1))*(v(i,k,j) +v(i,k,j+1)), (u(i,k,j) +u(i+1,k,j)) &
**2 +(v(i,k,j) +v(i,k,j+1))**2)
 absU =0.5*sqrt((u(i,k,j) +u(i+1,k,j))**2 +(v(i,k,j) +v(i,k,j+1))**2) +epsilon

 g_Tmpv1 =((2.0*g_ust(i,j)*ust(i,j))*(absU**2) -(2.0*g_absU*absU)*(ust(i,j) &
**2))/((absU**2)*(absU**2)) 
 Tmpv1 =(ust(i,j)**2)/(absU**2)

 g_Cd =g_Tmpv1
 Cd =Tmpv1

 g_Tmpv1 =(u(i,k,j) +u(i+1,k,j))*0.5*g_Cd +(g_u(i,k,j) +g_u(i+1,k,j))*0.5*Cd 
 Tmpv1 =(u(i,k,j) +u(i+1,k,j))*0.5*Cd

 g_Tmpv2 =Tmpv1*g_absU +g_Tmpv1*absU 
 Tmpv2 =Tmpv1*absU

 g_Tmpv3 =Tmpv2*(g_defor13(i,kts+1,j) +g_defor13(i+1,kts+1,j)) &
 +g_Tmpv2*(defor13(i,kts+1,j) +defor13(i+1,kts+1,j)) 
 Tmpv3 =Tmpv2*(defor13(i,kts+1,j) +defor13(i+1,kts+1,j))

 g_Tmpv4 =mu(i,j)*(g_Tmpv3*0.5) +g_mu(i,j)*(Tmpv3*0.5) 
 Tmpv4 =mu(i,j)*(Tmpv3*0.5)

 g_tendency(i,k,j) =g_tendency(i,k,j) +g_Tmpv4
 tendency(i,k,j) =tendency(i,k,j) +Tmpv4

 ENDDO
 ENDDO

 CASE DEFAULT  ! Added by Ning Pan, 2010-08-12
! Revised by Ning Pan, 2010-08-12
! CALL g_wrf_error_fatal('isfflx value invalid for diff_opt=2')
 CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')
 END SELECT tl_uflux  ! Added by Ning Pan, 2010-08-12

 DO j =j_start,j_end+1
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_tmp2(i,k,j) =g_defor23(i,k,j)
 tmp2(i,k,j) =defor23(i,k,j)

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end+1
 DO i =i_start,i_end

 g_tmp2(i,kts,j) =0.0
 tmp2(i,kts,j) =0.0

 g_tmp2(i,ktf+1,j) =0.0
 tmp2(i,ktf+1,j) =0.0

 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_avg(i,k,j) =0.25*((2.0*g_tmp2(i,k+1,j)*tmp2(i,k+1,j)) +(2.0*g_tmp2(i,k,j) &
*tmp2(i,k,j)) +(2.0*g_tmp2(i,k+1,j+1)*tmp2(i,k+1,j+1)) +(2.0*g_tmp2(i,k,j+1) &
*tmp2(i,k,j+1)))
 avg(i,k,j) =0.25*((tmp2(i,k+1,j)**2) +(tmp2(i,k,j)**2) +(tmp2(i,k+1,j+1)**2) &
 +(tmp2(i,k,j+1)**2))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =mu(i,j)*g_xkmv(i,k,j) +g_mu(i,j)*xkmv(i,k,j) 
 Tmpv1 =mu(i,j)*xkmv(i,k,j)

 g_Tmpv2 =Tmpv1*g_avg(i,k,j) +g_Tmpv1*avg(i,k,j) 
 Tmpv2 =Tmpv1*avg(i,k,j)

 g_tendency(i,k,j) =g_tendency(i,k,j) +g_Tmpv2
 tendency(i,k,j) =tendency(i,k,j) +Tmpv2

 ENDDO
 ENDDO
 ENDDO

 K =KTS

! Added by Ning Pan, 2010-08-12
 tl_vflux: SELECT CASE( config_flags%isfflx )
 CASE (0)

! g_cd0 =g_config_flags%tke_drag_coefficient  ! Remarked by Ning Pan, 2010-08-12
 cd0 =config_flags%tke_drag_coefficient

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_absU =0.5*g_Sqrt(2.0*(g_u(i,k,j) +g_u(i+1,k,j))*(u(i,k,j) +u(i+1,k,j)) &
 +2.0*(g_v(i,k,j) +g_v(i,k,j+1))*(v(i,k,j) +v(i,k,j+1)), (u(i,k,j) +u(i+1,k,j)) &
**2 +(v(i,k,j) +v(i,k,j+1))**2)
 absU =0.5*sqrt((u(i,k,j) +u(i+1,k,j))**2 +(v(i,k,j) +v(i,k,j+1))**2)

! Revised by Ning Pan, 2010-08-12
! g_Cd =g_cd0
 g_Cd =0.0
 Cd =cd0

 g_Tmpv1 =(v(i,k,j) +v(i,k,j+1))*0.5*g_Cd +(g_v(i,k,j) +g_v(i,k,j+1))*0.5*Cd 
 Tmpv1 =(v(i,k,j) +v(i,k,j+1))*0.5*Cd

 g_Tmpv2 =Tmpv1*g_absU +g_Tmpv1*absU 
 Tmpv2 =Tmpv1*absU

 g_Tmpv3 =Tmpv2*(g_defor23(i,kts+1,j) +g_defor23(i,kts+1,j+1)) &
 +g_Tmpv2*(defor23(i,kts+1,j) +defor23(i,kts+1,j+1)) 
 Tmpv3 =Tmpv2*(defor23(i,kts+1,j) +defor23(i,kts+1,j+1))

 g_Tmpv4 =mu(i,j)*(g_Tmpv3*0.5) +g_mu(i,j)*(Tmpv3*0.5) 
 Tmpv4 =mu(i,j)*(Tmpv3*0.5)

 g_tendency(i,k,j) =g_tendency(i,k,j) +g_Tmpv4
 tendency(i,k,j) =tendency(i,k,j) +Tmpv4

 ENDDO
 ENDDO

 CASE (1,2)  ! Added by Ning Pan, 2010-08-12

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_absU =0.5*g_Sqrt(2.0*(g_u(i,k,j) +g_u(i+1,k,j))*(u(i,k,j) +u(i+1,k,j)) &
 +2.0*(g_v(i,k,j) +g_v(i,k,j+1))*(v(i,k,j) +v(i,k,j+1)), (u(i,k,j) +u(i+1,k,j)) &
**2 +(v(i,k,j) +v(i,k,j+1))**2)
 absU =0.5*sqrt((u(i,k,j) +u(i+1,k,j))**2 +(v(i,k,j) +v(i,k,j+1))**2) +epsilon

 g_Tmpv1 =((2.0*g_ust(i,j)*ust(i,j))*(absU**2) -(2.0*g_absU*absU)*(ust(i,j) &
**2))/((absU**2)*(absU**2)) 
 Tmpv1 =(ust(i,j)**2)/(absU**2)

 g_Cd =g_Tmpv1
 Cd =Tmpv1

 g_Tmpv1 =(v(i,k,j) +v(i,k,j+1))*0.5*g_Cd +(g_v(i,k,j) +g_v(i,k,j+1))*0.5*Cd 
 Tmpv1 =(v(i,k,j) +v(i,k,j+1))*0.5*Cd

 g_Tmpv2 =Tmpv1*g_absU +g_Tmpv1*absU 
 Tmpv2 =Tmpv1*absU

 g_Tmpv3 =Tmpv2*(g_defor23(i,kts+1,j) +g_defor23(i,kts+1,j+1)) &
 +g_Tmpv2*(defor23(i,kts+1,j) +defor23(i,kts+1,j+1)) 
 Tmpv3 =Tmpv2*(defor23(i,kts+1,j) +defor23(i,kts+1,j+1))

 g_Tmpv4 =mu(i,j)*(g_Tmpv3*0.5) +g_mu(i,j)*(Tmpv3*0.5) 
 Tmpv4 =mu(i,j)*(Tmpv3*0.5)

 g_tendency(i,k,j) =g_tendency(i,k,j) +g_Tmpv4
 tendency(i,k,j) =tendency(i,k,j) +Tmpv4

 ENDDO
 ENDDO

 CASE DEFAULT  ! Added by Ning Pan, 2010-08-12
! Revised by Ning Pan, 2010-08-12
! CALL g_wrf_error_fatal('isfflx value invalid for diff_opt=2')
    CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' )
 END SELECT tl_vflux  ! Added by Ning Pan, 2010-08-12

 END SUBROUTINE g_tke_shear

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of compute_diff_metrics in forward (tangent) mode:
!   variations   of useful results: zx zy z rdzw rdz
!   with respect to varying inputs: zx zy z rdzw rdz ph
!   RW status of diff variables: zx:in-out zy:in-out z:in-out rdzw:in-out
!                rdz:in-out ph:in
SUBROUTINE G_COMPUTE_DIFF_METRICS(config_flags, ph, phd, phb, z, zd, rdz&
&  , rdzd, rdzw, rdzwd, zx, zxd, zy, zyd, rdx, rdy, ids, ide, jds, jde, &
&  kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
  IMPLICIT NONE
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: ph, phb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: phd
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: rdz, rdzw, &
&  zx, zy, z
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: rdzd, rdzwd&
&  , zxd, zyd, zd
  REAL, INTENT(IN) :: rdx, rdy
! Local variables.
  REAL, DIMENSION(its - 1:ite, kts:kte, jts - 1:jte) :: z_at_w
  REAL, DIMENSION(its-1:ite, kts:kte, jts-1:jte) :: z_at_wd
  INTEGER :: i, j, k, i_start, i_end, j_start, j_end, ktf
  INTEGER :: min1
  INTEGER :: max4
  INTEGER :: max3
  INTEGER :: max2
  INTEGER :: max1

  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
! Bug fix, WCS, 22 april 2002.
! We need rdzw in halo for average to u and v points.
  j_start = jts - 1
  j_end = jte
  z_at_wd = 0.0
! Begin with dz computations.
  DO j=j_start,j_end
    IF (jte .GT. jde - 1) THEN
      min1 = jde - 1
    ELSE
      min1 = jte
    END IF
    IF (j_start .GE. jts .AND. j_end .LE. min1) THEN
      i_start = its - 1
      i_end = ite
    ELSE
      i_start = its
      IF (ite .GT. ide - 1) THEN
        i_end = ide - 1
      ELSE
        i_end = ite
      END IF
    END IF
! Compute z at w points for rdz and rdzw computations.  We'll switch z
! to z at p points before returning
    DO k=1,kte
! Bug fix, WCS, 22 april 2002
      DO i=i_start,i_end
        z_at_wd(i, k, j) = phd(i, k, j)/g
        z_at_w(i, k, j) = (ph(i, k, j)+phb(i, k, j))/g
      END DO
    END DO
    DO k=1,ktf
      DO i=i_start,i_end
        rdzwd(i, k, j) = -((z_at_wd(i, k+1, j)-z_at_wd(i, k, j))/(z_at_w&
&          (i, k+1, j)-z_at_w(i, k, j))**2)
        rdzw(i, k, j) = 1.0/(z_at_w(i, k+1, j)-z_at_w(i, k, j))
      END DO
    END DO
    DO k=2,ktf
      DO i=i_start,i_end
        rdzd(i, k, j) = -(2.0*(z_at_wd(i, k+1, j)-z_at_wd(i, k-1, j))/(&
&          z_at_w(i, k+1, j)-z_at_w(i, k-1, j))**2)
        rdz(i, k, j) = 2.0/(z_at_w(i, k+1, j)-z_at_w(i, k-1, j))
      END DO
    END DO
! Bug fix, WCS, 22 april 2002; added the following code
    DO i=i_start,i_end
      rdzd(i, 1, j) = -(2.*(z_at_wd(i, 2, j)-z_at_wd(i, 1, j))/(z_at_w(i&
&        , 2, j)-z_at_w(i, 1, j))**2)
      rdz(i, 1, j) = 2./(z_at_w(i, 2, j)-z_at_w(i, 1, j))
    END DO
  END DO
! End bug fix.
! Now compute zx and zy; we'll assume that the halo for ph and phb is
! properly filled.
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
  DO j=j_start,j_end
    DO k=1,kte
      IF (ids + 1 .LT. its) THEN
        max1 = its
      ELSE
        max1 = ids + 1
      END IF
      DO i=max1,i_end
        zxd(i, k, j) = 0.0
        zx(i, k, j) = rdx*(phb(i, k, j)-phb(i-1, k, j))/g
      END DO
    END DO
  END DO
  DO j=j_start,j_end
    DO k=1,kte
      IF (ids + 1 .LT. its) THEN
        max2 = its
      ELSE
        max2 = ids + 1
      END IF
      DO i=max2,i_end
        zxd(i, k, j) = zxd(i, k, j) + rdx*(phd(i, k, j)-phd(i-1, k, j))/&
&          g
        zx(i, k, j) = zx(i, k, j) + rdx*(ph(i, k, j)-ph(i-1, k, j))/g
      END DO
    END DO
  END DO
  IF (jds + 1 .LT. jts) THEN
    max3 = jts
  ELSE
    max3 = jds + 1
  END IF
  DO j=max3,j_end
    DO k=1,kte
      DO i=i_start,i_end
        zyd(i, k, j) = 0.0
        zy(i, k, j) = rdy*(phb(i, k, j)-phb(i, k, j-1))/g
      END DO
    END DO
  END DO
  IF (jds + 1 .LT. jts) THEN
    max4 = jts
  ELSE
    max4 = jds + 1
  END IF
  DO j=max4,j_end
    DO k=1,kte
      DO i=i_start,i_end
        zyd(i, k, j) = zyd(i, k, j) + rdy*(phd(i, k, j)-phd(i, k, j-1))/&
&          g
        zy(i, k, j) = zy(i, k, j) + rdy*(ph(i, k, j)-ph(i, k, j-1))/g
      END DO
    END DO
  END DO
! Some b.c. on zx and zy.
  IF (.NOT.config_flags%periodic_x) THEN
    IF (ite .EQ. ide) THEN
      DO j=j_start,j_end
        DO k=1,ktf
          zxd(ide, k, j) = 0.0
          zx(ide, k, j) = 0.0
        END DO
      END DO
    END IF
    IF (its .EQ. ids) THEN
      DO j=j_start,j_end
        DO k=1,ktf
          zxd(ids, k, j) = 0.0
          zx(ids, k, j) = 0.0
        END DO
      END DO
    END IF
  ELSE
    IF (ite .EQ. ide) THEN
      DO j=j_start,j_end
        DO k=1,ktf
          zxd(ide, k, j) = 0.0
          zx(ide, k, j) = rdx*(phb(ide, k, j)-phb(ide-1, k, j))/g
        END DO
      END DO
      DO j=j_start,j_end
        DO k=1,ktf
          zxd(ide, k, j) = zxd(ide, k, j) + rdx*(phd(ide, k, j)-phd(ide-&
&            1, k, j))/g
          zx(ide, k, j) = zx(ide, k, j) + rdx*(ph(ide, k, j)-ph(ide-1, k&
&            , j))/g
        END DO
      END DO
    END IF
    IF (its .EQ. ids) THEN
      DO j=j_start,j_end
        DO k=1,ktf
          zxd(ids, k, j) = 0.0
          zx(ids, k, j) = rdx*(phb(ids, k, j)-phb(ids-1, k, j))/g
        END DO
      END DO
      DO j=j_start,j_end
        DO k=1,ktf
          zxd(ids, k, j) = zxd(ids, k, j) + rdx*(phd(ids, k, j)-phd(ids-&
&            1, k, j))/g
          zx(ids, k, j) = zx(ids, k, j) + rdx*(ph(ids, k, j)-ph(ids-1, k&
&            , j))/g
        END DO
      END DO
    END IF
  END IF
  IF (.NOT.config_flags%periodic_y) THEN
    IF (jte .EQ. jde) THEN
      DO k=1,ktf
        DO i=i_start,i_end
          zyd(i, k, jde) = 0.0
          zy(i, k, jde) = 0.0
        END DO
      END DO
    END IF
    IF (jts .EQ. jds) THEN
      DO k=1,ktf
        DO i=i_start,i_end
          zyd(i, k, jds) = 0.0
          zy(i, k, jds) = 0.0
        END DO
      END DO
    END IF
  ELSE
    IF (jte .EQ. jde) THEN
     DO k=1,ktf
        DO i =i_start, i_end
          zyd(i, k, jde) = 0.0
          zy(i, k, jde) = rdy*(phb(i, k, jde)-phb(i, k, jde-1))/g
        END DO
      END DO
     DO k=1,ktf
        DO i =i_start, i_end
          zyd(i, k, jde) = zyd(i, k, jde) + rdy*(phd(i, k, jde)-phd(i, k&
&            , jde-1))/g
          zy(i, k, jde) = zy(i, k, jde) + rdy*(ph(i, k, jde)-ph(i, k, &
&            jde-1))/g
        END DO
      END DO
    END IF
    IF (jts .EQ. jds) THEN
      DO k=1,ktf
        DO i =i_start, i_end
          zyd(i, k, jds) = 0.0
          zy(i, k, jds) = rdy*(phb(i, k, jds)-phb(i, k, jds-1))/g
        END DO
      END DO
      DO k=1,ktf
         DO i =i_start, i_end
          zyd(i, k, jds) = zyd(i, k, jds) + rdy*(phd(i, k, jds)-phd(i, k&
&            , jds-1))/g
          zy(i, k, jds) = zy(i, k, jds) + rdy*(ph(i, k, jds)-ph(i, k, &
&            jds-1))/g
        END DO
      END DO
    END IF
  END IF
! Calculate z at p points.
  DO j=j_start,j_end
    DO k=1,ktf
      DO i=i_start,i_end
        zd(i, k, j) = 0.5*(phd(i, k, j)+phd(i, k+1, j))/g
        z(i, k, j) = 0.5*(ph(i, k, j)+phb(i, k, j)+ph(i, k+1, j)+phb(i, &
&          k+1, j))/g
      END DO
    END DO
  END DO
END SUBROUTINE G_COMPUTE_DIFF_METRICS

 SUBROUTINE g_horizontal_diffusion_2(rt_tendf,g_rt_tendf,ru_tendf,g_ru_tendf, &
 rv_tendf,g_rv_tendf,rw_tendf,g_rw_tendf,tke_tendf,g_tke_tendf,moist_tendf, &
 g_moist_tendf,n_moist,chem_tendf,g_chem_tendf,n_chem,scalar_tendf, &
 g_scalar_tendf,n_scalar,tracer_tendf,g_tracer_tendf,n_tracer,thp,g_thp, &
 theta,g_theta,mu,g_mu,tke,g_tke,config_flags,defor11,g_defor11,defor22, &
 g_defor22,defor12,g_defor12,defor13,g_defor13,defor23,g_defor23,nba_mij, &
 g_nba_mij,n_nba_mij,div,g_div,moist,g_moist,chem,g_chem,scalar, &
 g_scalar,tracer,g_tracer,msfux,msfuy,msfvx,msfvy,msftx,msfty,xkmh,g_xkmh, &
 xkhh,g_xkhh,km_opt,rdx,rdy,rdz,g_rdz,rdzw,g_rdzw,fnm,fnp,cf1,cf2,cf3,zx, &
 g_zx,zy,g_zy,dn,dnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite, &
 jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 INTEGER :: n_moist,n_chem,n_scalar,n_tracer,km_opt
 REAL :: cf1,cf2,cf3
 REAL,DIMENSION(kms:kme) :: fnm
 REAL,DIMENSION(kms:kme) :: fnp
 REAL,DIMENSION(kms:kme) :: dnw
 REAL,DIMENSION(kms:kme) :: dn
 REAL,DIMENSION(ims:ime,jms:jme) :: msfux,msfuy,msfvx,msfvy,msftx,msfty,mu,g_mu
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rt_tendf,g_rt_tendf,ru_tendf, &
 g_ru_tendf,rv_tendf,g_rv_tendf,rw_tendf,g_rw_tendf,tke_tendf,g_tke_tendf
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist_tendf,g_moist_tendf
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_chem) :: chem_tendf,g_chem_tendf
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_scalar) :: scalar_tendf,g_scalar_tendf
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_tracer) :: tracer_tendf,g_tracer_tendf
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist,g_moist
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_chem) :: chem,g_chem
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_scalar) :: scalar,g_scalar
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_tracer) :: tracer,g_tracer
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor11,g_defor11,defor22,g_defor22, &
 defor12,g_defor12,defor13,g_defor13,defor23,g_defor23,div,g_div,xkmh, &
 g_xkmh,xkhh,g_xkhh,zx,g_zx,zy,g_zy,theta,g_theta,thp,g_thp,tke, &
 g_tke,rdz,g_rdz,rdzw,g_rdzw
 REAL :: rdx,rdy

 INTEGER :: n_nba_mij

 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,g_nba_mij
 INTEGER :: im,ic,is

 CALL g_horizontal_diffusion_u_2(ru_tendf,g_ru_tendf,mu,g_mu,config_flags, &
 defor11,g_defor11,defor12,g_defor12,div,g_div,nba_mij,g_nba_mij, &
 n_nba_mij,tke(ims,kms,jms),g_tke(ims,kms,jms),msfux,msfuy,xkmh,g_xkmh,rdx,rdy, &
 fnm,fnp,zx,g_zx,zy,g_zy,rdzw,g_rdzw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
 kms,kme,its,ite,jts,jte,kts,kte)

 CALL g_horizontal_diffusion_v_2(rv_tendf,g_rv_tendf,mu,g_mu,config_flags, &
 defor12,g_defor12,defor22,g_defor22,div,g_div,nba_mij,g_nba_mij, &
 n_nba_mij,tke(ims,kms,jms),g_tke(ims,kms,jms),msfvx,msfvy,xkmh,g_xkmh,rdx,rdy, &
 fnm,fnp,zx,g_zx,zy,g_zy,rdzw,g_rdzw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
 kms,kme,its,ite,jts,jte,kts,kte)

 CALL g_horizontal_diffusion_w_2(rw_tendf,g_rw_tendf,mu,g_mu,config_flags, &
 defor13,g_defor13,defor23,g_defor23,div,g_div,nba_mij,g_nba_mij, &
 n_nba_mij,tke(ims,kms,jms),g_tke(ims,kms,jms),msftx,msfty,xkmh,g_xkmh,rdx,rdy, &
 fnm,fnp,zx,g_zx,zy,g_zy,rdz,g_rdz,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
 kms,kme,its,ite,jts,jte,kts,kte)

 CALL g_horizontal_diffusion_s(rt_tendf,g_rt_tendf,mu,g_mu,config_flags,thp, &
 g_thp,msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,g_xkhh,rdx,rdy,fnm,fnp,cf1,cf2, &
 cf3,zx,g_zx,zy,g_zy,rdz,g_rdz,rdzw,g_rdzw,dnw,dn,.false.,ids,ide,jds,jde, &
 kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IF(km_opt .eq. 2) CALL g_horizontal_diffusion_s(tke_tendf(ims,kms,jms) &
,g_tke_tendf(ims,kms,jms),mu,g_mu,config_flags,tke(ims,kms,jms),g_tke(ims, &
 kms,jms),msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,g_xkhh,rdx,rdy,fnm,fnp,cf1,cf2, &
 cf3,zx,g_zx,zy,g_zy,rdz,g_rdz,rdzw,g_rdzw,dnw,dn,.true.,ids,ide,jds,jde, &
 kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IF(n_moist .ge. PARAM_FIRST_SCALAR) THEN

 DO im =PARAM_FIRST_SCALAR,n_moist

 CALL g_horizontal_diffusion_s(moist_tendf(ims,kms,jms,im),g_moist_tendf(ims, &
 kms,jms,im),mu,g_mu,config_flags,moist(ims,kms,jms,im),g_moist(ims,kms,jms,im) &
,msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,g_xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3,zx, &
 g_zx,zy,g_zy,rdz,g_rdz,rdzw,g_rdzw,dnw,dn,.false.,ids,ide,jds,jde,kds, &
 kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
 ENDDO
 ENDIF

 IF(n_chem .ge. PARAM_FIRST_SCALAR) THEN

 DO ic =PARAM_FIRST_SCALAR,n_chem

 CALL g_horizontal_diffusion_s(chem_tendf(ims,kms,jms,ic),g_chem_tendf(ims,kms, &
 jms,ic),mu,g_mu,config_flags,chem(ims,kms,jms,ic),g_chem(ims,kms,jms,ic) &
,msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,g_xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3,zx, &
 g_zx,zy,g_zy,rdz,g_rdz,rdzw,g_rdzw,dnw,dn,.false.,ids,ide,jds,jde,kds, &
 kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
 ENDDO
 ENDIF

 IF(n_tracer .ge. PARAM_FIRST_SCALAR) THEN

 DO ic =PARAM_FIRST_SCALAR,n_tracer

 CALL g_horizontal_diffusion_s(tracer_tendf(ims,kms,jms,ic),g_tracer_tendf(ims, &
 kms,jms,ic),mu,g_mu,config_flags,tracer(ims,kms,jms,ic),g_tracer(ims,kms,jms, &
 ic),msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,g_xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3, &
 zx,g_zx,zy,g_zy,rdz,g_rdz,rdzw,g_rdzw,dnw,dn,.false.,ids,ide,jds,jde,kds, &
 kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
 ENDDO
 ENDIF

 IF(n_scalar .ge. PARAM_FIRST_SCALAR) THEN

 DO is =PARAM_FIRST_SCALAR,n_scalar

 CALL g_horizontal_diffusion_s(scalar_tendf(ims,kms,jms,is),g_scalar_tendf(ims, &
 kms,jms,is),mu,g_mu,config_flags,scalar(ims,kms,jms,is),g_scalar(ims,kms,jms, &
 is),msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,g_xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3, &
 zx,g_zx,zy,g_zy,rdz,g_rdz,rdzw,g_rdzw,dnw,dn,.false.,ids,ide,jds,jde,kds, &
 kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
 ENDDO
 ENDIF

 END SUBROUTINE g_horizontal_diffusion_2

 SUBROUTINE g_horizontal_diffusion_u_2(tendency,g_tendency,mu,g_mu, &
 config_flags,defor11,g_defor11,defor12,g_defor12,div,g_div,nba_mij, &
 g_nba_mij,n_nba_mij,tke,g_tke,msfux,msfuy,xkmh,g_xkmh,rdx,rdy,fnm,fnp,zx, &
 g_zx,zy,g_zy,rdzw,g_rdzw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
 its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 REAL,DIMENSION(kms:kme) :: fnm
 REAL,DIMENSION(kms:kme) :: fnp
 REAL,DIMENSION(ims:ime,jms:jme) :: msfux,msfuy,mu,g_mu
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,g_tendency
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rdzw,g_rdzw
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor11,g_defor11,defor12,g_defor12, &
 div,g_div,tke,g_tke,xkmh,g_xkmh,zx,g_zx,zy,g_zy

 INTEGER :: n_nba_mij

 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,g_nba_mij
 REAL :: rdx,rdy
 INTEGER :: i,j,k,ktf
 INTEGER :: i_start,i_end,j_start,j_end
 INTEGER :: is_ext,ie_ext,js_ext,je_ext
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau1avg,g_titau1avg, &
 titau2avg,g_titau2avg,titau1,g_titau1,titau2,g_titau2,xkxavg,g_xkxavg, &
 rravg,g_rravg
 REAL :: mrdx,g_mrdx,mrdy,g_mrdy,rcoup,g_rcoup
 REAL :: tmpzy,g_tmpzy,tmpzeta_z,g_tmpzeta_z
 REAL :: term1,g_term1,term2,g_term2,term3,g_term3

 ktf =min(kte,kde-1)

 i_start =its

 i_end =ite

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .or. config_flags%specified .or.   &
        config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .or. config_flags%specified .or.   &
        config_flags%nested) i_end =min(ide-1,ite)

 IF( config_flags%open_ys .or. config_flags%specified .or.   &
        config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .or. config_flags%specified .or.   &
        config_flags%nested) j_end =min(jde-2,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =ite

 is_ext =1

 ie_ext =0

 js_ext =0

 je_ext =0

 CALL g_cal_titau_11_22_33(config_flags,titau1,g_titau1,mu,g_mu,tke,g_tke, &
 xkmh,g_xkmh,defor11,g_defor11,nba_mij(ims,kms,jms,P_m11),g_nba_mij(ims,kms, &
 jms,P_m11),is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
 kme,its,ite,jts,jte,kts,kte)

 is_ext =0

 ie_ext =0

 js_ext =0

 je_ext =1

 CALL g_cal_titau_12_21(config_flags,titau2,g_titau2,mu,g_mu,xkmh,g_xkmh, &
 defor12,g_defor12,nba_mij(ims,kms,jms,P_m12),g_nba_mij(ims,kms,jms,P_m12) &
,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite, &
 jts,jte,kts,kte)

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_titau1avg(i,k,j) =0.5*(fnm(k)*(g_titau1(i-1,k,j) +g_titau1(i,k,j)) +fnp(k) &
*(g_titau1(i-1,k-1,j) +g_titau1(i,k-1,j)))
 titau1avg(i,k,j) =0.5*(fnm(k)*(titau1(i-1,k,j) +titau1(i,k,j)) +fnp(k)*(titau1(i-1,k- &
 1,j) +titau1(i,k-1,j)))

 g_titau2avg(i,k,j) =0.5*(fnm(k)*(g_titau2(i,k,j+1) +g_titau2(i,k,j)) +fnp(k) &
*(g_titau2(i,k-1,j+1) +g_titau2(i,k-1,j)))
 titau2avg(i,k,j) =0.5*(fnm(k)*(titau2(i,k,j+1) +titau2(i,k,j)) +fnp(k)*(titau2(i,k-1, &
 j+1) +titau2(i,k-1,j)))

 g_tmpzy =0.25*(g_zy(i-1,k,j) +g_zy(i,k,j) +g_zy(i-1,k,j+1) +g_zy(i,k,j+1))
 tmpzy =0.25*(zy(i-1,k,j) +zy(i,k,j) +zy(i-1,k,j+1) +zy(i,k,j+1))

 g_Tmpv1 =titau1avg(i,k,j)*g_zx(i,k,j) +g_titau1avg(i,k,j)*zx(i,k,j) 
 Tmpv1 =titau1avg(i,k,j)*zx(i,k,j)

 g_titau1avg(i,k,j) =g_Tmpv1
 titau1avg(i,k,j) =Tmpv1

 g_Tmpv1 =titau2avg(i,k,j)*g_tmpzy +g_titau2avg(i,k,j)*tmpzy 
 Tmpv1 =titau2avg(i,k,j)*tmpzy

 g_titau2avg(i,k,j) =g_Tmpv1
 titau2avg(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_titau1avg(i,kts,j) =0.0
 titau1avg(i,kts,j) =0.

 g_titau1avg(i,ktf+1,j) =0.0
 titau1avg(i,ktf+1,j) =0.

 g_titau2avg(i,kts,j) =0.0
 titau2avg(i,kts,j) =0.

 g_titau2avg(i,ktf+1,j) =0.0
 titau2avg(i,ktf+1,j) =0.

 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

! g_mrdx =0.0  ! Remarked by Ning Pan, 2010-08-10
 mrdx =msfux(i,j) *rdx

! g_mrdy =0.0  ! Remarked by Ning Pan, 2010-08-10
 mrdy =msfuy(i,j) *rdy

! Revised by Ning Pan, 2010-08-10
! g_Tmpv1 =mrdx*(g_titau1(i,k,j) -g_titau1(i-1,k,j)) +g_mrdx*(titau1(i,k, &
! j) -titau1(i-1,k,j)) 
 g_Tmpv1 =mrdx*(g_titau1(i,k,j) -g_titau1(i-1,k,j))
 Tmpv1 =mrdx*(titau1(i,k,j) -titau1(i-1,k,j))

! Revised by Ning Pan, 2010-08-10
! g_Tmpv2 =mrdy*(g_titau2(i,k,j+1) -g_titau2(i,k,j)) +g_mrdy*(titau2(i,k, &
! j+1) -titau2(i,k,j)) 
 g_Tmpv2 =mrdy*(g_titau2(i,k,j+1) -g_titau2(i,k,j))
 Tmpv2 =mrdy*(titau2(i,k,j+1) -titau2(i,k,j))

 g_Tmpv3 =msfuy(i,j)*rdzw(i,k,j)*((g_titau1avg(i,k+1,j) -g_titau1avg(i,k,j)) &
 +(g_titau2avg(i,k+1,j) -g_titau2avg(i,k,j))) +msfuy(i,j)*g_rdzw(i,k,j) &
*((titau1avg(i,k+1,j) -titau1avg(i,k,j)) +(titau2avg(i,k+1,j) -titau2avg(i,k,j))) 
 Tmpv3 =msfuy(i,j)*rdzw(i,k,j)*((titau1avg(i,k+1,j) -titau1avg(i,k,j)) +(titau2avg(i, &
 k+1,j) -titau2avg(i,k,j)))

 g_tendency(i,k,j) =g_tendency(i,k,j) -(g_Tmpv1 +g_Tmpv2 -g_Tmpv3)
 tendency(i,k,j) =tendency(i,k,j) -(Tmpv1 +Tmpv2 -Tmpv3)

 ENDDO
 ENDDO
 ENDDO

 END SUBROUTINE g_horizontal_diffusion_u_2

 SUBROUTINE g_horizontal_diffusion_v_2(tendency,g_tendency,mu,g_mu, &
 config_flags,defor12,g_defor12,defor22,g_defor22,div,g_div,nba_mij, &
 g_nba_mij,n_nba_mij,tke,g_tke,msfvx,msfvy,xkmh,g_xkmh,rdx,rdy,fnm,fnp,zx, &
 g_zx,zy,g_zy,rdzw,g_rdzw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
 its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 REAL,DIMENSION(kms:kme) :: fnm
 REAL,DIMENSION(kms:kme) :: fnp
 REAL,DIMENSION(ims:ime,jms:jme) :: msfvx,msfvy,mu,g_mu
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,g_tendency
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor12,g_defor12,defor22,g_defor22, &
 div,g_div,tke,g_tke,xkmh,g_xkmh,zx,g_zx,zy,g_zy,rdzw,g_rdzw

 INTEGER :: n_nba_mij

 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,g_nba_mij
 REAL :: rdx,rdy
 INTEGER :: i,j,k,ktf
 INTEGER :: i_start,i_end,j_start,j_end
 INTEGER :: is_ext,ie_ext,js_ext,je_ext
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau1avg,g_titau1avg, &
 titau2avg,g_titau2avg,titau1,g_titau1,titau2,g_titau2,xkxavg,g_xkxavg, &
 rravg,g_rravg
 REAL :: mrdx,g_mrdx,mrdy,g_mrdy,rcoup,g_rcoup
 REAL :: tmpzx,g_tmpzx,tmpzeta_z,g_tmpzeta_z

 ktf =min(kte,kde-1)

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =jte

 IF( config_flags%open_xs .or. config_flags%specified .or.   &
        config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .or. config_flags%specified .or.   &
        config_flags%nested) i_end =min(ide-2,ite)

 IF( config_flags%open_ys .or. config_flags%specified .or.   &
        config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .or. config_flags%specified .or.   &
        config_flags%nested) j_end =min(jde-1,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide-1)

 is_ext =0

 ie_ext =1

 js_ext =0

 je_ext =0

 CALL g_cal_titau_12_21(config_flags,titau1,g_titau1,mu,g_mu,xkmh,g_xkmh, &
 defor12,g_defor12,nba_mij(ims,kms,jms,P_m12),g_nba_mij(ims,kms,jms,P_m12) &
,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite, &
 jts,jte,kts,kte)

 is_ext =0

 ie_ext =0

 js_ext =1

 je_ext =0

 CALL g_cal_titau_11_22_33(config_flags,titau2,g_titau2,mu,g_mu,tke,g_tke, &
 xkmh,g_xkmh,defor22,g_defor22,nba_mij(ims,kms,jms,P_m22),g_nba_mij(ims,kms, &
 jms,P_m22),is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
 kme,its,ite,jts,jte,kts,kte)

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_titau1avg(i,k,j) =0.5*(fnm(k)*(g_titau1(i+1,k,j) +g_titau1(i,k,j)) +fnp(k) &
*(g_titau1(i+1,k-1,j) +g_titau1(i,k-1,j)))
 titau1avg(i,k,j) =0.5*(fnm(k)*(titau1(i+1,k,j) +titau1(i,k,j)) +fnp(k)*(titau1(i+1,k- &
 1,j) +titau1(i,k-1,j)))

 g_titau2avg(i,k,j) =0.5*(fnm(k)*(g_titau2(i,k,j-1) +g_titau2(i,k,j)) +fnp(k) &
*(g_titau2(i,k-1,j-1) +g_titau2(i,k-1,j)))
 titau2avg(i,k,j) =0.5*(fnm(k)*(titau2(i,k,j-1) +titau2(i,k,j)) +fnp(k)*(titau2(i,k-1, &
 j-1) +titau2(i,k-1,j)))

 g_tmpzx =0.25*(g_zx(i,k,j) +g_zx(i+1,k,j) +g_zx(i,k,j-1) +g_zx(i+1,k,j-1))
 tmpzx =0.25*(zx(i,k,j) +zx(i+1,k,j) +zx(i,k,j-1) +zx(i+1,k,j-1))

 g_Tmpv1 =titau1avg(i,k,j)*g_tmpzx +g_titau1avg(i,k,j)*tmpzx 
 Tmpv1 =titau1avg(i,k,j)*tmpzx

 g_titau1avg(i,k,j) =g_Tmpv1
 titau1avg(i,k,j) =Tmpv1

 g_Tmpv1 =titau2avg(i,k,j)*g_zy(i,k,j) +g_titau2avg(i,k,j)*zy(i,k,j) 
 Tmpv1 =titau2avg(i,k,j)*zy(i,k,j)

 g_titau2avg(i,k,j) =g_Tmpv1
 titau2avg(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_titau1avg(i,kts,j) =0.0
 titau1avg(i,kts,j) =0.

 g_titau1avg(i,ktf+1,j) =0.0
 titau1avg(i,ktf+1,j) =0.

 g_titau2avg(i,kts,j) =0.0
 titau2avg(i,kts,j) =0.

 g_titau2avg(i,ktf+1,j) =0.0
 titau2avg(i,ktf+1,j) =0.

 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

! g_mrdx =0.0  ! Remarked by Ning Pan, 2010-08-10
 mrdx =msfvx(i,j) *rdx

! g_mrdy =0.0  ! Remarked by Ning Pan, 2010-08-10
 mrdy =msfvy(i,j) *rdy

! Revised by Ning Pan, 2010-08-10
! g_Tmpv1 =mrdy*(g_titau2(i,k,j) -g_titau2(i,k,j-1)) +g_mrdy*(titau2(i,k, &
! j) -titau2(i,k,j-1)) 
 g_Tmpv1 =mrdy*(g_titau2(i,k,j) -g_titau2(i,k,j-1))
 Tmpv1 =mrdy*(titau2(i,k,j) -titau2(i,k,j-1))

! Revised by Ning Pan, 2010-08-10
! g_Tmpv2 =mrdx*(g_titau1(i+1,k,j) -g_titau1(i,k,j)) +g_mrdx*(titau1(i+1, &
! k,j) -titau1(i,k,j)) 
 g_Tmpv2 =mrdx*(g_titau1(i+1,k,j) -g_titau1(i,k,j))
 Tmpv2 =mrdx*(titau1(i+1,k,j) -titau1(i,k,j))

 g_Tmpv3 =msfvy(i,j)*rdzw(i,k,j)*((g_titau1avg(i,k+1,j) -g_titau1avg(i,k,j)) &
 +(g_titau2avg(i,k+1,j) -g_titau2avg(i,k,j))) +msfvy(i,j)*g_rdzw(i,k,j) &
*((titau1avg(i,k+1,j) -titau1avg(i,k,j)) +(titau2avg(i,k+1,j) -titau2avg(i,k,j))) 
 Tmpv3 =msfvy(i,j)*rdzw(i,k,j)*((titau1avg(i,k+1,j) -titau1avg(i,k,j)) +(titau2avg(i, &
 k+1,j) -titau2avg(i,k,j)))

 g_tendency(i,k,j) =g_tendency(i,k,j) -(g_Tmpv1 +g_Tmpv2 -g_Tmpv3)
 tendency(i,k,j) =tendency(i,k,j) -(Tmpv1 +Tmpv2 -Tmpv3)

 ENDDO
 ENDDO
 ENDDO

 END SUBROUTINE g_horizontal_diffusion_v_2

 SUBROUTINE g_horizontal_diffusion_w_2(tendency,g_tendency,mu,g_mu, &
 config_flags,defor13,g_defor13,defor23,g_defor23,div,g_div,nba_mij, &
 g_nba_mij,n_nba_mij,tke,g_tke,msftx,msfty,xkmh,g_xkmh,rdx,rdy,fnm,fnp,zx, &
 g_zx,zy,g_zy,rdz,g_rdz,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its, &
 ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 REAL,DIMENSION(kms:kme) :: fnm
 REAL,DIMENSION(kms:kme) :: fnp
 REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty,mu,g_mu
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,g_tendency
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor13,g_defor13,defor23,g_defor23, &
 div,g_div,tke,g_tke,xkmh,g_xkmh,zx,g_zx,zy,g_zy,rdz,g_rdz

 INTEGER :: n_nba_mij

 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,g_nba_mij
 REAL :: rdx,rdy
 INTEGER :: i,j,k,ktf
 INTEGER :: i_start,i_end,j_start,j_end
 INTEGER :: is_ext,ie_ext,js_ext,je_ext
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau1avg,g_titau1avg, &
 titau2avg,g_titau2avg,titau1,g_titau1,titau2,g_titau2,xkxavg,g_xkxavg, &
 rravg,g_rravg
 REAL :: mrdx,g_mrdx,mrdy,g_mrdy,rcoup,g_rcoup
 REAL :: tmpzx,g_tmpzx,tmpzy,g_tmpzy,tmpzeta_z,g_tmpzeta_z

 ktf =min(kte,kde-1)

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .or. config_flags%specified .or.   &
        config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .or. config_flags%specified .or.   &
        config_flags%nested) i_end =min(ide-2,ite)

 IF( config_flags%open_ys .or. config_flags%specified .or.   &
        config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .or. config_flags%specified .or.   &
        config_flags%nested) j_end =min(jde-2,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide-1)

 is_ext =0

 ie_ext =1

 js_ext =0

 je_ext =0

 CALL g_cal_titau_13_31(config_flags,titau1,g_titau1,defor13,g_defor13, &
 nba_mij(ims,kms,jms,P_m13),g_nba_mij(ims,kms,jms,P_m13),mu,g_mu,xkmh,g_xkmh, &
 fnm,fnp,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
 its,ite,jts,jte,kts,kte)

 is_ext =0

 ie_ext =0

 js_ext =0

 je_ext =1

 CALL g_cal_titau_23_32(config_flags,titau2,g_titau2,defor23,g_defor23, &
 nba_mij(ims,kms,jms,P_m23),g_nba_mij(ims,kms,jms,P_m23),mu,g_mu,xkmh,g_xkmh, &
 fnm,fnp,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
 its,ite,jts,jte,kts,kte)

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_titau1avg(i,k,j) =0.25*(g_titau1(i+1,k+1,j) +g_titau1(i,k+1,j) &
 +g_titau1(i+1,k,j) +g_titau1(i,k,j))
 titau1avg(i,k,j) =0.25*(titau1(i+1,k+1,j) +titau1(i,k+1,j) +titau1(i+1,k,j) +titau1(i,k,j))

 g_titau2avg(i,k,j) =0.25*(g_titau2(i,k+1,j+1) +g_titau2(i,k+1,j) &
 +g_titau2(i,k,j+1) +g_titau2(i,k,j))
 titau2avg(i,k,j) =0.25*(titau2(i,k+1,j+1) +titau2(i,k+1,j) +titau2(i,k,j+1) +titau2(i,k,j))

 g_tmpzx =0.25*(g_zx(i,k,j) +g_zx(i+1,k,j) +g_zx(i,k+1,j) +g_zx(i+1,k+1,j))
 tmpzx =0.25*(zx(i,k,j) +zx(i+1,k,j) +zx(i,k+1,j) +zx(i+1,k+1,j))

 g_tmpzy =0.25*(g_zy(i,k,j) +g_zy(i,k,j+1) +g_zy(i,k+1,j) +g_zy(i,k+1,j+1))
 tmpzy =0.25*(zy(i,k,j) +zy(i,k,j+1) +zy(i,k+1,j) +zy(i,k+1,j+1))

 g_Tmpv1 =titau1avg(i,k,j)*g_tmpzx +g_titau1avg(i,k,j)*tmpzx 
 Tmpv1 =titau1avg(i,k,j)*tmpzx

 g_titau1avg(i,k,j) =g_Tmpv1
 titau1avg(i,k,j) =Tmpv1

 g_Tmpv1 =titau2avg(i,k,j)*g_tmpzy +g_titau2avg(i,k,j)*tmpzy 
 Tmpv1 =titau2avg(i,k,j)*tmpzy

 g_titau2avg(i,k,j) =g_Tmpv1
 titau2avg(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_titau1avg(i,ktf+1,j) =0.0
 titau1avg(i,ktf+1,j) =0.

 g_titau2avg(i,ktf+1,j) =0.0
 titau2avg(i,ktf+1,j) =0.

 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

! g_mrdx =0.0  ! Remarked by Ning Pan, 2010-08-10
 mrdx =msftx(i,j) *rdx

! g_mrdy =0.0  ! Remarked by Ning Pan, 2010-08-10
 mrdy =msfty(i,j) *rdy

! Revised by Ning Pan, 2010-08-10
! g_Tmpv1 =mrdx*(g_titau1(i+1,k,j) -g_titau1(i,k,j)) +g_mrdx*(titau1(i+1, &
! k,j) -titau1(i,k,j)) 
 g_Tmpv1 =mrdx*(g_titau1(i+1,k,j) -g_titau1(i,k,j))
 Tmpv1 =mrdx*(titau1(i+1,k,j) -titau1(i,k,j))

! Revised by Ning Pan, 2010-08-10
! g_Tmpv2 =mrdy*(g_titau2(i,k,j+1) -g_titau2(i,k,j)) +g_mrdy*(titau2(i,k, &
! j+1) -titau2(i,k,j)) 
 g_Tmpv2 =mrdy*(g_titau2(i,k,j+1) -g_titau2(i,k,j))
 Tmpv2 =mrdy*(titau2(i,k,j+1) -titau2(i,k,j))

 g_Tmpv3 =msfty(i,j)*rdz(i,k,j)*(g_titau1avg(i,k,j) -g_titau1avg(i,k-1,j) &
 +g_titau2avg(i,k,j) -g_titau2avg(i,k-1,j)) +msfty(i,j)*g_rdz(i,k,j) &
*(titau1avg(i,k,j) -titau1avg(i,k-1,j) +titau2avg(i,k,j) -titau2avg(i,k-1,j)) 
 Tmpv3 =msfty(i,j)*rdz(i,k,j)*(titau1avg(i,k,j) -titau1avg(i,k-1,j) +titau2avg(i,k,j) &
 -titau2avg(i,k-1,j))

 g_tendency(i,k,j) =g_tendency(i,k,j) -(g_Tmpv1 +g_Tmpv2 -g_Tmpv3)
 tendency(i,k,j) =tendency(i,k,j) -(Tmpv1 +Tmpv2 -Tmpv3)

 ENDDO
 ENDDO
 ENDDO

 END SUBROUTINE g_horizontal_diffusion_w_2

 SUBROUTINE g_horizontal_diffusion_s(tendency,g_tendency,mu,g_mu, &
 config_flags,var,g_var,msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,g_xkhh,rdx,rdy, &
 fnm,fnp,cf1,cf2,cf3,zx,g_zx,zy,g_zy,rdz,g_rdz,rdzw,g_rdzw,dnw,dn, &
 doing_tke,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4,Tmpv5, &
 g_Tmpv5,Tmpv6,g_Tmpv6,Tmpv7,g_Tmpv7,Tmpv8,g_Tmpv8,Tmpv9,g_Tmpv9
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 LOGICAL :: doing_tke
 REAL :: cf1,cf2,cf3
 REAL,DIMENSION(kms:kme) :: fnm
 REAL,DIMENSION(kms:kme) :: fnp
 REAL,DIMENSION(kms:kme) :: dn
 REAL,DIMENSION(kms:kme) :: dnw
 REAL,DIMENSION(ims:ime,jms:jme) :: msfux
 REAL,DIMENSION(ims:ime,jms:jme) :: msfuy
 REAL,DIMENSION(ims:ime,jms:jme) :: msfvx
 REAL,DIMENSION(ims:ime,jms:jme) :: msfvy
 REAL,DIMENSION(ims:ime,jms:jme) :: msftx
 REAL,DIMENSION(ims:ime,jms:jme) :: msfty
 REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,g_tendency
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkhh,g_xkhh,rdz,g_rdz,rdzw,g_rdzw
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: var,g_var,zx,g_zx,zy,g_zy
 REAL :: rdx,rdy
 INTEGER :: i,j,k,ktf
 INTEGER :: i_start,i_end,j_start,j_end
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: H1avg,g_H1avg,H2avg,g_H2avg, &
 H1,g_H1,H2,g_H2,xkxavg,g_xkxavg
 REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: tmptendf,g_tmptendf
 REAL :: mrdx,g_mrdx,mrdy,g_mrdy,rcoup,g_rcoup
 REAL :: tmpzx,g_tmpzx,tmpzy,g_tmpzy,tmpzeta_z,g_tmpzeta_z,rdzu,g_rdzu, &
 rdzv,g_rdzv
 INTEGER :: ktes1,ktes2

 ktf =min(kte,kde-1)

 ktes1 =kte-1

 ktes2 =kte-2

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .or. config_flags%specified .or.   &
        config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .or. config_flags%specified .or.   &
        config_flags%nested) i_end =min(ide-2,ite)

 IF( config_flags%open_ys .or. config_flags%specified .or.   &
        config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .or. config_flags%specified .or.   &
        config_flags%nested) j_end =min(jde-2,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide-1)

 IF( doing_tke ) THEN

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tmptendf(i,k,j) =g_tendency(i,k,j)
 tmptendf(i,k,j) =tendency(i,k,j)

 ENDDO
 ENDDO
 ENDDO
 ENDIF

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end+1

 g_xkxavg(i,k,j) =0.5*(g_xkhh(i-1,k,j) +g_xkhh(i,k,j))
 xkxavg(i,k,j) =0.5*(xkhh(i-1,k,j) +xkhh(i,k,j))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end+1

 g_H1avg(i,k,j) =0.5*(fnm(k)*(g_var(i-1,k,j) +g_var(i,k,j)) +fnp(k) &
*(g_var(i-1,k-1,j) +g_var(i,k-1,j)))
 H1avg(i,k,j) =0.5*(fnm(k)*(var(i-1,k,j) +var(i,k,j)) +fnp(k)*(var(i-1,k-1,j) +var(i,k-1,j)))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end+1

 g_H1avg(i,kts,j) =0.5*(cf1*g_var(i,1,j) +cf2*g_var(i,2,j) +cf3*g_var(i,3, &
 j) +cf1*g_var(i-1,1,j) +cf2*g_var(i-1,2,j) +cf3*g_var(i-1,3,j))
 H1avg(i,kts,j) =0.5*(cf1*var(i,1,j) +cf2*var(i,2,j) +cf3*var(i,3,j) +cf1*var(i-1,1,j) &
 +cf2*var(i-1,2,j) +cf3*var(i-1,3,j))

 g_H1avg(i,ktf+1,j) =0.5*(g_var(i,ktes1,j) +((g_var(i,ktes1,j) -g_var(i, &
 ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)) +g_var(i-1,ktes1,j) +((g_var(i-1,ktes1,j) &
 -g_var(i-1,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)))
 H1avg(i,ktf+1,j) =0.5*(var(i,ktes1,j) +(var(i,ktes1,j) -var(i,ktes2,j)) &
*0.5*dnw(ktes1)/dn(ktes1) +var(i-1,ktes1,j) +(var(i-1,ktes1,j) -var(i-1,ktes2,j)) &
*0.5*dnw(ktes1)/dn(ktes1))

 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end+1

 g_tmpzx =0.5*(g_zx(i,k,j) +g_zx(i,k+1,j))
 tmpzx =0.5*(zx(i,k,j) +zx(i,k+1,j))

 g_rdzu =-2.*(-1.*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j)) +(-1.*g_rdzw(i-1,k, &
 j)/(rdzw(i-1,k,j)*rdzw(i-1,k,j))))/((1./rdzw(i,k,j) +1./rdzw(i-1,k,j))*(1./rdzw(i,k, &
 j) +1./rdzw(i-1,k,j)))
 rdzu =2./(1./rdzw(i,k,j) +1./rdzw(i-1,k,j))

 g_Tmpv1 =tmpzx*(g_H1avg(i,k+1,j) -g_H1avg(i,k,j)) +g_tmpzx*(H1avg(i,k+1, &
 j) -H1avg(i,k,j)) 
 Tmpv1 =tmpzx*(H1avg(i,k+1,j) -H1avg(i,k,j))

 g_Tmpv2 =Tmpv1*g_rdzu +g_Tmpv1*rdzu 
 Tmpv2 =Tmpv1*rdzu

 g_Tmpv3 =-msfuy(i,j)*xkxavg(i,k,j)*(rdx*(g_var(i,k,j) -g_var(i-1,k,j)) &
 -g_Tmpv2) -msfuy(i,j)*g_xkxavg(i,k,j)*(rdx*(var(i,k,j) -var(i-1,k,j)) -Tmpv2) 
 Tmpv3 =-msfuy(i,j)*xkxavg(i,k,j)*(rdx*(var(i,k,j) -var(i-1,k,j)) -Tmpv2)

 g_H1(i,k,j) =g_Tmpv3
 H1(i,k,j) =Tmpv3

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end+1
 DO k =kts,ktf
 DO i =i_start,i_end

 g_xkxavg(i,k,j) =0.5*(g_xkhh(i,k,j-1) +g_xkhh(i,k,j))
 xkxavg(i,k,j) =0.5*(xkhh(i,k,j-1) +xkhh(i,k,j))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end+1
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_H2avg(i,k,j) =0.5*(fnm(k)*(g_var(i,k,j-1) +g_var(i,k,j)) +fnp(k) &
*(g_var(i,k-1,j-1) +g_var(i,k-1,j)))
 H2avg(i,k,j) =0.5*(fnm(k)*(var(i,k,j-1) +var(i,k,j)) +fnp(k)*(var(i,k-1,j-1) +var(i,k-1,j)))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end+1
 DO i =i_start,i_end

 g_H2avg(i,kts,j) =0.5*(cf1*g_var(i,1,j) +cf2*g_var(i,2,j) +cf3*g_var(i,3, &
 j) +cf1*g_var(i,1,j-1) +cf2*g_var(i,2,j-1) +cf3*g_var(i,3,j-1))
 H2avg(i,kts,j) =0.5*(cf1*var(i,1,j) +cf2*var(i,2,j) +cf3*var(i,3,j) +cf1*var(i,1,j-1) &
 +cf2*var(i,2,j-1) +cf3*var(i,3,j-1))

 g_H2avg(i,ktf+1,j) =0.5*(g_var(i,ktes1,j) +((g_var(i,ktes1,j) -g_var(i, &
 ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)) +g_var(i,ktes1,j-1) +((g_var(i,ktes1,j-1) &
 -g_var(i,ktes2,j-1))*0.5*dnw(ktes1)/dn(ktes1)))
 H2avg(i,ktf+1,j) =0.5*(var(i,ktes1,j) +(var(i,ktes1,j) -var(i,ktes2,j)) &
*0.5*dnw(ktes1)/dn(ktes1) +var(i,ktes1,j-1) +(var(i,ktes1,j-1) -var(i,ktes2,j-1)) &
*0.5*dnw(ktes1)/dn(ktes1))

 ENDDO
 ENDDO

 DO j =j_start,j_end+1
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tmpzy =0.5*(g_zy(i,k,j) +g_zy(i,k+1,j))
 tmpzy =0.5*(zy(i,k,j) +zy(i,k+1,j))

 g_rdzv =-2.*(-1.*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j)) +(-1.*g_rdzw(i,k,j- &
 1)/(rdzw(i,k,j-1)*rdzw(i,k,j-1))))/((1./rdzw(i,k,j) +1./rdzw(i,k,j-1))*(1./rdzw(i,k, &
 j) +1./rdzw(i,k,j-1)))
 rdzv =2./(1./rdzw(i,k,j) +1./rdzw(i,k,j-1))

 g_Tmpv1 =tmpzy*(g_H2avg(i,k+1,j) -g_H2avg(i,k,j)) +g_tmpzy*(H2avg(i,k+1, &
 j) -H2avg(i,k,j)) 
 Tmpv1 =tmpzy*(H2avg(i,k+1,j) -H2avg(i,k,j))

 g_Tmpv2 =Tmpv1*g_rdzv +g_Tmpv1*rdzv 
 Tmpv2 =Tmpv1*rdzv

 g_Tmpv3 =-msfvy(i,j)*xkxavg(i,k,j)*(rdy*(g_var(i,k,j) -g_var(i,k,j-1)) &
 -g_Tmpv2) -msfvy(i,j)*g_xkxavg(i,k,j)*(rdy*(var(i,k,j) -var(i,k,j-1)) -Tmpv2) 
 Tmpv3 =-msfvy(i,j)*xkxavg(i,k,j)*(rdy*(var(i,k,j) -var(i,k,j-1)) -Tmpv2)

 g_H2(i,k,j) =g_Tmpv3
 H2(i,k,j) =Tmpv3

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_H1avg(i,k,j) =0.5*(fnm(k)*(g_H1(i+1,k,j) +g_H1(i,k,j)) +fnp(k) &
*(g_H1(i+1,k-1,j) +g_H1(i,k-1,j)))
 H1avg(i,k,j) =0.5*(fnm(k)*(H1(i+1,k,j) +H1(i,k,j)) +fnp(k)*(H1(i+1,k-1,j) +H1(i,k-1,j)))

 g_H2avg(i,k,j) =0.5*(fnm(k)*(g_H2(i,k,j+1) +g_H2(i,k,j)) +fnp(k) &
*(g_H2(i,k-1,j+1) +g_H2(i,k-1,j)))
 H2avg(i,k,j) =0.5*(fnm(k)*(H2(i,k,j+1) +H2(i,k,j)) +fnp(k)*(H2(i,k-1,j+1) +H2(i,k-1,j)))

 g_tmpzx =0.5*(g_zx(i,k,j) +g_zx(i+1,k,j))
 tmpzx =0.5*(zx(i,k,j) +zx(i+1,k,j))

 g_tmpzy =0.5*(g_zy(i,k,j) +g_zy(i,k,j+1))
 tmpzy =0.5*(zy(i,k,j) +zy(i,k,j+1))

 g_Tmpv1 =H1avg(i,k,j)*g_tmpzx +g_H1avg(i,k,j)*tmpzx 
 Tmpv1 =H1avg(i,k,j)*tmpzx

 g_H1avg(i,k,j) =g_Tmpv1
 H1avg(i,k,j) =Tmpv1

 g_Tmpv1 =H2avg(i,k,j)*g_tmpzy +g_H2avg(i,k,j)*tmpzy 
 Tmpv1 =H2avg(i,k,j)*tmpzy

 g_H2avg(i,k,j) =g_Tmpv1
 H2avg(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_H1avg(i,kts,j) =0.0
 H1avg(i,kts,j) =0.

 g_H1avg(i,ktf+1,j) =0.0
 H1avg(i,ktf+1,j) =0.

 g_H2avg(i,kts,j) =0.0
 H2avg(i,kts,j) =0.

 g_H2avg(i,ktf+1,j) =0.0
 H2avg(i,ktf+1,j) =0.

 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

! g_mrdx =0.0  ! Remarked by Ning Pan, 2010-08-10
 mrdx =msftx(i,j) *rdx

! g_mrdy =0.0  ! Remarked by Ning Pan, 2010-08-10
 mrdy =msfty(i,j) *rdy

 g_Tmpv1 =(mu(i+1,j) +mu(i,j))*g_H1(i+1,k,j) +(g_mu(i+1,j) +g_mu(i,j))*H1(i+1,k,j) 
 Tmpv1 =(mu(i+1,j) +mu(i,j))*H1(i+1,k,j)

 g_Tmpv2 =(mu(i-1,j) +mu(i,j))*g_H1(i,k,j) +(g_mu(i-1,j) +g_mu(i,j))*H1(i,k,j) 
 Tmpv2 =(mu(i-1,j) +mu(i,j))*H1(i,k,j)

! Revised by Ning Pan, 2010-08-10
! g_Tmpv3 =mrdx*0.5*(g_Tmpv1 -g_Tmpv2) +g_mrdx*0.5*(Tmpv1 -Tmpv2) 
 g_Tmpv3 =mrdx*0.5*(g_Tmpv1 -g_Tmpv2)
 Tmpv3 =mrdx*0.5*(Tmpv1 -Tmpv2)

 g_Tmpv4 =(mu(i,j+1) +mu(i,j))*g_H2(i,k,j+1) +(g_mu(i,j+1) +g_mu(i,j))*H2(i,k,j+1) 
 Tmpv4 =(mu(i,j+1) +mu(i,j))*H2(i,k,j+1)

 g_Tmpv5 =(mu(i,j-1) +mu(i,j))*g_H2(i,k,j) +(g_mu(i,j-1) +g_mu(i,j))*H2(i,k,j) 
 Tmpv5 =(mu(i,j-1) +mu(i,j))*H2(i,k,j)

! Revised by Ning Pan, 2010-08-10
! g_Tmpv6 =mrdy*0.5*(g_Tmpv4 -g_Tmpv5) +g_mrdy*0.5*(Tmpv4 -Tmpv5) 
 g_Tmpv6 =mrdy*0.5*(g_Tmpv4 -g_Tmpv5)
 Tmpv6 =mrdy*0.5*(Tmpv4 -Tmpv5)

 g_Tmpv7 =msfty(i,j)*mu(i,j)*(g_H1avg(i,k+1,j) -g_H1avg(i,k,j) &
 +g_H2avg(i,k+1,j) -g_H2avg(i,k,j)) +msfty(i,j)*g_mu(i,j)*(H1avg(i,k+1,j) &
 -H1avg(i,k,j) +H2avg(i,k+1,j) -H2avg(i,k,j)) 
 Tmpv7 =msfty(i,j)*mu(i,j)*(H1avg(i,k+1,j) -H1avg(i,k,j) +H2avg(i,k+1,j) -H2avg(i,k,j))

 g_Tmpv8 =Tmpv7*g_rdzw(i,k,j) +g_Tmpv7*rdzw(i,k,j) 
 Tmpv8 =Tmpv7*rdzw(i,k,j)

 g_tendency(i,k,j) =g_tendency(i,k,j) -(g_Tmpv3 +g_Tmpv6 -g_Tmpv8)
 tendency(i,k,j) =tendency(i,k,j) -(Tmpv3 +Tmpv6 -Tmpv8)

 ENDDO
 ENDDO
 ENDDO

 IF( doing_tke ) THEN

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tendency(i,k,j) =g_tmptendf(i,k,j) +2.*(g_tendency(i,k,j) -g_tmptendf(i,k,j))
 tendency(i,k,j) =tmptendf(i,k,j) +2.*(tendency(i,k,j) -tmptendf(i,k,j))

 ENDDO
 ENDDO
 ENDDO
 ENDIF

 END SUBROUTINE g_horizontal_diffusion_s

 SUBROUTINE g_vertical_diffusion_2(ru_tendf,g_ru_tendf,rv_tendf,g_rv_tendf, &
 rw_tendf,g_rw_tendf,rt_tendf,g_rt_tendf,tke_tendf,g_tke_tendf,moist_tendf, &
 g_moist_tendf,n_moist,chem_tendf,g_chem_tendf,n_chem,scalar_tendf, &
 g_scalar_tendf,n_scalar,tracer_tendf,g_tracer_tendf,n_tracer,u_2,g_u_2,v_2, &
 g_v_2,thp,g_thp,u_base,v_base,t_base,qv_base,mu,g_mu,tke,g_tke, &
 config_flags,defor13,g_defor13,defor23,g_defor23,defor33,g_defor33,nba_mij, &
 g_nba_mij,n_nba_mij,div,g_div,moist,g_moist,chem,g_chem,scalar, &
 g_scalar,tracer,g_tracer,xkmv,g_xkmv,xkhv,g_xkhv,km_opt,fnm,fnp,dn,dnw, &
 rdz,g_rdz,rdzw,g_rdzw,hfx,g_hfx,qfx,g_qfx,ust,g_ust,rho,g_rho,ids, &
 ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3

   REAL :: g_Sqrt
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 INTEGER :: n_moist,n_chem,n_scalar,n_tracer,km_opt
 REAL,DIMENSION(kms:kme) :: fnm
 REAL,DIMENSION(kms:kme) :: fnp
 REAL,DIMENSION(kms:kme) :: dnw
 REAL,DIMENSION(kms:kme) :: dn
 REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 REAL,DIMENSION(kms:kme) :: qv_base
 REAL,DIMENSION(kms:kme) :: u_base
 REAL,DIMENSION(kms:kme) :: v_base
 REAL,DIMENSION(kms:kme) :: t_base
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ru_tendf,g_ru_tendf,rv_tendf, &
 g_rv_tendf,rw_tendf,g_rw_tendf,tke_tendf,g_tke_tendf,rt_tendf,g_rt_tendf
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist_tendf,g_moist_tendf
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_chem) :: chem_tendf,g_chem_tendf
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_scalar) :: scalar_tendf,g_scalar_tendf
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_tracer) :: tracer_tendf,g_tracer_tendf
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist,g_moist
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_chem) :: chem,g_chem
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_scalar) :: scalar,g_scalar
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_tracer) :: tracer,g_tracer
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor13,g_defor13,defor23,g_defor23, &
 defor33,g_defor33,div,g_div,xkmv,g_xkmv,xkhv,g_xkhv,tke,g_tke,rdz, &
 g_rdz,u_2,g_u_2,v_2,g_v_2,rdzw,g_rdzw

 INTEGER :: n_nba_mij

 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,g_nba_mij
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho,g_rho
 REAL,DIMENSION(ims:ime,jms:jme) :: hfx,g_hfx,qfx,g_qfx
 REAL,DIMENSION(ims:ime,jms:jme) :: ust,g_ust
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: thp,g_thp
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: var_mix,g_var_mix
 INTEGER :: im,i,j,k
 INTEGER :: i_start,i_end,j_start,j_end
 REAL :: V0_u,g_V0_u,V0_v,g_V0_v,tao_xz,g_tao_xz,tao_yz,g_tao_yz,ustar, &
 g_ustar,cd0,g_cd0
 REAL :: xsfc,g_xsfc,psi1,g_psi1,vk2,g_vk2,zrough,g_zrough,lnz,g_lnz
 REAL :: heat_flux,g_heat_flux,moist_flux,g_moist_flux,heat_flux0,g_heat_flux0
 REAL :: cpm,g_cpm

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 CALL g_vertical_diffusion_u_2(ru_tendf,g_ru_tendf,config_flags,mu,g_mu, &
 defor13,g_defor13,xkmv,g_xkmv,nba_mij,g_nba_mij,n_nba_mij,dnw,rdzw, &
 g_rdzw,fnm,fnp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 CALL g_vertical_diffusion_v_2(rv_tendf,g_rv_tendf,config_flags,mu,g_mu, &
 defor23,g_defor23,xkmv,g_xkmv,nba_mij,g_nba_mij,n_nba_mij,dnw,rdzw, &
 g_rdzw,fnm,fnp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 CALL g_vertical_diffusion_w_2(rw_tendf,g_rw_tendf,config_flags,mu,g_mu, &
 defor33,g_defor33,tke(ims,kms,jms),g_tke(ims,kms,jms),nba_mij,g_nba_mij, &
 n_nba_mij,div,g_div,xkmv,g_xkmv,dn,rdz,g_rdz,ids,ide,jds,jde,kds,kde,ims, &
 ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

! Added by Ning Pan, 2010-08-11
 tl_vflux: SELECT CASE( config_flags%isfflx )
 CASE (0)

! Remarked by Ning Pan, 2010-08-09
! g_cd0 =g_config_flags%tke_drag_coefficient
 cd0 =config_flags%tke_drag_coefficient

 DO j =j_start,j_end
 DO i =i_start,ite

 g_V0_u =0.0
 V0_u =0.

 g_tao_xz =0.0
 tao_xz =0.

 g_V0_u =g_Sqrt((2.0*g_u_2(i,kts,j)*u_2(i,kts,j)) +(2.0*((g_v_2(i,kts,j) &
 +g_v_2(i,kts,j+1) +g_v_2(i-1,kts,j) +g_v_2(i-1,kts,j+1))/4)*((v_2(i,kts,j) &
 +v_2(i,kts,j+1) +v_2(i-1,kts,j) +v_2(i-1,kts,j+1))/4)), (u_2(i,kts,j)**2) &
 +(((v_2(i,kts,j) +v_2(i,kts,j+1) +v_2(i-1,kts,j) +v_2(i-1,kts,j+1))/4)**2))
 V0_u =sqrt((u_2(i,kts,j)**2) +(((v_2(i,kts,j) +v_2(i,kts,j+1) +v_2(i-1,kts,j) &
 +v_2(i-1,kts,j+1))/4)**2)) +epsilon

! Revised by Ning Pan, 2010-08-11
! g_Tmpv1 =cd0*g_V0_u +g_cd0*V0_u 
 g_Tmpv1 =cd0*g_V0_u
 Tmpv1 =cd0*V0_u

 g_Tmpv2 =Tmpv1*g_u_2(i,kts,j) +g_Tmpv1*u_2(i,kts,j) 
 Tmpv2 =Tmpv1*u_2(i,kts,j)

 g_tao_xz =g_Tmpv2
 tao_xz =Tmpv2

 g_Tmpv1 =0.25*(mu(i,j) +mu(i-1,j))*g_tao_xz +0.25*(g_mu(i,j) +g_mu(i-1,j))*tao_xz 
 Tmpv1 =0.25*(mu(i,j) +mu(i-1,j))*tao_xz

 g_Tmpv2 =Tmpv1*(g_rdzw(i,kts,j) +g_rdzw(i-1,kts,j)) +g_Tmpv1*(rdzw(i, &
 kts,j) +rdzw(i-1,kts,j)) 
 Tmpv2 =Tmpv1*(rdzw(i,kts,j) +rdzw(i-1,kts,j))

 g_ru_tendf(i,kts,j) =g_ru_tendf(i,kts,j) -g_Tmpv2
 ru_tendf(i,kts,j) =ru_tendf(i,kts,j) -Tmpv2

 IF ( (config_flags%m_opt .EQ. 1) .OR. (config_flags%sfs_opt .GT. 0) ) THEN
    g_nba_mij(i,kts,j,P_m13) = -g_tao_xz
    nba_mij(i,kts,j,P_m13) = -tao_xz
 ENDIF

 ENDDO
 ENDDO

 DO j =j_start,jte
 DO i =i_start,i_end

 g_V0_v =0.0
 V0_v =0.

 g_tao_yz =0.0
 tao_yz =0.

 g_V0_v =g_Sqrt((2.0*g_v_2(i,kts,j)*v_2(i,kts,j)) +(2.0*((g_u_2(i,kts,j) &
 +g_u_2(i,kts,j-1) +g_u_2(i+1,kts,j) +g_u_2(i+1,kts,j-1))/4)*((u_2(i,kts,j) &
 +u_2(i,kts,j-1) +u_2(i+1,kts,j) +u_2(i+1,kts,j-1))/4)), (v_2(i,kts,j)**2) &
 +(((u_2(i,kts,j) +u_2(i,kts,j-1) +u_2(i+1,kts,j) +u_2(i+1,kts,j-1))/4)**2))
 V0_v =sqrt((v_2(i,kts,j)**2) +(((u_2(i,kts,j) +u_2(i,kts,j-1) +u_2(i+1,kts,j) &
 +u_2(i+1,kts,j-1))/4)**2)) +epsilon

! Revised by Ning Pan, 2010-08-11
! g_Tmpv1 =cd0*g_V0_v +g_cd0*V0_v 
 g_Tmpv1 =cd0*g_V0_v
 Tmpv1 =cd0*V0_v

 g_Tmpv2 =Tmpv1*g_v_2(i,kts,j) +g_Tmpv1*v_2(i,kts,j) 
 Tmpv2 =Tmpv1*v_2(i,kts,j)

 g_tao_yz =g_Tmpv2
 tao_yz =Tmpv2

 g_Tmpv1 =0.25*(mu(i,j) +mu(i,j-1))*g_tao_yz +0.25*(g_mu(i,j) +g_mu(i,j-1))*tao_yz 
 Tmpv1 =0.25*(mu(i,j) +mu(i,j-1))*tao_yz

 g_Tmpv2 =Tmpv1*(g_rdzw(i,kts,j) +g_rdzw(i,kts,j-1)) +g_Tmpv1*(rdzw(i, &
 kts,j) +rdzw(i,kts,j-1)) 
 Tmpv2 =Tmpv1*(rdzw(i,kts,j) +rdzw(i,kts,j-1))

 g_rv_tendf(i,kts,j) =g_rv_tendf(i,kts,j) -g_Tmpv2
 rv_tendf(i,kts,j) =rv_tendf(i,kts,j) -Tmpv2

 IF ( (config_flags%m_opt .EQ. 1) .OR. (config_flags%sfs_opt .GT. 0) ) THEN
    g_nba_mij(i,kts,j,P_m23) = -g_tao_yz
    nba_mij(i,kts,j,P_m23) = -tao_yz
 ENDIF

 ENDDO
 ENDDO

 CASE (1,2)  ! Added by Ning Pan, 2010-08-11

 DO j =j_start,j_end
 DO i =i_start,ite

 g_V0_u =0.0
 V0_u =0.

 g_tao_xz =0.0
 tao_xz =0.

 g_V0_u =g_Sqrt((2.0*g_u_2(i,kts,j)*u_2(i,kts,j)) +(2.0*((g_v_2(i,kts,j) &
 +g_v_2(i,kts,j+1) +g_v_2(i-1,kts,j) +g_v_2(i-1,kts,j+1))/4)*((v_2(i,kts,j) &
 +v_2(i,kts,j+1) +v_2(i-1,kts,j) +v_2(i-1,kts,j+1))/4)), (u_2(i,kts,j)**2) &
 +(((v_2(i,kts,j) +v_2(i,kts,j+1) +v_2(i-1,kts,j) +v_2(i-1,kts,j+1))/4)**2))
 V0_u =sqrt((u_2(i,kts,j)**2) +(((v_2(i,kts,j) +v_2(i,kts,j+1) +v_2(i-1,kts,j) &
 +v_2(i-1,kts,j+1))/4)**2)) +epsilon

 g_ustar =0.5*(g_ust(i,j) +g_ust(i-1,j))
 ustar =0.5*(ust(i,j) +ust(i-1,j))

 g_Tmpv1 =2.0*ustar*g_ustar 
 Tmpv1 =ustar*ustar

 g_Tmpv2 =Tmpv1*g_u_2(i,kts,j) +g_Tmpv1*u_2(i,kts,j) 
 Tmpv2 =Tmpv1*u_2(i,kts,j)

 g_Tmpv3 =(g_Tmpv2*V0_u -g_V0_u*Tmpv2)/(V0_u*V0_u) 
 Tmpv3 =Tmpv2/V0_u

 g_tao_xz =g_Tmpv3
 tao_xz =Tmpv3

 g_Tmpv1 =0.25*(mu(i,j) +mu(i-1,j))*g_tao_xz +0.25*(g_mu(i,j) +g_mu(i-1,j))*tao_xz 
 Tmpv1 =0.25*(mu(i,j) +mu(i-1,j))*tao_xz

 g_Tmpv2 =Tmpv1*(g_rdzw(i,kts,j) +g_rdzw(i-1,kts,j)) +g_Tmpv1*(rdzw(i, &
 kts,j) +rdzw(i-1,kts,j)) 
 Tmpv2 =Tmpv1*(rdzw(i,kts,j) +rdzw(i-1,kts,j))

 g_ru_tendf(i,kts,j) =g_ru_tendf(i,kts,j) -g_Tmpv2
 ru_tendf(i,kts,j) =ru_tendf(i,kts,j) -Tmpv2

 IF ( (config_flags%m_opt .EQ. 1) .OR. (config_flags%sfs_opt .GT. 0) ) THEN
    g_nba_mij(i,kts,j,P_m13) = -g_tao_xz
    nba_mij(i,kts,j,P_m13) = -tao_xz
 ENDIF

 ENDDO
 ENDDO

 DO j =j_start,jte
 DO i =i_start,i_end

 g_V0_v =0.0
 V0_v =0.

 g_tao_yz =0.0
 tao_yz =0.

 g_V0_v =g_Sqrt((2.0*g_v_2(i,kts,j)*v_2(i,kts,j)) +(2.0*((g_u_2(i,kts,j) &
 +g_u_2(i,kts,j-1) +g_u_2(i+1,kts,j) +g_u_2(i+1,kts,j-1))/4)*((u_2(i,kts,j) &
 +u_2(i,kts,j-1) +u_2(i+1,kts,j) +u_2(i+1,kts,j-1))/4)), (v_2(i,kts,j)**2) &
 +(((u_2(i,kts,j) +u_2(i,kts,j-1) +u_2(i+1,kts,j) +u_2(i+1,kts,j-1))/4)**2))
 V0_v =sqrt((v_2(i,kts,j)**2) +(((u_2(i,kts,j) +u_2(i,kts,j-1) +u_2(i+1,kts,j) &
 +u_2(i+1,kts,j-1))/4)**2)) +epsilon

 g_ustar =0.5*(g_ust(i,j) +g_ust(i,j-1))
 ustar =0.5*(ust(i,j) +ust(i,j-1))

 g_Tmpv1 =2.0*ustar*g_ustar 
 Tmpv1 =ustar*ustar

 g_Tmpv2 =Tmpv1*g_v_2(i,kts,j) +g_Tmpv1*v_2(i,kts,j) 
 Tmpv2 =Tmpv1*v_2(i,kts,j)

 g_Tmpv3 =(g_Tmpv2*V0_v -g_V0_v*Tmpv2)/(V0_v*V0_v) 
 Tmpv3 =Tmpv2/V0_v

 g_tao_yz =g_Tmpv3
 tao_yz =Tmpv3

 g_Tmpv1 =0.25*(mu(i,j) +mu(i,j-1))*g_tao_yz +0.25*(g_mu(i,j) +g_mu(i,j-1))*tao_yz 
 Tmpv1 =0.25*(mu(i,j) +mu(i,j-1))*tao_yz

 g_Tmpv2 =Tmpv1*(g_rdzw(i,kts,j) +g_rdzw(i,kts,j-1)) +g_Tmpv1*(rdzw(i, &
 kts,j) +rdzw(i,kts,j-1)) 
 Tmpv2 =Tmpv1*(rdzw(i,kts,j) +rdzw(i,kts,j-1))

 g_rv_tendf(i,kts,j) =g_rv_tendf(i,kts,j) -g_Tmpv2
 rv_tendf(i,kts,j) =rv_tendf(i,kts,j) -Tmpv2

 IF ( (config_flags%m_opt .EQ. 1) .OR. (config_flags%sfs_opt .GT. 0) ) THEN
    g_nba_mij(i,kts,j,P_m23) = -g_tao_yz
    nba_mij(i,kts,j,P_m23) = -tao_yz
 ENDIF

 ENDDO
 ENDDO

 CASE DEFAULT  ! Added by Ning Pan, 2010-08-11

! Revised by Ning Pan, 2010-08-10
! CALL g_wrf_error_fatal('isfflx value invalid for diff_opt=2')
 CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')

 END SELECT tl_vflux  ! Added by Ning Pan, 2010-08-11

 IF( config_flags%mix_full_fields ) THEN

 DO j =jts,min(jte,jde-1)
 DO k =kts,kte-1
 DO i =its,min(ite,ide-1)

 g_var_mix(i,k,j) =g_thp(i,k,j)
 var_mix(i,k,j) =thp(i,k,j)

 ENDDO
 ENDDO
 ENDDO
 ELSE

 DO j =jts,min(jte,jde-1)
 DO k =kts,kte-1
 DO i =its,min(ite,ide-1)

 g_var_mix(i,k,j) =g_thp(i,k,j)
 var_mix(i,k,j) =thp(i,k,j) -t_base(k)

 ENDDO
 ENDDO
 ENDDO
 END IF

 CALL g_vertical_diffusion_s(rt_tendf,g_rt_tendf,config_flags,var_mix, &
 g_var_mix,mu,g_mu,xkhv,g_xkhv,dn,dnw,rdz,g_rdz,rdzw,g_rdzw,fnm,fnp, &
.false.,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

! Added by Ning Pan, 2010-08-11
 tl_hflux: SELECT CASE( config_flags%isfflx )
 CASE (0,2)

! Remarked by Ning Pan, 2010-08-09
! g_heat_flux =g_config_flags%tke_heat_flux
 heat_flux =config_flags%tke_heat_flux

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_cpm =cp*(0.8*g_moist(i,kts,j,P_QV))
 cpm =cp*(1. +0.8*moist(i,kts,j,P_QV))

 g_hfx(i,j)= heat_flux*cpm*g_rho(i,1,j) + heat_flux*g_cpm*rho(i,1,j)

! Revised by Ning Pan, 2010-08-11
! g_Tmpv1 =mu(i,j)*g_heat_flux +g_mu(i,j)*heat_flux 
 g_Tmpv1 =g_mu(i,j)*heat_flux 
 Tmpv1 =mu(i,j)*heat_flux

 g_Tmpv2 =Tmpv1*g_rdzw(i,kts,j) +g_Tmpv1*rdzw(i,kts,j) 
 Tmpv2 =Tmpv1*rdzw(i,kts,j)

 g_rt_tendf(i,kts,j) =g_rt_tendf(i,kts,j) +g_Tmpv2
 rt_tendf(i,kts,j) =rt_tendf(i,kts,j) +Tmpv2

 ENDDO
 ENDDO

 CASE (1)  ! Added by Ning Pan, 2010-08-11

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_cpm =cp*(0.8*g_moist(i,kts,j,P_QV))
 cpm =cp*(1. +0.8*moist(i,kts,j,P_QV))

 g_Tmpv1 =(g_hfx(i,j)*cpm -g_cpm*hfx(i,j))/(cpm*cpm) 
 Tmpv1 =hfx(i,j)/cpm

 g_Tmpv2 =(g_Tmpv1*rho(i,1,j) -g_rho(i,1,j)*Tmpv1)/(rho(i,1,j)*rho(i,1,j)) 
 Tmpv2 =Tmpv1/rho(i,1,j)

 g_heat_flux =g_Tmpv2
 heat_flux =Tmpv2

 g_Tmpv1 =mu(i,j)*g_heat_flux +g_mu(i,j)*heat_flux 
 Tmpv1 =mu(i,j)*heat_flux

 g_Tmpv2 =Tmpv1*g_rdzw(i,kts,j) +g_Tmpv1*rdzw(i,kts,j) 
 Tmpv2 =Tmpv1*rdzw(i,kts,j)

 g_rt_tendf(i,kts,j) =g_rt_tendf(i,kts,j) +g_Tmpv2
 rt_tendf(i,kts,j) =rt_tendf(i,kts,j) +Tmpv2

 ENDDO
 ENDDO

 CASE DEFAULT  ! Added by Ning Pan, 2010-08-11

! Revised by Ning Pan, 2010-08-10
! CALL g_wrf_error_fatal('isfflx value invalid for diff_opt=2')
 CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')

 END SELECT tl_hflux  ! Added by Ning Pan, 2010-08-11

 IF(km_opt .eq. 2) THEN

 CALL g_vertical_diffusion_s(tke_tendf(ims,kms,jms),g_tke_tendf(ims,kms,jms) &
,config_flags,tke(ims,kms,jms),g_tke(ims,kms,jms),mu,g_mu,xkhv,g_xkhv,dn, &
 dnw,rdz,g_rdz,rdzw,g_rdzw,fnm,fnp,.true.,ids,ide,jds,jde,kds,kde,ims,ime,jms, &
 jme,kms,kme,its,ite,jts,jte,kts,kte)
 endif

 IF(n_moist .ge. PARAM_FIRST_SCALAR) THEN

 DO im =PARAM_FIRST_SCALAR,n_moist

 IF( (.not. config_flags%mix_full_fields) .and. (im == P_QV) ) THEN

 DO j =jts,min(jte,jde-1)
 DO k =kts,kte-1
 DO i =its,min(ite,ide-1)

 g_var_mix(i,k,j) =g_moist(i,k,j,im)
 var_mix(i,k,j) =moist(i,k,j,im) -qv_base(k)

 ENDDO
 ENDDO
 ENDDO
 ELSE

 DO j =jts,min(jte,jde-1)
 DO k =kts,kte-1
 DO i =its,min(ite,ide-1)

 g_var_mix(i,k,j) =g_moist(i,k,j,im)
 var_mix(i,k,j) =moist(i,k,j,im)

 ENDDO
 ENDDO
 ENDDO
 END IF

 CALL g_vertical_diffusion_s(moist_tendf(ims,kms,jms,im),g_moist_tendf(ims,kms, &
 jms,im),config_flags,var_mix,g_var_mix,mu,g_mu,xkhv,g_xkhv,dn,dnw,rdz, &
 g_rdz,rdzw,g_rdzw,fnm,fnp,.false.,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
 kme,its,ite,jts,jte,kts,kte)

! Added by Ning Pan, 2010-08-11
 tl_qflux: SELECT CASE( config_flags%isfflx )
 CASE (0)
 CASE (1,2)

 IF( im == P_QV ) THEN

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_Tmpv1 =(g_qfx(i,j)*rho(i,1,j) -g_rho(i,1,j)*qfx(i,j))/(rho(i,1,j)*rho(i,1,j)) 
 Tmpv1 =qfx(i,j)/rho(i,1,j)

 g_Tmpv2 =(g_Tmpv1*(1. +moist(i,kts,j,P_QV)) -(g_moist(i,kts,j,P_QV))*Tmpv1) &
/((1. +moist(i,kts,j,P_QV))*(1. +moist(i,kts,j,P_QV))) 
 Tmpv2 =Tmpv1/(1. +moist(i,kts,j,P_QV))

 g_moist_flux =g_Tmpv2
 moist_flux =Tmpv2

 g_Tmpv1 =mu(i,j)*g_moist_flux +g_mu(i,j)*moist_flux 
 Tmpv1 =mu(i,j)*moist_flux

 g_Tmpv2 =Tmpv1*g_rdzw(i,kts,j) +g_Tmpv1*rdzw(i,kts,j) 
 Tmpv2 =Tmpv1*rdzw(i,kts,j)

 g_moist_tendf(i,kts,j,im) =g_moist_tendf(i,kts,j,im) +g_Tmpv2
 moist_tendf(i,kts,j,im) =moist_tendf(i,kts,j,im) +Tmpv2

 ENDDO
 ENDDO
 ENDIF

 CASE DEFAULT  ! Added by Ning Pan, 2010-08-11

! Revised by Ning Pan, 2010-08-10
! CALL g_wrf_error_fatal('isfflx value invalid for diff_opt=2')
 CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')

 END SELECT tl_qflux  ! Added by Ning Pan, 2010-08-11

 ENDDO
 ENDIF

 IF(n_chem .ge. PARAM_FIRST_SCALAR) THEN

 DO im =PARAM_FIRST_SCALAR,n_chem
 CALL g_vertical_diffusion_s(chem_tendf(ims,kms,jms,im),g_chem_tendf(ims,kms, &
 jms,im),config_flags,chem(ims,kms,jms,im),g_chem(ims,kms,jms,im),mu,g_mu,xkhv, &
 g_xkhv,dn,dnw,rdz,g_rdz,rdzw,g_rdzw,fnm,fnp,.false.,ids,ide,jds,jde,kds,kde, &
 ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
 ENDDO
 ENDIF

 IF(n_tracer .ge. PARAM_FIRST_SCALAR) THEN

 DO im =PARAM_FIRST_SCALAR,n_tracer

 CALL g_vertical_diffusion_s(tracer_tendf(ims,kms,jms,im),g_tracer_tendf(ims, &
 kms,jms,im),config_flags,tracer(ims,kms,jms,im),g_tracer(ims,kms,jms,im) &
,mu,g_mu,xkhv,g_xkhv,dn,dnw,rdz,g_rdz,rdzw,g_rdzw,fnm,fnp,.false.,ids, &
 ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
 ENDDO
 ENDIF

 IF(n_scalar .ge. PARAM_FIRST_SCALAR) THEN

 DO im =PARAM_FIRST_SCALAR,n_scalar

 CALL g_vertical_diffusion_s(scalar_tendf(ims,kms,jms,im),g_scalar_tendf(ims, &
 kms,jms,im),config_flags,scalar(ims,kms,jms,im),g_scalar(ims,kms,jms,im) &
,mu,g_mu,xkhv,g_xkhv,dn,dnw,rdz,g_rdz,rdzw,g_rdzw,fnm,fnp,.false.,ids, &
 ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
 ENDDO
 ENDIF

 END SUBROUTINE g_vertical_diffusion_2

 SUBROUTINE g_vertical_diffusion_u_2(tendency,g_tendency,config_flags,mu, &
 g_mu,defor13,g_defor13,xkmv,g_xkmv,nba_mij,g_nba_mij,n_nba_mij,dnw,rdzw, &
 g_rdzw,fnm,fnp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 REAL,DIMENSION(kms:kme) :: fnm
 REAL,DIMENSION(kms:kme) :: fnp
 REAL,DIMENSION(kms:kme) :: dnw
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,g_tendency
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor13,g_defor13,xkmv,g_xkmv,rdzw,g_rdzw

 INTEGER :: n_nba_mij

 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,g_nba_mij
 REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 INTEGER :: i,j,k,ktf
 INTEGER :: i_start,i_end,j_start,j_end
 INTEGER :: is_ext,ie_ext,js_ext,je_ext
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau3,g_titau3
 REAL,DIMENSION(its:ite,jts:jte) :: zzavg,g_zzavg
 REAL :: rdzu,g_rdzu

 ktf =min(kte,kde-1)

 i_start =its

 i_end =ite

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .or. config_flags%specified .or.   &
        config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .or. config_flags%specified .or.   &
        config_flags%nested) i_end =min(ide-1,ite)

 IF( config_flags%open_ys .or. config_flags%specified .or.   &
        config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .or. config_flags%specified .or.   &
        config_flags%nested) j_end =min(jde-2,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =ite

 is_ext =0

 ie_ext =0

 js_ext =0

 je_ext =0

 CALL g_cal_titau_13_31(config_flags,titau3,g_titau3,defor13,g_defor13, &
 nba_mij(ims,kms,jms,P_m13),g_nba_mij(ims,kms,jms,P_m13),mu,g_mu,xkmv,g_xkmv, &
 fnm,fnp,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
 its,ite,jts,jte,kts,kte)

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_rdzu =-2.*(-1.*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j)) +(-1.*g_rdzw(i-1,k, &
 j)/(rdzw(i-1,k,j)*rdzw(i-1,k,j))))/((1./rdzw(i,k,j) +1./rdzw(i-1,k,j))*(1./rdzw(i,k, &
 j) +1./rdzw(i-1,k,j)))
 rdzu =2./(1./rdzw(i,k,j) +1./rdzw(i-1,k,j))

 g_Tmpv1 =rdzu*(g_titau3(i,k+1,j) -g_titau3(i,k,j)) +g_rdzu*(titau3(i,k+ &
 1,j) -titau3(i,k,j)) 
 Tmpv1 =rdzu*(titau3(i,k+1,j) -titau3(i,k,j))

 g_tendency(i,k,j) =g_tendency(i,k,j) -g_Tmpv1
 tendency(i,k,j) =tendency(i,k,j) -Tmpv1

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end

 k =kts

 DO i =i_start,i_end

 g_rdzu =-2.*(-1.*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j)) +(-1.*g_rdzw(i-1,k, &
 j)/(rdzw(i-1,k,j)*rdzw(i-1,k,j))))/((1./rdzw(i,k,j) +1./rdzw(i-1,k,j))*(1./rdzw(i,k, &
 j) +1./rdzw(i-1,k,j)))
 rdzu =2./(1./rdzw(i,k,j) +1./rdzw(i-1,k,j))

 g_Tmpv1 =rdzu*(g_titau3(i,k+1,j)) +g_rdzu*(titau3(i,k+1,j)) 
 Tmpv1 =rdzu*(titau3(i,k+1,j))

 g_tendency(i,k,j) =g_tendency(i,k,j) -g_Tmpv1
 tendency(i,k,j) =tendency(i,k,j) -Tmpv1

 ENDDO
 ENDDO

 END SUBROUTINE g_vertical_diffusion_u_2

 SUBROUTINE g_vertical_diffusion_v_2(tendency,g_tendency,config_flags,mu, &
 g_mu,defor23,g_defor23,xkmv,g_xkmv,nba_mij,g_nba_mij,n_nba_mij,dnw,rdzw, &
 g_rdzw,fnm,fnp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 REAL,DIMENSION(kms:kme) :: fnm
 REAL,DIMENSION(kms:kme) :: fnp
 REAL,DIMENSION(kms:kme) :: dnw
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,g_tendency
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor23,g_defor23,xkmv,g_xkmv,rdzw,g_rdzw

 INTEGER :: n_nba_mij

 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,g_nba_mij
 REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 INTEGER :: i,j,k,ktf
 INTEGER :: i_start,i_end,j_start,j_end
 INTEGER :: is_ext,ie_ext,js_ext,je_ext
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau3,g_titau3
 REAL,DIMENSION(its:ite,jts:jte) :: zzavg,g_zzavg
 REAL :: rdzv,g_rdzv

 ktf =min(kte,kde-1)

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =jte

 IF( config_flags%open_xs .or. config_flags%specified .or.   &
        config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .or. config_flags%specified .or.   &
        config_flags%nested) i_end =min(ide-2,ite)

 IF( config_flags%open_ys .or. config_flags%specified .or.   &
        config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .or. config_flags%specified .or.   &
        config_flags%nested) j_end =min(jde-1,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide-1)

 is_ext =0

 ie_ext =0

 js_ext =0

 je_ext =0

 CALL g_cal_titau_23_32(config_flags,titau3,g_titau3,defor23,g_defor23, &
 nba_mij(ims,kms,jms,P_m23),g_nba_mij(ims,kms,jms,P_m23),mu,g_mu,xkmv,g_xkmv, &
 fnm,fnp,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
 its,ite,jts,jte,kts,kte)

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_rdzv =-2.*(-1.*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j)) +(-1.*g_rdzw(i,k,j- &
 1)/(rdzw(i,k,j-1)*rdzw(i,k,j-1))))/((1./rdzw(i,k,j) +1./rdzw(i,k,j-1))*(1./rdzw(i,k, &
 j) +1./rdzw(i,k,j-1)))
 rdzv =2./(1./rdzw(i,k,j) +1./rdzw(i,k,j-1))

 g_Tmpv1 =rdzv*(g_titau3(i,k+1,j) -g_titau3(i,k,j)) +g_rdzv*(titau3(i,k+ &
 1,j) -titau3(i,k,j)) 
 Tmpv1 =rdzv*(titau3(i,k+1,j) -titau3(i,k,j))

 g_tendency(i,k,j) =g_tendency(i,k,j) -g_Tmpv1
 tendency(i,k,j) =tendency(i,k,j) -Tmpv1

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end

 k =kts

 DO i =i_start,i_end

 g_rdzv =-2.*(-1.*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j)) +(-1.*g_rdzw(i,k,j- &
 1)/(rdzw(i,k,j-1)*rdzw(i,k,j-1))))/((1./rdzw(i,k,j) +1./rdzw(i,k,j-1))*(1./rdzw(i,k, &
 j) +1./rdzw(i,k,j-1)))
 rdzv =2./(1./rdzw(i,k,j) +1./rdzw(i,k,j-1))

 g_Tmpv1 =rdzv*(g_titau3(i,k+1,j)) +g_rdzv*(titau3(i,k+1,j)) 
 Tmpv1 =rdzv*(titau3(i,k+1,j))

 g_tendency(i,k,j) =g_tendency(i,k,j) -g_Tmpv1
 tendency(i,k,j) =tendency(i,k,j) -Tmpv1

 ENDDO
 ENDDO

 END SUBROUTINE g_vertical_diffusion_v_2

 SUBROUTINE g_vertical_diffusion_w_2(tendency,g_tendency,config_flags,mu, &
 g_mu,defor33,g_defor33,tke,g_tke,nba_mij,g_nba_mij,n_nba_mij,div, &
 g_div,xkmv,g_xkmv,dn,rdz,g_rdz,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
 kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 REAL,DIMENSION(kms:kme) :: dn
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,g_tendency
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor33,g_defor33,tke,g_tke,div, &
 g_div,xkmv,g_xkmv,rdz,g_rdz

 INTEGER :: n_nba_mij

 REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,g_nba_mij
 REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 INTEGER :: i,j,k,ktf
 INTEGER :: i_start,i_end,j_start,j_end
 INTEGER :: is_ext,ie_ext,js_ext,je_ext
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau3,g_titau3

 ktf =min(kte,kde-1)

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .or. config_flags%specified .or.   &
        config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .or. config_flags%specified .or.   &
        config_flags%nested) i_end =min(ide-2,ite)

 IF( config_flags%open_ys .or. config_flags%specified .or.   &
        config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .or. config_flags%specified .or.   &
        config_flags%nested) j_end =min(jde-2,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide-1)

 is_ext =0

 ie_ext =0

 js_ext =0

 je_ext =0

 CALL g_cal_titau_11_22_33(config_flags,titau3,g_titau3,mu,g_mu,tke,g_tke, &
 xkmv,g_xkmv,defor33,g_defor33,nba_mij(ims,kms,jms,P_m33),g_nba_mij(ims,kms, &
 jms,P_m33),is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
 kme,its,ite,jts,jte,kts,kte)

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =rdz(i,k,j)*(g_titau3(i,k,j) -g_titau3(i,k-1,j)) +g_rdz(i,k,j) &
*(titau3(i,k,j) -titau3(i,k-1,j)) 
 Tmpv1 =rdz(i,k,j)*(titau3(i,k,j) -titau3(i,k-1,j))

 g_tendency(i,k,j) =g_tendency(i,k,j) -g_Tmpv1
 tendency(i,k,j) =tendency(i,k,j) -Tmpv1

 ENDDO
 ENDDO
 ENDDO

 END SUBROUTINE g_vertical_diffusion_w_2

 SUBROUTINE g_vertical_diffusion_s(tendency,g_tendency,config_flags,var, &
 g_var,mu,g_mu,xkhv,g_xkhv,dn,dnw,rdz,g_rdz,rdzw,g_rdzw,fnm,fnp, &
 doing_tke,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 LOGICAL :: doing_tke
 REAL,DIMENSION(kms:kme) :: fnm
 REAL,DIMENSION(kms:kme) :: fnp
 REAL,DIMENSION(kms:kme) :: dn
 REAL,DIMENSION(kms:kme) :: dnw
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,g_tendency
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkhv,g_xkhv
 REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: var,g_var,rdz,g_rdz,rdzw,g_rdzw
 INTEGER :: i,j,k,ktf
 INTEGER :: i_start,i_end,j_start,j_end
 REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: H3,g_H3,xkxavg,g_xkxavg,rravg,g_rravg
 REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: tmptendf,g_tmptendf

 ktf =min(kte,kde-1)

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .or. config_flags%specified .or.   &
        config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .or. config_flags%specified .or.   &
        config_flags%nested) i_end =min(ide-2,ite)

 IF( config_flags%open_ys .or. config_flags%specified .or.   &
        config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .or. config_flags%specified .or.   &
        config_flags%nested) j_end =min(jde-2,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide-1)

 IF(doing_tke) THEN

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tmptendf(i,k,j) =g_tendency(i,k,j)
 tmptendf(i,k,j) =tendency(i,k,j)

 ENDDO
 ENDDO
 ENDDO
 ENDIF

 g_xkxavg =0.0
 xkxavg =0.

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_xkxavg(i,k,j) =fnm(k)*g_xkhv(i,k,j) +fnp(k)*g_xkhv(i,k-1,j)
 xkxavg(i,k,j) =fnm(k)*xkhv(i,k,j) +fnp(k)*xkhv(i,k-1,j)

 g_Tmpv1 =-xkxavg(i,k,j)*(g_var(i,k,j) -g_var(i,k-1,j)) -g_xkxavg(i,k,j) &
*(var(i,k,j) -var(i,k-1,j)) 
 Tmpv1 =-xkxavg(i,k,j)*(var(i,k,j) -var(i,k-1,j))

 g_Tmpv2 =Tmpv1*g_rdz(i,k,j) +g_Tmpv1*rdz(i,k,j) 
 Tmpv2 =Tmpv1*rdz(i,k,j)

 g_H3(i,k,j) =g_Tmpv2
 H3(i,k,j) =Tmpv2

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_H3(i,kts,j) =0.0
 H3(i,kts,j) =0.

 g_H3(i,ktf+1,j) =0.0
 H3(i,ktf+1,j) =0.

 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =mu(i,j)*(g_H3(i,k+1,j) -g_H3(i,k,j)) +g_mu(i,j)*(H3(i,k+1,j) -H3(i,k,j)) 
 Tmpv1 =mu(i,j)*(H3(i,k+1,j) -H3(i,k,j))

 g_Tmpv2 =Tmpv1*g_rdzw(i,k,j) +g_Tmpv1*rdzw(i,k,j) 
 Tmpv2 =Tmpv1*rdzw(i,k,j)

 g_tendency(i,k,j) =g_tendency(i,k,j) -g_Tmpv2
 tendency(i,k,j) =tendency(i,k,j) -Tmpv2

 ENDDO
 ENDDO
 ENDDO

 IF(doing_tke) THEN

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tendency(i,k,j) =g_tmptendf(i,k,j) +2.*(g_tendency(i,k,j) -g_tmptendf(i,k,j))
 tendency(i,k,j) =tmptendf(i,k,j) +2.*(tendency(i,k,j) -tmptendf(i,k,j))

 ENDDO
 ENDDO
 ENDDO
 ENDIF

 END SUBROUTINE g_vertical_diffusion_s

 SUBROUTINE g_cal_titau_11_22_33(config_flags,titau,g_titau,mu,g_mu,tke, &
 g_tke,xkx,g_xkx,defor,g_defor,mtau,g_mtau,is_ext,ie_ext,js_ext,je_ext, &
 ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 INTEGER :: is_ext,ie_ext,js_ext,je_ext
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau,g_titau
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor,g_defor,xkx,g_xkx,tke,g_tke

 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: mtau,g_mtau
 REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 INTEGER :: i,j,k,ktf,i_start,i_end,j_start,j_end

 ktf =min(kte,kde-1)

 i_start =its

 i_end =ite

 j_start =jts

 j_end =jte

 IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
         config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
         config_flags%nested) i_end =min(ide-1,ite)

 IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
         config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
         config_flags%nested) j_end =min(jde-1,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =ite

 i_start =i_start-is_ext

 i_end =i_end+ie_ext

 j_start =j_start-js_ext

 j_end =j_end+je_ext

 IF( config_flags%sfs_opt .GT. 0 ) THEN

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =mu(i,j)*g_mtau(i,k,j) +g_mu(i,j)*mtau(i,k,j) 
 Tmpv1 =mu(i,j)*mtau(i,k,j)

 g_titau(i,k,j) =g_Tmpv1
 titau(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 ELSE

 IF( config_flags%m_opt .EQ. 1 ) THEN

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =-mu(i,j)*g_xkx(i,k,j) -g_mu(i,j)*xkx(i,k,j) 
 Tmpv1 =-mu(i,j)*xkx(i,k,j)

 g_Tmpv2 =Tmpv1*g_defor(i,k,j) +g_Tmpv1*defor(i,k,j) 
 Tmpv2 =Tmpv1*defor(i,k,j)

 g_titau(i,k,j) =g_Tmpv2
 titau(i,k,j) =Tmpv2

 g_Tmpv1 =-xkx(i,k,j)*g_defor(i,k,j) -g_xkx(i,k,j)*defor(i,k,j) 
 Tmpv1 =-xkx(i,k,j)*defor(i,k,j)

 g_mtau(i,k,j) =g_Tmpv1
 mtau(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 ELSE

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =-mu(i,j)*g_xkx(i,k,j) -g_mu(i,j)*xkx(i,k,j) 
 Tmpv1 =-mu(i,j)*xkx(i,k,j)

 g_Tmpv2 =Tmpv1*g_defor(i,k,j) +g_Tmpv1*defor(i,k,j) 
 Tmpv2 =Tmpv1*defor(i,k,j)

 g_titau(i,k,j) =g_Tmpv2
 titau(i,k,j) =Tmpv2

 ENDDO
 ENDDO
 ENDDO
 ENDIF
 ENDIF

 END SUBROUTINE g_cal_titau_11_22_33

 SUBROUTINE g_cal_titau_12_21(config_flags,titau,g_titau,mu,g_mu,xkx, &
 g_xkx,defor,g_defor,mtau,g_mtau,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde, &
 kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 INTEGER :: is_ext,ie_ext,js_ext,je_ext
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau,g_titau
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor,g_defor,xkx,g_xkx

 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: mtau,g_mtau
 REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 INTEGER :: i,j,k,ktf,i_start,i_end,j_start,j_end
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: xkxavg,g_xkxavg
 REAL,DIMENSION(its-1:ite+1,jts-1:jte+1) :: muavg,g_muavg

 ktf =min(kte,kde-1)

 i_start =its

 i_end =ite

 j_start =jts

 j_end =jte

 IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
         config_flags%nested ) i_start =max(ids+1,its)

 IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
         config_flags%nested ) i_end =min(ide-1,ite)

 IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
         config_flags%nested ) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
         config_flags%nested ) j_end =min(jde-1,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =ite

 i_start =i_start-is_ext

 i_end =i_end+ie_ext

 j_start =j_start-js_ext

 j_end =j_end+je_ext

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_xkxavg(i,k,j) =0.25*(g_xkx(i-1,k,j) +g_xkx(i,k,j) +g_xkx(i-1,k,j-1) &
 +g_xkx(i,k,j-1))
 xkxavg(i,k,j) =0.25*(xkx(i-1,k,j) +xkx(i,k,j) +xkx(i-1,k,j-1) +xkx(i,k,j-1))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_muavg(i,j) =0.25*(g_mu(i-1,j) +g_mu(i,j) +g_mu(i-1,j-1) +g_mu(i,j-1))
 muavg(i,j) =0.25*(mu(i-1,j) +mu(i,j) +mu(i-1,j-1) +mu(i,j-1))

 ENDDO
 ENDDO

 IF( config_flags%sfs_opt .GT. 0 ) THEN

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =muavg(i,j)*g_mtau(i,k,j) +g_muavg(i,j)*mtau(i,k,j) 
 Tmpv1 =muavg(i,j)*mtau(i,k,j)

 g_titau(i,k,j) =g_Tmpv1
 titau(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 ELSE

 IF( config_flags%m_opt .EQ. 1 ) THEN

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =-muavg(i,j)*g_xkxavg(i,k,j) -g_muavg(i,j)*xkxavg(i,k,j) 
 Tmpv1 =-muavg(i,j)*xkxavg(i,k,j)

 g_Tmpv2 =Tmpv1*g_defor(i,k,j) +g_Tmpv1*defor(i,k,j) 
 Tmpv2 =Tmpv1*defor(i,k,j)

 g_titau(i,k,j) =g_Tmpv2
 titau(i,k,j) =Tmpv2

 g_Tmpv1 =-xkxavg(i,k,j)*g_defor(i,k,j) -g_xkxavg(i,k,j)*defor(i,k,j) 
 Tmpv1 =-xkxavg(i,k,j)*defor(i,k,j)

 g_mtau(i,k,j) =g_Tmpv1
 mtau(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 ELSE

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =-muavg(i,j)*g_xkxavg(i,k,j) -g_muavg(i,j)*xkxavg(i,k,j) 
 Tmpv1 =-muavg(i,j)*xkxavg(i,k,j)

 g_Tmpv2 =Tmpv1*g_defor(i,k,j) +g_Tmpv1*defor(i,k,j) 
 Tmpv2 =Tmpv1*defor(i,k,j)

 g_titau(i,k,j) =g_Tmpv2
 titau(i,k,j) =Tmpv2

 ENDDO
 ENDDO
 ENDDO
 ENDIF
 ENDIF

 END SUBROUTINE g_cal_titau_12_21

 SUBROUTINE g_cal_titau_13_31(config_flags,titau,g_titau,defor,g_defor,mtau, &
 g_mtau,mu,g_mu,xkx,g_xkx,fnm,fnp,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds, &
 jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 INTEGER :: is_ext,ie_ext,js_ext,je_ext
 REAL,DIMENSION(kms:kme) :: fnm,fnp
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau,g_titau
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor,g_defor,xkx,g_xkx

 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: mtau,g_mtau
 REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 INTEGER :: i,j,k,ktf,i_start,i_end,j_start,j_end
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: xkxavg,g_xkxavg
 REAL,DIMENSION(its-1:ite+1,jts-1:jte+1) :: muavg,g_muavg

 ktf =min(kte,kde-1)

 i_start =its

 i_end =ite

 j_start =jts

 j_end =min(jte,jde-1)

 IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
         config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
         config_flags%nested) i_end =min(ide-1,ite)

 IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
         config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
         config_flags%nested) j_end =min(jde-2,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =ite

 i_start =i_start-is_ext

 i_end =i_end+ie_ext

 j_start =j_start-js_ext

 j_end =j_end+je_ext

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_xkxavg(i,k,j) =0.5*(fnm(k)*(g_xkx(i,k,j) +g_xkx(i-1,k,j)) +fnp(k) &
*(g_xkx(i,k-1,j) +g_xkx(i-1,k-1,j)))
 xkxavg(i,k,j) =0.5*(fnm(k)*(xkx(i,k,j) +xkx(i-1,k,j)) +fnp(k)*(xkx(i,k-1,j) &
 +xkx(i-1,k-1,j)))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_muavg(i,j) =0.5*(g_mu(i,j) +g_mu(i-1,j))
 muavg(i,j) =0.5*(mu(i,j) +mu(i-1,j))

 ENDDO
 ENDDO

 IF( config_flags%sfs_opt .GT. 0 ) THEN

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =muavg(i,j)*g_mtau(i,k,j) +g_muavg(i,j)*mtau(i,k,j) 
 Tmpv1 =muavg(i,j)*mtau(i,k,j)

 g_titau(i,k,j) =g_Tmpv1
 titau(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 ELSE

 IF( config_flags%m_opt .EQ. 1 ) THEN

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =-muavg(i,j)*g_xkxavg(i,k,j) -g_muavg(i,j)*xkxavg(i,k,j) 
 Tmpv1 =-muavg(i,j)*xkxavg(i,k,j)

 g_Tmpv2 =Tmpv1*g_defor(i,k,j) +g_Tmpv1*defor(i,k,j) 
 Tmpv2 =Tmpv1*defor(i,k,j)

 g_titau(i,k,j) =g_Tmpv2
 titau(i,k,j) =Tmpv2

 g_Tmpv1 =-xkxavg(i,k,j)*g_defor(i,k,j) -g_xkxavg(i,k,j)*defor(i,k,j) 
 Tmpv1 =-xkxavg(i,k,j)*defor(i,k,j)

 g_mtau(i,k,j) =g_Tmpv1
 mtau(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 ELSE

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =-muavg(i,j)*g_xkxavg(i,k,j) -g_muavg(i,j)*xkxavg(i,k,j) 
 Tmpv1 =-muavg(i,j)*xkxavg(i,k,j)

 g_Tmpv2 =Tmpv1*g_defor(i,k,j) +g_Tmpv1*defor(i,k,j) 
 Tmpv2 =Tmpv1*defor(i,k,j)

 g_titau(i,k,j) =g_Tmpv2
 titau(i,k,j) =Tmpv2

 ENDDO
 ENDDO
 ENDDO
 ENDIF
 ENDIF

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_titau(i,kts,j) =0.0
 titau(i,kts,j) =0.0

 g_titau(i,ktf+1,j) =0.0
 titau(i,ktf+1,j) =0.0

 ENDDO
 ENDDO

 END SUBROUTINE g_cal_titau_13_31

 SUBROUTINE g_cal_titau_23_32(config_flags,titau,g_titau,defor,g_defor,mtau, &
 g_mtau,mu,g_mu,xkx,g_xkx,fnm,fnp,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds, &
 jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2
 TYPE(grid_config_rec_type) :: config_flags
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 INTEGER :: is_ext,ie_ext,js_ext,je_ext
 REAL,DIMENSION(kms:kme) :: fnm,fnp
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau,g_titau
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor,g_defor,xkx,g_xkx

 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: mtau,g_mtau
 REAL,DIMENSION(ims:ime,jms:jme) :: mu,g_mu
 INTEGER :: i,j,k,ktf,i_start,i_end,j_start,j_end
 REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: xkxavg,g_xkxavg
 REAL,DIMENSION(its-1:ite+1,jts-1:jte+1) :: muavg,g_muavg

 ktf =min(kte,kde-1)

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =jte

 IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
         config_flags%nested) i_start =max(ids+1,its)

 IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
         config_flags%nested) i_end =min(ide-2,ite)

 IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
         config_flags%nested) j_start =max(jds+1,jts)

 IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
         config_flags%nested) j_end =min(jde-1,jte)

 IF( config_flags%periodic_x ) i_start =its

 IF( config_flags%periodic_x ) i_end =min(ite,ide-1)

 i_start =i_start-is_ext

 i_end =i_end+ie_ext

 j_start =j_start-js_ext

 j_end =j_end+je_ext

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_xkxavg(i,k,j) =0.5*(fnm(k)*(g_xkx(i,k,j) +g_xkx(i,k,j-1)) +fnp(k) &
*(g_xkx(i,k-1,j) +g_xkx(i,k-1,j-1)))
 xkxavg(i,k,j) =0.5*(fnm(k)*(xkx(i,k,j) +xkx(i,k,j-1)) +fnp(k)*(xkx(i,k-1,j) &
 +xkx(i,k-1,j-1)))

 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_muavg(i,j) =0.5*(g_mu(i,j) +g_mu(i,j-1))
 muavg(i,j) =0.5*(mu(i,j) +mu(i,j-1))

 ENDDO
 ENDDO

 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

 g_Tmpv1 =muavg(i,j)*g_mtau(i,k,j) +g_muavg(i,j)*mtau(i,k,j) 
 Tmpv1 =muavg(i,j)*mtau(i,k,j)

 g_titau(i,k,j) =g_Tmpv1
 titau(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 ELSE

 IF( config_flags%m_opt .EQ. 1 ) THEN

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =-muavg(i,j)*g_xkxavg(i,k,j) -g_muavg(i,j)*xkxavg(i,k,j) 
 Tmpv1 =-muavg(i,j)*xkxavg(i,k,j)

 g_Tmpv2 =Tmpv1*g_defor(i,k,j) +g_Tmpv1*defor(i,k,j) 
 Tmpv2 =Tmpv1*defor(i,k,j)

 g_titau(i,k,j) =g_Tmpv2
 titau(i,k,j) =Tmpv2

 g_Tmpv1 =-xkxavg(i,k,j)*g_defor(i,k,j) -g_xkxavg(i,k,j)*defor(i,k,j) 
 Tmpv1 =-xkxavg(i,k,j)*defor(i,k,j)

 g_mtau(i,k,j) =g_Tmpv1
 mtau(i,k,j) =Tmpv1

 ENDDO
 ENDDO
 ENDDO

 ELSE

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 g_Tmpv1 =-muavg(i,j)*g_xkxavg(i,k,j) -g_muavg(i,j)*xkxavg(i,k,j) 
 Tmpv1 =-muavg(i,j)*xkxavg(i,k,j)

 g_Tmpv2 =Tmpv1*g_defor(i,k,j) +g_Tmpv1*defor(i,k,j) 
 Tmpv2 =Tmpv1*defor(i,k,j)

 g_titau(i,k,j) =g_Tmpv2
 titau(i,k,j) =Tmpv2

 ENDDO
 ENDDO
 ENDDO
 ENDIF
 ENDIF

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_titau(i,kts,j) =0.0
 titau(i,kts,j) =0.0

 g_titau(i,ktf+1,j) =0.0
 titau(i,ktf+1,j) =0.0

 ENDDO
 ENDDO

 END SUBROUTINE g_cal_titau_23_32

 END MODULE g_module_diffusion_em

 REAL Function g_Sqrt(g_x,x)

 REAL g_x,x

 IF(x.GT.0.0) THEN 
   g_Sqrt =0.5*g_x/sqrt(x) 
 ELSE 
! Revised by Ning Pan, 2010-08-10
!   Print*,'' 
!   Print*,'g_Sqrt is incorrectly evaluated by 0!' 
!   Print*,'Aborted from compute_diff_metrics' 
!   g_Sqrt =0.0 
   g_Sqrt =0.5*g_x/(sqrt(x)+1.e-6)
 END IF

 RETURN 
 END