wrftladj/module_sfs_nba_tl.F

   1
   2 ! ======================================================================================
   3 ! This file was generated by the version 5.3.6 of DFT on 08/15/2010. The differentiation
   4 ! transforming system(DFT) was jointly developed and sponsored by LASG of IAP(1998-2010)
   5 ! and LSEC of ICMSEC, AMSS(2001-2003)
   6 ! The copyright of the DFT system was declared by Walls at LASG, 1998-2010
   7 ! ======================================================================================
   8
   9  MODULE g_module_sfs_nba
  10
  11  USE module_configure, ONLY : grid_config_rec_type
  12  USE module_sfs_nba, ONLY : c1, c2, c3, ce, cb, cs  ! Added by Ning Pan, 2010-08-18
  13
  14  IMPLICIT NONE
  15
  16 ! REAL :: c1,c2,c3,ce,cb,cs  ! Remarked by Ning Pan, 2010-08-18
  17
  18  CONTAINS
  19
  20 ! Remarked by Ning Pan, 2010-08-18
  21 ! SUBROUTINE g_calc_mij_constants()
  22
  23 ! IMPLICIT NONE
  24
  25 ! REAL :: Tmpv1,g_Tmpv1
  26 ! REAL :: sk,pi
  27
  28 ! sk =0.5
  29
  30 ! pi =3.1415927
  31
  32 ! cb =0.36
  33
  34 ! cs =((8.0 *(1.0+cb))/(27.0 *pi**2))**0.5
  35
  36 ! c1 =((960.0**0.5) *cb)/(7.0 *(1.0+cb) *sk)
  37
  38 ! c2 =c1
  39
  40 ! ce =((8.0 *pi/27.0)**(1.0/3.0)) *cs**(4.0/3.0)
  41
  42 ! c3 =((27.0/(8.0 *pi))**(1.0/3.0)) *cs**(2.0/3.0)
  43 ! Return
  44
  45 ! END SUBROUTINE g_calc_mij_constants
  46
  47  SUBROUTINE g_calc_smnsmn(smnsmn,g_smnsmn,s11,g_s11,s22,g_s22,s33, &
  48  g_s33,s12,g_s12,s13,g_s13,s23,g_s23,config_flags,ids,ide,jds,jde,kds,kde, &
  49  ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
  50
  51  IMPLICIT NONE
  52
  53  REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3
  54  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: smnsmn,g_smnsmn
  55
  56  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s11,g_s11,s22,g_s22,s33,g_s33, &
  57  s12,g_s12,s13,g_s13,s23,g_s23
  58  TYPE(grid_config_rec_type) :: config_flags
  59  INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, &
  60  its,ite,jts,jte,kts,kte
  61  REAL :: tmp,g_tmp
  62  INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
  63
  64  ktf =min(kte,kde-1)
  65
  66  i_start =its
  67
  68  i_end =min(ite,ide-1)
  69
  70  j_start =jts
  71
  72  j_end =min(jte,jde-1)
  73
  74  IF( config_flags%open_xs .or. config_flags%specified .or.   &
  75        config_flags%nested) i_start =max(ids+1,its)
  76
  77  IF( config_flags%open_xe .or. config_flags%specified .or.   &
  78        config_flags%nested) i_end =min(ide-2,ite)
  79
  80  IF( config_flags%open_ys .or. config_flags%specified .or.   &
  81        config_flags%nested) j_start =max(jds+1,jts)
  82
  83  IF( config_flags%open_ye .or. config_flags%specified .or.   &
  84        config_flags%nested) j_end =min(jde-2,jte)
  85
  86  IF( config_flags%periodic_x ) i_start =its
  87
  88  IF( config_flags%periodic_x ) i_end =min(ite,ide-1)
  89
  90  DO j =j_start,j_end
  91  DO k =kts,ktf
  92  DO i =i_start,i_end
  93
  94  g_Tmpv1 =2.0*s11(i,k,j)*g_s11(i,k,j)
  95  Tmpv1 =s11(i,k,j)*s11(i,k,j)
  96
  97  g_Tmpv2 =2.0*s22(i,k,j)*g_s22(i,k,j)
  98  Tmpv2 =s22(i,k,j)*s22(i,k,j)
  99
 100  g_Tmpv3 =2.0*s33(i,k,j)*g_s33(i,k,j)
 101  Tmpv3 =s33(i,k,j)*s33(i,k,j)
 102
 103  g_smnsmn(i,k,j) =0.25*(g_Tmpv1 +g_Tmpv2 +g_Tmpv3)
 104  smnsmn(i,k,j) =0.25*(Tmpv1 +Tmpv2 +Tmpv3)
 105
 106  ENDDO
 107  ENDDO
 108  ENDDO
 109
 110  DO j =j_start,j_end
 111  DO k =kts,ktf
 112  DO i =i_start,i_end
 113
 114  g_tmp =0.125*(g_s12(i,k,j) +g_s12(i,k,j+1) +g_s12(i+1,k,j) +g_s12(i+1,k,j+1))
 115  tmp =0.125*(s12(i,k,j) +s12(i,k,j+1) +s12(i+1,k,j) +s12(i+1,k,j+1))
 116
 117  g_Tmpv1 =2.0*tmp*g_tmp +2.0*g_tmp*tmp
 118  Tmpv1 =2.0*tmp*tmp
 119
 120  g_smnsmn(i,k,j) =g_smnsmn(i,k,j) +g_Tmpv1
 121  smnsmn(i,k,j) =smnsmn(i,k,j) +Tmpv1
 122
 123  ENDDO
 124  ENDDO
 125  ENDDO
 126
 127  DO j =j_start,j_end
 128  DO k =kts,ktf
 129  DO i =i_start,i_end
 130
 131  g_tmp =0.125*(g_s13(i,k+1,j) +g_s13(i,k,j) +g_s13(i+1,k+1,j) +g_s13(i+1,k,j))
 132  tmp =0.125*(s13(i,k+1,j) +s13(i,k,j) +s13(i+1,k+1,j) +s13(i+1,k,j))
 133
 134  g_Tmpv1 =2.0*tmp*g_tmp +2.0*g_tmp*tmp
 135  Tmpv1 =2.0*tmp*tmp
 136
 137  g_smnsmn(i,k,j) =g_smnsmn(i,k,j) +g_Tmpv1
 138  smnsmn(i,k,j) =smnsmn(i,k,j) +Tmpv1
 139
 140  ENDDO
 141  ENDDO
 142  ENDDO
 143
 144  DO j =j_start,j_end
 145  DO k =kts,ktf
 146  DO i =i_start,i_end
 147
 148  g_tmp =0.125*(g_s23(i,k+1,j) +g_s23(i,k,j) +g_s23(i,k+1,j+1) +g_s23(i,k,j+1))
 149  tmp =0.125*(s23(i,k+1,j) +s23(i,k,j) +s23(i,k+1,j+1) +s23(i,k,j+1))
 150
 151  g_Tmpv1 =2.0*tmp*g_tmp +2.0*g_tmp*tmp
 152  Tmpv1 =2.0*tmp*tmp
 153
 154  g_smnsmn(i,k,j) =g_smnsmn(i,k,j) +g_Tmpv1
 155  smnsmn(i,k,j) =smnsmn(i,k,j) +Tmpv1
 156
 157  ENDDO
 158  ENDDO
 159  ENDDO
 160
 161  Return
 162
 163  END SUBROUTINE g_calc_smnsmn
 164
 165  SUBROUTINE g_calc_mii(m11,g_m11,m22,g_m22,m33,g_m33,s11,g_s11,s22, &
 166  g_s22,s33,g_s33,s12,g_s12,s13,g_s13,s23,g_s23,r12,g_r12,r13, &
 167  g_r13,r23,g_r23,smnsmn,g_smnsmn,tke,g_tke,rdzw,g_rdzw,dx,dy, &
 168  config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, &
 169  its,ite,jts,jte,kts,kte)
 170
 171  IMPLICIT NONE
 172
 173  REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4,Tmpv5, &
 174  g_Tmpv5,Tmpv6,g_Tmpv6,Tmpv7,g_Tmpv7,Tmpv8,g_Tmpv8
 175
 176    REAL :: g_Sqrt
 177  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: m11,g_m11,m22,g_m22,m33,g_m33
 178
 179  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s11,g_s11,s22,g_s22,s33,g_s33, &
 180  s12,g_s12,s13,g_s13,s23,g_s23,r12,g_r12,r13,g_r13,r23,g_r23,smnsmn, &
 181  g_smnsmn,tke,g_tke,rdzw,g_rdzw
 182
 183  REAL :: dx,dy
 184  TYPE(grid_config_rec_type) :: config_flags
 185  INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, &
 186  its,ite,jts,jte,kts,kte
 187
 188  REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss11,g_ss11,ss22,g_ss22, &
 189  ss33,g_ss33,ss12,g_ss12,ss13,g_ss13,ss23,g_ss23,rr12,g_rr12,rr13, &
 190  g_rr13,rr23,g_rr23
 191
 192  REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss12c,g_ss12c,rr12c,g_rr12c, &
 193  ss13c,g_ss13c,rr13c,g_rr13c,ss23c,g_ss23c,rr23c,g_rr23c
 194  REAL :: delta,g_delta,a,g_a,b,g_b
 195  INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf,is_ext,js_ext
 196
 197
 198
 199  ktf =min(kte,kde-1)
 200
 201  i_start =its
 202
 203  i_end =ite
 204
 205  j_start =jts
 206
 207  j_end =jte
 208
 209  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
 210          config_flags%nested) i_start =max(ids+1,its)
 211
 212  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
 213          config_flags%nested) i_end =min(ide-1,ite)
 214
 215  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
 216          config_flags%nested) j_start =max(jds+1,jts)
 217
 218  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
 219          config_flags%nested) j_end =min(jde-1,jte)
 220
 221  IF( config_flags%periodic_x ) i_start =its
 222
 223  IF( config_flags%periodic_x ) i_end =ite
 224
 225  is_ext =1
 226
 227  js_ext =1
 228
 229  i_start =i_start-is_ext
 230
 231  j_start =j_start-js_ext
 232
 233  DO j =j_start,j_end+1
 234  DO k =kts,ktf
 235  DO i =i_start,i_end+1
 236
 237  g_ss11(i,k,j) =g_s11(i,k,j)/2.0
 238  ss11(i,k,j) =s11(i,k,j)/2.0
 239
 240  g_ss22(i,k,j) =g_s22(i,k,j)/2.0
 241  ss22(i,k,j) =s22(i,k,j)/2.0
 242
 243  g_ss33(i,k,j) =g_s33(i,k,j)/2.0
 244  ss33(i,k,j) =s33(i,k,j)/2.0
 245
 246  g_ss12(i,k,j) =g_s12(i,k,j)/2.0
 247  ss12(i,k,j) =s12(i,k,j)/2.0
 248
 249  g_ss13(i,k,j) =g_s13(i,k,j)/2.0
 250  ss13(i,k,j) =s13(i,k,j)/2.0
 251
 252  g_ss23(i,k,j) =g_s23(i,k,j)/2.0
 253  ss23(i,k,j) =s23(i,k,j)/2.0
 254
 255  g_rr12(i,k,j) =g_r12(i,k,j)/2.0
 256  rr12(i,k,j) =r12(i,k,j)/2.0
 257
 258  g_rr13(i,k,j) =g_r13(i,k,j)/2.0
 259  rr13(i,k,j) =r13(i,k,j)/2.0
 260
 261  g_rr23(i,k,j) =g_r23(i,k,j)/2.0
 262  rr23(i,k,j) =r23(i,k,j)/2.0
 263
 264  ENDDO
 265  ENDDO
 266  ENDDO
 267
 268  DO j =j_start,j_end+1
 269  DO i =i_start,i_end+1
 270
 271  g_ss13(i,kde,j) =0.0
 272  ss13(i,kde,j) =0.0
 273
 274  g_ss23(i,kde,j) =0.0
 275  ss23(i,kde,j) =0.0
 276
 277  g_rr13(i,kde,j) =0.0
 278  rr13(i,kde,j) =0.0
 279
 280  g_rr23(i,kde,j) =0.0
 281  rr23(i,kde,j) =0.0
 282
 283  ENDDO
 284  ENDDO
 285
 286  DO j =j_start,j_end
 287  DO k =kts,ktf
 288  DO i =i_start,i_end
 289
 290  g_ss12c(i,k,j) =0.25*(g_ss12(i,k,j) +g_ss12(i,k,j+1) +g_ss12(i+1,k,j) &
 291  +g_ss12(i+1,k,j+1))
 292  ss12c(i,k,j) =0.25*(ss12(i,k,j) +ss12(i,k,j+1) +ss12(i+1,k,j) +ss12(i+1,k,j+1))
 293
 294  g_rr12c(i,k,j) =0.25*(g_rr12(i,k,j) +g_rr12(i,k,j+1) +g_rr12(i+1,k,j) &
 295  +g_rr12(i+1,k,j+1))
 296  rr12c(i,k,j) =0.25*(rr12(i,k,j) +rr12(i,k,j+1) +rr12(i+1,k,j) +rr12(i+1,k,j+1))
 297
 298  g_ss13c(i,k,j) =0.25*(g_ss13(i,k+1,j) +g_ss13(i,k,j) +g_ss13(i+1,k+1,j) &
 299  +g_ss13(i+1,k,j))
 300  ss13c(i,k,j) =0.25*(ss13(i,k+1,j) +ss13(i,k,j) +ss13(i+1,k+1,j) +ss13(i+1,k,j))
 301
 302  g_rr13c(i,k,j) =0.25*(g_rr13(i,k+1,j) +g_rr13(i,k,j) +g_rr13(i+1,k+1,j) &
 303  +g_rr13(i+1,k,j))
 304  rr13c(i,k,j) =0.25*(rr13(i,k+1,j) +rr13(i,k,j) +rr13(i+1,k+1,j) +rr13(i+1,k,j))
 305
 306  g_ss23c(i,k,j) =0.25*(g_ss23(i,k+1,j) +g_ss23(i,k,j) +g_ss23(i,k+1,j+1) &
 307  +g_ss23(i,k,j+1))
 308  ss23c(i,k,j) =0.25*(ss23(i,k+1,j) +ss23(i,k,j) +ss23(i,k+1,j+1) +ss23(i,k,j+1))
 309
 310  g_rr23c(i,k,j) =0.25*(g_rr23(i,k+1,j) +g_rr23(i,k,j) +g_rr23(i,k+1,j+1) &
 311  +g_rr23(i,k,j+1))
 312  rr23c(i,k,j) =0.25*(rr23(i,k+1,j) +rr23(i,k,j) +rr23(i,k+1,j+1) +rr23(i,k,j+1))
 313
 314  ENDDO
 315  ENDDO
 316  ENDDO
 317
 318  IF( config_flags%sfs_opt .EQ. 1 ) THEN
 319
 320  DO j =j_start,j_end
 321  DO k =kts,ktf
 322  DO i =i_start,i_end
 323
 324  g_delta =0.33333333*(-dx *dy*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))) &
 325 *(dx *dy/rdzw(i,k,j))**(0.33333333 -1.0)
 326  delta =(dx *dy/rdzw(i,k,j))**0.33333333
 327
 328  g_a =-1.0*2.0*(cs*g_delta)*(cs*delta)
 329  a =-1.0*(cs*delta)**2
 330
 331  g_Tmpv1 =2.0*sqrt(2.0*smnsmn(i,k,j))*g_ss11(i,k,j) +2.0*g_Sqrt(2.0* &
 332  g_smnsmn(i,k,j), 2.0*smnsmn(i,k,j))*ss11(i,k,j)
 333  Tmpv1 =2.0*sqrt(2.0*smnsmn(i,k,j))*ss11(i,k,j)
 334
 335  g_Tmpv2 =2.0*ss11(i,k,j)*g_ss11(i,k,j)
 336  Tmpv2 =ss11(i,k,j)*ss11(i,k,j)
 337
 338  g_Tmpv3 =2.0*ss12c(i,k,j)*g_ss12c(i,k,j)
 339  Tmpv3 =ss12c(i,k,j)*ss12c(i,k,j)
 340
 341  g_Tmpv4 =2.0*ss13c(i,k,j)*g_ss13c(i,k,j)
 342  Tmpv4 =ss13c(i,k,j)*ss13c(i,k,j)
 343
 344  g_Tmpv5 =ss12c(i,k,j)*g_rr12c(i,k,j) +g_ss12c(i,k,j)*rr12c(i,k,j)
 345  Tmpv5 =ss12c(i,k,j)*rr12c(i,k,j)
 346
 347  g_Tmpv6 =ss13c(i,k,j)*g_rr13c(i,k,j) +g_ss13c(i,k,j)*rr13c(i,k,j)
 348  Tmpv6 =ss13c(i,k,j)*rr13c(i,k,j)
 349
 350  g_Tmpv7 =a*(g_Tmpv1 +c1*(g_Tmpv2 +g_Tmpv3 +g_Tmpv4 -(g_smnsmn(i,k, &
 351  j)/3.0)) +c2*(-2.0*(g_Tmpv5 +g_Tmpv6))) +g_a*(Tmpv1 +c1*(Tmpv2 +Tmpv3 + &
 352  Tmpv4 -smnsmn(i,k,j)/3.0) +c2*(-2.0*(Tmpv5 +Tmpv6)))
 353  Tmpv7 =a*(Tmpv1 +c1*(Tmpv2 +Tmpv3 +Tmpv4 -smnsmn(i,k,j)/3.0) +c2*(-2.0*(Tmpv5 +Tmpv6)))
 354
 355  g_m11(i,k,j) =g_Tmpv7
 356  m11(i,k,j) =Tmpv7
 357
 358  g_Tmpv1 =2.0*sqrt(2.0*smnsmn(i,k,j))*g_ss22(i,k,j) +2.0*g_Sqrt(2.0* &
 359  g_smnsmn(i,k,j), 2.0*smnsmn(i,k,j))*ss22(i,k,j)
 360  Tmpv1 =2.0*sqrt(2.0*smnsmn(i,k,j))*ss22(i,k,j)
 361
 362  g_Tmpv2 =2.0*ss22(i,k,j)*g_ss22(i,k,j)
 363  Tmpv2 =ss22(i,k,j)*ss22(i,k,j)
 364
 365  g_Tmpv3 =2.0*ss12c(i,k,j)*g_ss12c(i,k,j)
 366  Tmpv3 =ss12c(i,k,j)*ss12c(i,k,j)
 367
 368  g_Tmpv4 =2.0*ss23c(i,k,j)*g_ss23c(i,k,j)
 369  Tmpv4 =ss23c(i,k,j)*ss23c(i,k,j)
 370
 371  g_Tmpv5 =ss12c(i,k,j)*g_rr12c(i,k,j) +g_ss12c(i,k,j)*rr12c(i,k,j)
 372  Tmpv5 =ss12c(i,k,j)*rr12c(i,k,j)
 373
 374  g_Tmpv6 =ss23c(i,k,j)*g_rr23c(i,k,j) +g_ss23c(i,k,j)*rr23c(i,k,j)
 375  Tmpv6 =ss23c(i,k,j)*rr23c(i,k,j)
 376
 377  g_Tmpv7 =a*(g_Tmpv1 +c1*(g_Tmpv2 +g_Tmpv3 +g_Tmpv4 -(g_smnsmn(i,k, &
 378  j)/3.0)) +c2*(2.0*(g_Tmpv5 -g_Tmpv6))) +g_a*(Tmpv1 +c1*(Tmpv2 +Tmpv3 + &
 379  Tmpv4 -smnsmn(i,k,j)/3.0) +c2*(2.0*(Tmpv5 -Tmpv6)))
 380  Tmpv7 =a*(Tmpv1 +c1*(Tmpv2 +Tmpv3 +Tmpv4 -smnsmn(i,k,j)/3.0) +c2*(2.0*(Tmpv5 -Tmpv6)))
 381
 382  g_m22(i,k,j) =g_Tmpv7
 383  m22(i,k,j) =Tmpv7
 384
 385  g_Tmpv1 =2.0*sqrt(2.0*smnsmn(i,k,j))*g_ss33(i,k,j) +2.0*g_Sqrt(2.0* &
 386  g_smnsmn(i,k,j), 2.0*smnsmn(i,k,j))*ss33(i,k,j)
 387  Tmpv1 =2.0*sqrt(2.0*smnsmn(i,k,j))*ss33(i,k,j)
 388
 389  g_Tmpv2 =2.0*ss33(i,k,j)*g_ss33(i,k,j)
 390  Tmpv2 =ss33(i,k,j)*ss33(i,k,j)
 391
 392  g_Tmpv3 =2.0*ss13c(i,k,j)*g_ss13c(i,k,j)
 393  Tmpv3 =ss13c(i,k,j)*ss13c(i,k,j)
 394
 395  g_Tmpv4 =2.0*ss23c(i,k,j)*g_ss23c(i,k,j)
 396  Tmpv4 =ss23c(i,k,j)*ss23c(i,k,j)
 397
 398  g_Tmpv5 =ss13c(i,k,j)*g_rr13c(i,k,j) +g_ss13c(i,k,j)*rr13c(i,k,j)
 399  Tmpv5 =ss13c(i,k,j)*rr13c(i,k,j)
 400
 401  g_Tmpv6 =ss23c(i,k,j)*g_rr23c(i,k,j) +g_ss23c(i,k,j)*rr23c(i,k,j)
 402  Tmpv6 =ss23c(i,k,j)*rr23c(i,k,j)
 403
 404  g_Tmpv7 =a*(g_Tmpv1 +c1*(g_Tmpv2 +g_Tmpv3 +g_Tmpv4 -(g_smnsmn(i,k, &
 405  j)/3.0)) +c2*(2.0*(g_Tmpv5 +g_Tmpv6))) +g_a*(Tmpv1 +c1*(Tmpv2 +Tmpv3 + &
 406  Tmpv4 -smnsmn(i,k,j)/3.0) +c2*(2.0*(Tmpv5 +Tmpv6)))
 407  Tmpv7 =a*(Tmpv1 +c1*(Tmpv2 +Tmpv3 +Tmpv4 -smnsmn(i,k,j)/3.0) +c2*(2.0*(Tmpv5 +Tmpv6)))
 408
 409  g_m33(i,k,j) =g_Tmpv7
 410  m33(i,k,j) =Tmpv7
 411
 412  ENDDO
 413  ENDDO
 414  ENDDO
 415
 416  ELSE
 417
 418  DO j =j_start,j_end
 419  DO k =kts,ktf
 420  DO i =i_start,i_end
 421
 422  g_delta =0.33333333*(-dx *dy*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))) &
 423 *(dx *dy/rdzw(i,k,j))**(0.33333333 -1.0)
 424  delta =(dx *dy/rdzw(i,k,j))**0.33333333
 425
 426  g_a =-1.0 *ce*g_delta
 427  a =-1.0 *ce*delta
 428
 429  g_b =c3*g_delta
 430  b =c3*delta
 431
 432  g_Tmpv1 =2.0*sqrt(tke(i,k,j))*g_ss11(i,k,j) +2.0*g_Sqrt(g_tke(i,k,j) &
 433 , tke(i,k,j))*ss11(i,k,j)
 434  Tmpv1 =2.0*sqrt(tke(i,k,j))*ss11(i,k,j)
 435
 436  g_Tmpv2 =2.0*ss11(i,k,j)*g_ss11(i,k,j)
 437  Tmpv2 =ss11(i,k,j)*ss11(i,k,j)
 438
 439  g_Tmpv3 =2.0*ss12c(i,k,j)*g_ss12c(i,k,j)
 440  Tmpv3 =ss12c(i,k,j)*ss12c(i,k,j)
 441
 442  g_Tmpv4 =2.0*ss13c(i,k,j)*g_ss13c(i,k,j)
 443  Tmpv4 =ss13c(i,k,j)*ss13c(i,k,j)
 444
 445  g_Tmpv5 =ss12c(i,k,j)*g_rr12c(i,k,j) +g_ss12c(i,k,j)*rr12c(i,k,j)
 446  Tmpv5 =ss12c(i,k,j)*rr12c(i,k,j)
 447
 448  g_Tmpv6 =ss13c(i,k,j)*g_rr13c(i,k,j) +g_ss13c(i,k,j)*rr13c(i,k,j)
 449  Tmpv6 =ss13c(i,k,j)*rr13c(i,k,j)
 450
 451  g_Tmpv7 =b*(c1*(g_Tmpv2 +g_Tmpv3 +g_Tmpv4 -(g_smnsmn(i,k,j)/3.0)) &
 452  +c2*(-2.0*(g_Tmpv5 +g_Tmpv6))) +g_b*(c1*(Tmpv2 +Tmpv3 +Tmpv4 -smnsmn(i,k,j) &
 453 /3.0) +c2*(-2.0*(Tmpv5 +Tmpv6)))
 454  Tmpv7 =b*(c1*(Tmpv2 +Tmpv3 +Tmpv4 -smnsmn(i,k,j)/3.0) +c2*(-2.0*(Tmpv5 +Tmpv6)))
 455
 456  g_Tmpv8 =a*(g_Tmpv1 +g_Tmpv7) +g_a*(Tmpv1 +Tmpv7)
 457  Tmpv8 =a*(Tmpv1 +Tmpv7)
 458
 459  g_m11(i,k,j) =g_Tmpv8
 460  m11(i,k,j) =Tmpv8
 461
 462  g_Tmpv1 =2.0*sqrt(tke(i,k,j))*g_ss22(i,k,j) +2.0*g_Sqrt(g_tke(i,k,j) &
 463 , tke(i,k,j))*ss22(i,k,j)
 464  Tmpv1 =2.0*sqrt(tke(i,k,j))*ss22(i,k,j)
 465
 466  g_Tmpv2 =2.0*ss22(i,k,j)*g_ss22(i,k,j)
 467  Tmpv2 =ss22(i,k,j)*ss22(i,k,j)
 468
 469  g_Tmpv3 =2.0*ss12c(i,k,j)*g_ss12c(i,k,j)
 470  Tmpv3 =ss12c(i,k,j)*ss12c(i,k,j)
 471
 472  g_Tmpv4 =2.0*ss23c(i,k,j)*g_ss23c(i,k,j)
 473  Tmpv4 =ss23c(i,k,j)*ss23c(i,k,j)
 474
 475  g_Tmpv5 =ss12c(i,k,j)*g_rr12c(i,k,j) +g_ss12c(i,k,j)*rr12c(i,k,j)
 476  Tmpv5 =ss12c(i,k,j)*rr12c(i,k,j)
 477
 478  g_Tmpv6 =ss23c(i,k,j)*g_rr23c(i,k,j) +g_ss23c(i,k,j)*rr23c(i,k,j)
 479  Tmpv6 =ss23c(i,k,j)*rr23c(i,k,j)
 480
 481  g_Tmpv7 =b*(c1*(g_Tmpv2 +g_Tmpv3 +g_Tmpv4 -(g_smnsmn(i,k,j)/3.0)) &
 482  +c2*(2.0*(g_Tmpv5 -g_Tmpv6))) +g_b*(c1*(Tmpv2 +Tmpv3 +Tmpv4 -smnsmn(i,k,j) &
 483 /3.0) +c2*(2.0*(Tmpv5 -Tmpv6)))
 484  Tmpv7 =b*(c1*(Tmpv2 +Tmpv3 +Tmpv4 -smnsmn(i,k,j)/3.0) +c2*(2.0*(Tmpv5 -Tmpv6)))
 485
 486  g_Tmpv8 =a*(g_Tmpv1 +g_Tmpv7) +g_a*(Tmpv1 +Tmpv7)
 487  Tmpv8 =a*(Tmpv1 +Tmpv7)
 488
 489  g_m22(i,k,j) =g_Tmpv8
 490  m22(i,k,j) =Tmpv8
 491
 492  g_Tmpv1 =2.0*sqrt(tke(i,k,j))*g_ss33(i,k,j) +2.0*g_Sqrt(g_tke(i,k,j) &
 493 , tke(i,k,j))*ss33(i,k,j)
 494  Tmpv1 =2.0*sqrt(tke(i,k,j))*ss33(i,k,j)
 495
 496  g_Tmpv2 =2.0*ss33(i,k,j)*g_ss33(i,k,j)
 497  Tmpv2 =ss33(i,k,j)*ss33(i,k,j)
 498
 499  g_Tmpv3 =2.0*ss13c(i,k,j)*g_ss13c(i,k,j)
 500  Tmpv3 =ss13c(i,k,j)*ss13c(i,k,j)
 501
 502  g_Tmpv4 =2.0*ss23c(i,k,j)*g_ss23c(i,k,j)
 503  Tmpv4 =ss23c(i,k,j)*ss23c(i,k,j)
 504
 505  g_Tmpv5 =ss13c(i,k,j)*g_rr13c(i,k,j) +g_ss13c(i,k,j)*rr13c(i,k,j)
 506  Tmpv5 =ss13c(i,k,j)*rr13c(i,k,j)
 507
 508  g_Tmpv6 =ss23c(i,k,j)*g_rr23c(i,k,j) +g_ss23c(i,k,j)*rr23c(i,k,j)
 509  Tmpv6 =ss23c(i,k,j)*rr23c(i,k,j)
 510
 511  g_Tmpv7 =b*(c1*(g_Tmpv2 +g_Tmpv3 +g_Tmpv4 -(g_smnsmn(i,k,j)/3.0)) &
 512  +c2*(2.0*(g_Tmpv5 +g_Tmpv6))) +g_b*(c1*(Tmpv2 +Tmpv3 +Tmpv4 -smnsmn(i,k,j) &
 513 /3.0) +c2*(2.0*(Tmpv5 +Tmpv6)))
 514  Tmpv7 =b*(c1*(Tmpv2 +Tmpv3 +Tmpv4 -smnsmn(i,k,j)/3.0) +c2*(2.0*(Tmpv5 +Tmpv6)))
 515
 516  g_Tmpv8 =a*(g_Tmpv1 +g_Tmpv7) +g_a*(Tmpv1 +Tmpv7)
 517  Tmpv8 =a*(Tmpv1 +Tmpv7)
 518
 519  g_m33(i,k,j) =g_Tmpv8
 520  m33(i,k,j) =Tmpv8
 521
 522  ENDDO
 523  ENDDO
 524  ENDDO
 525  ENDIF
 526  Return
 527
 528  END SUBROUTINE g_calc_mii
 529
 530  SUBROUTINE g_calc_m12(m12,g_m12,s11,g_s11,s22,g_s22,s12,g_s12,s13, &
 531  g_s13,s23,g_s23,r12,g_r12,r13,g_r13,r23,g_r23,smnsmn,g_smnsmn,tke, &
 532  g_tke,rdzw,g_rdzw,dx,dy,config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
 533  kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 534
 535  IMPLICIT NONE
 536
 537  REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4,Tmpv5, &
 538  g_Tmpv5,Tmpv6,g_Tmpv6,Tmpv7,g_Tmpv7,Tmpv8,g_Tmpv8,Tmpv9,g_Tmpv9, &
 539  Tmpv10,g_Tmpv10
 540
 541  REAL :: g_Sqrt
 542  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: m12,g_m12
 543
 544  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s11,g_s11,s22,g_s22,s12,g_s12, &
 545  s13,g_s13,s23,g_s23,r12,g_r12,r13,g_r13,r23,g_r23,smnsmn,g_smnsmn, &
 546  tke,g_tke,rdzw,g_rdzw
 547
 548  REAL :: dx,dy
 549  TYPE(grid_config_rec_type) :: config_flags
 550  INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, &
 551  its,ite,jts,jte,kts,kte
 552
 553  REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss11,g_ss11,ss22,g_ss22, &
 554  ss12,g_ss12,ss13,g_ss13,ss23,g_ss23,rr12,g_rr12,rr13,g_rr13,rr23,g_rr23
 555
 556  REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: tked,g_tked,ss11d,g_ss11d, &
 557  ss22d,g_ss22d,ss13d,g_ss13d,ss23d,g_ss23d,rr13d,g_rr13d,rr23d,g_rr23d, &
 558  smnsmnd,g_smnsmnd
 559  REAL :: delta,g_delta,a,g_a,b,g_b
 560  INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf,je_ext,ie_ext
 561
 562  ktf =min(kte,kde-1)
 563
 564  i_start =its
 565
 566  i_end =ite
 567
 568  j_start =jts
 569
 570  j_end =jte
 571
 572  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
 573          config_flags%nested ) i_start =max(ids+1,its)
 574
 575  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
 576          config_flags%nested ) i_end =min(ide-1,ite)
 577
 578  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
 579          config_flags%nested ) j_start =max(jds+1,jts)
 580
 581  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
 582          config_flags%nested ) j_end =min(jde-1,jte)
 583
 584  IF( config_flags%periodic_x ) i_start =its
 585
 586  IF( config_flags%periodic_x ) i_end =ite
 587
 588  je_ext =1
 589
 590  ie_ext =1
 591
 592  i_end =i_end+ie_ext
 593
 594  j_end =j_end+je_ext
 595
 596  DO j =j_start-1,j_end
 597  DO k =kts,ktf
 598  DO i =i_start-1,i_end
 599
 600  g_ss11(i,k,j) =g_s11(i,k,j)/2.0
 601  ss11(i,k,j) =s11(i,k,j)/2.0
 602
 603  g_ss22(i,k,j) =g_s22(i,k,j)/2.0
 604  ss22(i,k,j) =s22(i,k,j)/2.0
 605
 606  g_ss12(i,k,j) =g_s12(i,k,j)/2.0
 607  ss12(i,k,j) =s12(i,k,j)/2.0
 608
 609  g_ss13(i,k,j) =g_s13(i,k,j)/2.0
 610  ss13(i,k,j) =s13(i,k,j)/2.0
 611
 612  g_ss23(i,k,j) =g_s23(i,k,j)/2.0
 613  ss23(i,k,j) =s23(i,k,j)/2.0
 614
 615  g_rr12(i,k,j) =g_r12(i,k,j)/2.0
 616  rr12(i,k,j) =r12(i,k,j)/2.0
 617
 618  g_rr13(i,k,j) =g_r13(i,k,j)/2.0
 619  rr13(i,k,j) =r13(i,k,j)/2.0
 620
 621  g_rr23(i,k,j) =g_r23(i,k,j)/2.0
 622  rr23(i,k,j) =r23(i,k,j)/2.0
 623
 624  ENDDO
 625  ENDDO
 626  ENDDO
 627
 628  DO j =j_start-1,j_end
 629  DO i =i_start-1,i_end
 630
 631  g_ss13(i,kde,j) =0.0
 632  ss13(i,kde,j) =0.0
 633
 634  g_ss23(i,kde,j) =0.0
 635  ss23(i,kde,j) =0.0
 636
 637  g_rr13(i,kde,j) =0.0
 638  rr13(i,kde,j) =0.0
 639
 640  g_rr23(i,kde,j) =0.0
 641  rr23(i,kde,j) =0.0
 642
 643  ENDDO
 644  ENDDO
 645
 646  DO j =j_start,j_end
 647  DO k =kts,ktf
 648  DO i =i_start,i_end
 649
 650  g_tked(i,k,j) =0.25*(g_tke(i-1,k,j) +g_tke(i,k,j) +g_tke(i-1,k,j-1) &
 651  +g_tke(i,k,j-1))
 652  tked(i,k,j) =0.25*(tke(i-1,k,j) +tke(i,k,j) +tke(i-1,k,j-1) +tke(i,k,j-1))
 653
 654  g_smnsmnd(i,k,j) =0.25*(g_smnsmn(i-1,k,j) +g_smnsmn(i,k,j) +g_smnsmn(i-1, &
 655  k,j-1) +g_smnsmn(i,k,j-1))
 656  smnsmnd(i,k,j) =0.25*(smnsmn(i-1,k,j) +smnsmn(i,k,j) +smnsmn(i-1,k,j-1) +smnsmn(i,k,j-1))
 657
 658  g_ss11d(i,k,j) =0.25*(g_ss11(i-1,k,j) +g_ss11(i,k,j) +g_ss11(i-1,k,j-1) &
 659  +g_ss11(i,k,j-1))
 660  ss11d(i,k,j) =0.25*(ss11(i-1,k,j) +ss11(i,k,j) +ss11(i-1,k,j-1) +ss11(i,k,j-1))
 661
 662  g_ss22d(i,k,j) =0.25*(g_ss22(i-1,k,j) +g_ss22(i,k,j) +g_ss22(i-1,k,j-1) &
 663  +g_ss22(i,k,j-1))
 664  ss22d(i,k,j) =0.25*(ss22(i-1,k,j) +ss22(i,k,j) +ss22(i-1,k,j-1) +ss22(i,k,j-1))
 665
 666  g_ss13d(i,k,j) =0.25*(g_ss13(i,k+1,j) +g_ss13(i,k+1,j-1) +g_ss13(i,k,j) &
 667  +g_ss13(i,k,j-1))
 668  ss13d(i,k,j) =0.25*(ss13(i,k+1,j) +ss13(i,k+1,j-1) +ss13(i,k,j) +ss13(i,k,j-1))
 669
 670  g_rr13d(i,k,j) =0.25*(g_rr13(i,k+1,j) +g_rr13(i,k+1,j-1) +g_rr13(i,k,j) &
 671  +g_rr13(i,k,j-1))
 672  rr13d(i,k,j) =0.25*(rr13(i,k+1,j) +rr13(i,k+1,j-1) +rr13(i,k,j) +rr13(i,k,j-1))
 673
 674  g_ss23d(i,k,j) =0.25*(g_ss23(i,k+1,j) +g_ss23(i-1,k+1,j) +g_ss23(i,k,j) &
 675  +g_ss23(i-1,k,j))
 676  ss23d(i,k,j) =0.25*(ss23(i,k+1,j) +ss23(i-1,k+1,j) +ss23(i,k,j) +ss23(i-1,k,j))
 677
 678  g_rr23d(i,k,j) =0.25*(g_rr23(i,k+1,j) +g_rr23(i-1,k+1,j) +g_rr23(i,k,j) &
 679  +g_rr23(i-1,k,j))
 680  rr23d(i,k,j) =0.25*(rr23(i,k+1,j) +rr23(i-1,k+1,j) +rr23(i,k,j) +rr23(i-1,k,j))
 681
 682  ENDDO
 683  ENDDO
 684  ENDDO
 685
 686  IF( config_flags%sfs_opt .EQ. 1 ) THEN
 687
 688  DO j =j_start,j_end
 689  DO k =kts,ktf
 690  DO i =i_start,i_end
 691
 692  g_delta =0.33333333*(-dx *dy*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))) &
 693 *(dx *dy/rdzw(i,k,j))**(0.33333333 -1.0)
 694  delta =(dx *dy/rdzw(i,k,j))**0.33333333
 695
 696  g_a =-1.0*2.0*(cs*g_delta)*(cs*delta)
 697  a =-1.0*(cs*delta)**2
 698
 699  g_Tmpv1 =2.0*sqrt(2.0*smnsmnd(i,k,j))*g_ss12(i,k,j) +2.0*g_Sqrt(2.0* &
 700  g_smnsmnd(i,k,j), 2.0*smnsmnd(i,k,j))*ss12(i,k,j)
 701  Tmpv1 =2.0*sqrt(2.0*smnsmnd(i,k,j))*ss12(i,k,j)
 702
 703  g_Tmpv2 =ss11d(i,k,j)*g_ss12(i,k,j) +g_ss11d(i,k,j)*ss12(i,k,j)
 704  Tmpv2 =ss11d(i,k,j)*ss12(i,k,j)
 705
 706  g_Tmpv3 =ss22d(i,k,j)*g_ss12(i,k,j) +g_ss22d(i,k,j)*ss12(i,k,j)
 707  Tmpv3 =ss22d(i,k,j)*ss12(i,k,j)
 708
 709  g_Tmpv4 =ss13d(i,k,j)*g_ss23d(i,k,j) +g_ss13d(i,k,j)*ss23d(i,k,j)
 710  Tmpv4 =ss13d(i,k,j)*ss23d(i,k,j)
 711
 712  g_Tmpv5 =ss11d(i,k,j)*g_rr12(i,k,j) +g_ss11d(i,k,j)*rr12(i,k,j)
 713  Tmpv5 =ss11d(i,k,j)*rr12(i,k,j)
 714
 715  g_Tmpv6 =ss13d(i,k,j)*g_rr23d(i,k,j) +g_ss13d(i,k,j)*rr23d(i,k,j)
 716  Tmpv6 =ss13d(i,k,j)*rr23d(i,k,j)
 717
 718  g_Tmpv7 =ss22d(i,k,j)*g_rr12(i,k,j) +g_ss22d(i,k,j)*rr12(i,k,j)
 719  Tmpv7 =ss22d(i,k,j)*rr12(i,k,j)
 720
 721  g_Tmpv8 =ss23d(i,k,j)*g_rr13d(i,k,j) +g_ss23d(i,k,j)*rr13d(i,k,j)
 722  Tmpv8 =ss23d(i,k,j)*rr13d(i,k,j)
 723
 724  g_Tmpv9 =a*(g_Tmpv1 +c1*(g_Tmpv2 +g_Tmpv3 +g_Tmpv4) +c2*(g_Tmpv5 - &
 725  g_Tmpv6 -g_Tmpv7 -g_Tmpv8)) +g_a*(Tmpv1 +c1*(Tmpv2 +Tmpv3 +Tmpv4) &
 726  +c2*(Tmpv5 -Tmpv6 -Tmpv7 -Tmpv8))
 727  Tmpv9 =a*(Tmpv1 +c1*(Tmpv2 +Tmpv3 +Tmpv4) +c2*(Tmpv5 -Tmpv6 -Tmpv7 -Tmpv8))
 728
 729  g_m12(i,k,j) =g_Tmpv9
 730  m12(i,k,j) =Tmpv9
 731
 732  ENDDO
 733  ENDDO
 734  ENDDO
 735
 736  ELSE
 737
 738  DO j =j_start,j_end
 739  DO k =kts,ktf
 740  DO i =i_start,i_end
 741
 742  g_delta =0.33333333*(-dx *dy*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))) &
 743 *(dx *dy/rdzw(i,k,j))**(0.33333333 -1.0)
 744  delta =(dx *dy/rdzw(i,k,j))**0.33333333
 745
 746  g_a =-1.0 *ce*g_delta
 747  a =-1.0 *ce*delta
 748
 749  g_b =c3*g_delta
 750  b =c3*delta
 751
 752  g_Tmpv1 =2.0*sqrt(tked(i,k,j))*g_s12(i,k,j) +2.0*g_Sqrt(g_tked(i,k,j) &
 753 , tked(i,k,j))*s12(i,k,j)
 754  Tmpv1 =2.0*sqrt(tked(i,k,j))*s12(i,k,j)
 755
 756  g_Tmpv2 =ss11d(i,k,j)*g_ss12(i,k,j) +g_ss11d(i,k,j)*ss12(i,k,j)
 757  Tmpv2 =ss11d(i,k,j)*ss12(i,k,j)
 758
 759  g_Tmpv3 =ss22d(i,k,j)*g_ss12(i,k,j) +g_ss22d(i,k,j)*ss12(i,k,j)
 760  Tmpv3 =ss22d(i,k,j)*ss12(i,k,j)
 761
 762  g_Tmpv4 =ss13d(i,k,j)*g_ss23d(i,k,j) +g_ss13d(i,k,j)*ss23d(i,k,j)
 763  Tmpv4 =ss13d(i,k,j)*ss23d(i,k,j)
 764
 765  g_Tmpv5 =ss11d(i,k,j)*g_rr12(i,k,j) +g_ss11d(i,k,j)*rr12(i,k,j)
 766  Tmpv5 =ss11d(i,k,j)*rr12(i,k,j)
 767
 768  g_Tmpv6 =ss13d(i,k,j)*g_rr23d(i,k,j) +g_ss13d(i,k,j)*rr23d(i,k,j)
 769  Tmpv6 =ss13d(i,k,j)*rr23d(i,k,j)
 770
 771  g_Tmpv7 =ss22d(i,k,j)*g_rr12(i,k,j) +g_ss22d(i,k,j)*rr12(i,k,j)
 772  Tmpv7 =ss22d(i,k,j)*rr12(i,k,j)
 773
 774  g_Tmpv8 =ss23d(i,k,j)*g_rr13d(i,k,j) +g_ss23d(i,k,j)*rr13d(i,k,j)
 775  Tmpv8 =ss23d(i,k,j)*rr13d(i,k,j)
 776
 777  g_Tmpv9 =b*(c1*(g_Tmpv2 +g_Tmpv3 +g_Tmpv4) +c2*(g_Tmpv5 -g_Tmpv6 - &
 778  g_Tmpv7 -g_Tmpv8)) +g_b*(c1*(Tmpv2 +Tmpv3 +Tmpv4) +c2*(Tmpv5 -Tmpv6 -Tmpv7 -Tmpv8))
 779  Tmpv9 =b*(c1*(Tmpv2 +Tmpv3 +Tmpv4) +c2*(Tmpv5 -Tmpv6 -Tmpv7 -Tmpv8))
 780
 781  g_Tmpv10 =a*(g_Tmpv1 +g_Tmpv9) +g_a*(Tmpv1 +Tmpv9)
 782  Tmpv10 =a*(Tmpv1 +Tmpv9)
 783
 784  g_m12(i,k,j) =g_Tmpv10
 785  m12(i,k,j) =Tmpv10
 786
 787  ENDDO
 788  ENDDO
 789  ENDDO
 790  ENDIF
 791  Return
 792
 793  END SUBROUTINE g_calc_m12
 794
 795  SUBROUTINE g_calc_m13(m13,g_m13,s11,g_s11,s33,g_s33,s12,g_s12,s13, &
 796  g_s13,s23,g_s23,r12,g_r12,r13,g_r13,r23,g_r23,smnsmn,g_smnsmn,tke, &
 797  g_tke,rdzw,g_rdzw,dx,dy,fnm,fnp,config_flags,ids,ide,jds,jde,kds,kde,ims,ime, &
 798  jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
 799
 800  IMPLICIT NONE
 801
 802  REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4,Tmpv5, &
 803  g_Tmpv5,Tmpv6,g_Tmpv6,Tmpv7,g_Tmpv7,Tmpv8,g_Tmpv8,Tmpv9,g_Tmpv9, &
 804  Tmpv10,g_Tmpv10
 805
 806    REAL :: g_Sqrt
 807  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: m13,g_m13
 808
 809  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s11,g_s11,s33,g_s33,s12,g_s12, &
 810  s13,g_s13,s23,g_s23,r12,g_r12,r13,g_r13,r23,g_r23,smnsmn,g_smnsmn, &
 811  tke,g_tke,rdzw,g_rdzw
 812
 813  REAL :: dx,dy
 814
 815  REAL,DIMENSION(kms:kme) :: fnm,fnp
 816  TYPE(grid_config_rec_type) :: config_flags
 817  INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, &
 818  its,ite,jts,jte,kts,kte
 819
 820  REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss11,g_ss11,ss33,g_ss33, &
 821  ss12,g_ss12,ss13,g_ss13,ss23,g_ss23,rr12,g_rr12,rr13,g_rr13,rr23,g_rr23
 822
 823  REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: tkee,g_tkee,ss11e,g_ss11e, &
 824  ss33e,g_ss33e,ss12e,g_ss12e,ss23e,g_ss23e,rr12e,g_rr12e,rr23e,g_rr23e, &
 825  smnsmne,g_smnsmne
 826  REAL :: delta,g_delta,a,g_a,b,g_b
 827  INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf,ie_ext
 828
 829  ktf =min(kte,kde-1)
 830
 831  i_start =its
 832
 833  i_end =ite
 834
 835  j_start =jts
 836
 837  j_end =min(jte,jde-1)
 838
 839  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
 840          config_flags%nested) i_start =max(ids+1,its)
 841
 842  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
 843          config_flags%nested) i_end =min(ide-1,ite)
 844
 845  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
 846          config_flags%nested) j_start =max(jds+1,jts)
 847
 848  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
 849          config_flags%nested) j_end =min(jde-2,jte)
 850
 851  IF( config_flags%periodic_x ) i_start =its
 852
 853  IF( config_flags%periodic_x ) i_end =ite
 854
 855  ie_ext =1
 856
 857  i_end =i_end+ie_ext
 858
 859  DO j =j_start,j_end+1
 860  DO k =kts,ktf
 861  DO i =i_start-1,i_end
 862
 863  g_ss11(i,k,j) =g_s11(i,k,j)/2.0
 864  ss11(i,k,j) =s11(i,k,j)/2.0
 865
 866  g_ss33(i,k,j) =g_s33(i,k,j)/2.0
 867  ss33(i,k,j) =s33(i,k,j)/2.0
 868
 869  g_ss12(i,k,j) =g_s12(i,k,j)/2.0
 870  ss12(i,k,j) =s12(i,k,j)/2.0
 871
 872  g_ss13(i,k,j) =g_s13(i,k,j)/2.0
 873  ss13(i,k,j) =s13(i,k,j)/2.0
 874
 875  g_ss23(i,k,j) =g_s23(i,k,j)/2.0
 876  ss23(i,k,j) =s23(i,k,j)/2.0
 877
 878  g_rr12(i,k,j) =g_r12(i,k,j)/2.0
 879  rr12(i,k,j) =r12(i,k,j)/2.0
 880
 881  g_rr13(i,k,j) =g_r13(i,k,j)/2.0
 882  rr13(i,k,j) =r13(i,k,j)/2.0
 883
 884  g_rr23(i,k,j) =g_r23(i,k,j)/2.0
 885  rr23(i,k,j) =r23(i,k,j)/2.0
 886
 887  ENDDO
 888  ENDDO
 889  ENDDO
 890
 891  DO j =j_start,j_end
 892  DO k =kts+1,ktf
 893  DO i =i_start,i_end
 894
 895  g_tkee(i,k,j) =0.5*(fnm(k)*(g_tke(i,k,j) +g_tke(i-1,k,j)) +fnp(k) &
 896 *(g_tke(i,k-1,j) +g_tke(i-1,k-1,j)))
 897  tkee(i,k,j) =0.5*(fnm(k)*(tke(i,k,j) +tke(i-1,k,j)) +fnp(k)*(tke(i,k-1,j) +tke(i-1,k-1,j)))
 898
 899  g_smnsmne(i,k,j) =0.5*(fnm(k)*(g_smnsmn(i,k,j) +g_smnsmn(i-1,k,j)) +fnp(k) &
 900 *(g_smnsmn(i,k-1,j) +g_smnsmn(i-1,k-1,j)))
 901  smnsmne(i,k,j) =0.5*(fnm(k)*(smnsmn(i,k,j) +smnsmn(i-1,k,j)) +fnp(k)*(smnsmn(i,k-1,j) &
 902  +smnsmn(i-1,k-1,j)))
 903
 904  g_ss11e(i,k,j) =0.5*(fnm(k)*(g_ss11(i,k,j) +g_ss11(i-1,k,j)) +fnp(k) &
 905 *(g_ss11(i,k-1,j) +g_ss11(i-1,k-1,j)))
 906  ss11e(i,k,j) =0.5*(fnm(k)*(ss11(i,k,j) +ss11(i-1,k,j)) +fnp(k)*(ss11(i,k-1,j) &
 907  +ss11(i-1,k-1,j)))
 908
 909  g_ss33e(i,k,j) =0.5*(fnm(k)*(g_ss33(i,k,j) +g_ss33(i-1,k,j)) +fnp(k) &
 910 *(g_ss33(i,k-1,j) +g_ss33(i-1,k-1,j)))
 911  ss33e(i,k,j) =0.5*(fnm(k)*(ss33(i,k,j) +ss33(i-1,k,j)) +fnp(k)*(ss33(i,k-1,j) &
 912  +ss33(i-1,k-1,j)))
 913
 914  g_ss12e(i,k,j) =0.5*(fnm(k)*(g_ss12(i,k,j) +g_ss12(i,k,j+1)) +fnp(k) &
 915 *(g_ss12(i,k-1,j) +g_ss12(i,k-1,j+1)))
 916  ss12e(i,k,j) =0.5*(fnm(k)*(ss12(i,k,j) +ss12(i,k,j+1)) +fnp(k)*(ss12(i,k-1,j) &
 917  +ss12(i,k-1,j+1)))
 918
 919  g_rr12e(i,k,j) =0.5*(fnm(k)*(g_rr12(i,k,j) +g_rr12(i,k,j+1)) +fnp(k) &
 920 *(g_rr12(i,k-1,j) +g_rr12(i,k-1,j+1)))
 921  rr12e(i,k,j) =0.5*(fnm(k)*(rr12(i,k,j) +rr12(i,k,j+1)) +fnp(k)*(rr12(i,k-1,j) &
 922  +rr12(i,k-1,j+1)))
 923
 924  g_ss23e(i,k,j) =0.25*(g_ss23(i,k,j) +g_ss23(i,k,j+1) +g_ss23(i-1,k,j) &
 925  +g_ss23(i-1,k,j+1))
 926  ss23e(i,k,j) =0.25*(ss23(i,k,j) +ss23(i,k,j+1) +ss23(i-1,k,j) +ss23(i-1,k,j+1))
 927
 928  g_rr23e(i,k,j) =0.25*(g_rr23(i,k,j) +g_rr23(i,k,j+1) +g_rr23(i-1,k,j) &
 929  +g_rr23(i-1,k,j+1))
 930  rr23e(i,k,j) =0.25*(rr23(i,k,j) +rr23(i,k,j+1) +rr23(i-1,k,j) +rr23(i-1,k,j+1))
 931
 932  ENDDO
 933  ENDDO
 934  ENDDO
 935
 936  IF( config_flags%sfs_opt .EQ. 1 ) THEN
 937
 938  DO j =j_start,j_end
 939  DO k =kts+1,ktf
 940  DO i =i_start,i_end
 941
 942  g_delta =0.33333333*(-dx *dy*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))) &
 943 *(dx *dy/rdzw(i,k,j))**(0.33333333 -1.0)
 944  delta =(dx *dy/rdzw(i,k,j))**0.33333333
 945
 946  g_a =-1.0*2.0*(cs*g_delta)*(cs*delta)
 947  a =-1.0*(cs*delta)**2
 948
 949  g_Tmpv1 =2.0*sqrt(2.0*smnsmne(i,k,j))*g_ss13(i,k,j) +2.0*g_Sqrt(2.0* &
 950  g_smnsmne(i,k,j), 2.0*smnsmne(i,k,j))*ss13(i,k,j)
 951  Tmpv1 =2.0*sqrt(2.0*smnsmne(i,k,j))*ss13(i,k,j)
 952
 953  g_Tmpv2 =ss11e(i,k,j)*g_ss13(i,k,j) +g_ss11e(i,k,j)*ss13(i,k,j)
 954  Tmpv2 =ss11e(i,k,j)*ss13(i,k,j)
 955
 956  g_Tmpv3 =ss12e(i,k,j)*g_ss23e(i,k,j) +g_ss12e(i,k,j)*ss23e(i,k,j)
 957  Tmpv3 =ss12e(i,k,j)*ss23e(i,k,j)
 958
 959  g_Tmpv4 =ss13(i,k,j)*g_ss33e(i,k,j) +g_ss13(i,k,j)*ss33e(i,k,j)
 960  Tmpv4 =ss13(i,k,j)*ss33e(i,k,j)
 961
 962  g_Tmpv5 =ss11e(i,k,j)*g_rr13(i,k,j) +g_ss11e(i,k,j)*rr13(i,k,j)
 963  Tmpv5 =ss11e(i,k,j)*rr13(i,k,j)
 964
 965  g_Tmpv6 =ss12e(i,k,j)*g_rr23e(i,k,j) +g_ss12e(i,k,j)*rr23e(i,k,j)
 966  Tmpv6 =ss12e(i,k,j)*rr23e(i,k,j)
 967
 968  g_Tmpv7 =ss23e(i,k,j)*g_rr12e(i,k,j) +g_ss23e(i,k,j)*rr12e(i,k,j)
 969  Tmpv7 =ss23e(i,k,j)*rr12e(i,k,j)
 970
 971  g_Tmpv8 =ss33e(i,k,j)*g_rr13(i,k,j) +g_ss33e(i,k,j)*rr13(i,k,j)
 972  Tmpv8 =ss33e(i,k,j)*rr13(i,k,j)
 973
 974  g_Tmpv9 =a*(g_Tmpv1 +c1*(g_Tmpv2 +g_Tmpv3 +g_Tmpv4) +c2*(g_Tmpv5 + &
 975  g_Tmpv6 -g_Tmpv7 -g_Tmpv8)) +g_a*(Tmpv1 +c1*(Tmpv2 +Tmpv3 +Tmpv4) &
 976  +c2*(Tmpv5 +Tmpv6 -Tmpv7 -Tmpv8))
 977  Tmpv9 =a*(Tmpv1 +c1*(Tmpv2 +Tmpv3 +Tmpv4) +c2*(Tmpv5 +Tmpv6 -Tmpv7 -Tmpv8))
 978
 979  g_m13(i,k,j) =g_Tmpv9
 980  m13(i,k,j) =Tmpv9
 981
 982  ENDDO
 983  ENDDO
 984  ENDDO
 985
 986  ELSE
 987
 988  DO j =j_start,j_end
 989  DO k =kts+1,ktf
 990  DO i =i_start,i_end
 991
 992  g_delta =0.33333333*(-dx *dy*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))) &
 993 *(dx *dy/rdzw(i,k,j))**(0.33333333 -1.0)
 994  delta =(dx *dy/rdzw(i,k,j))**0.33333333
 995
 996  g_a =-1.0 *ce*g_delta
 997  a =-1.0 *ce*delta
 998
 999  g_b =c3*g_delta
1000  b =c3*delta
1001
1002  g_Tmpv1 =2.0*sqrt(tkee(i,k,j))*g_ss13(i,k,j) +2.0*g_Sqrt(g_tkee(i,k,j) &
1003 , tkee(i,k,j))*ss13(i,k,j)
1004  Tmpv1 =2.0*sqrt(tkee(i,k,j))*ss13(i,k,j)
1005
1006  g_Tmpv2 =ss11e(i,k,j)*g_ss13(i,k,j) +g_ss11e(i,k,j)*ss13(i,k,j)
1007  Tmpv2 =ss11e(i,k,j)*ss13(i,k,j)
1008
1009  g_Tmpv3 =ss12e(i,k,j)*g_ss23e(i,k,j) +g_ss12e(i,k,j)*ss23e(i,k,j)
1010  Tmpv3 =ss12e(i,k,j)*ss23e(i,k,j)
1011
1012  g_Tmpv4 =ss13(i,k,j)*g_ss33e(i,k,j) +g_ss13(i,k,j)*ss33e(i,k,j)
1013  Tmpv4 =ss13(i,k,j)*ss33e(i,k,j)
1014
1015  g_Tmpv5 =ss11e(i,k,j)*g_rr13(i,k,j) +g_ss11e(i,k,j)*rr13(i,k,j)
1016  Tmpv5 =ss11e(i,k,j)*rr13(i,k,j)
1017
1018  g_Tmpv6 =ss12e(i,k,j)*g_rr23e(i,k,j) +g_ss12e(i,k,j)*rr23e(i,k,j)
1019  Tmpv6 =ss12e(i,k,j)*rr23e(i,k,j)
1020
1021  g_Tmpv7 =ss23e(i,k,j)*g_rr12e(i,k,j) +g_ss23e(i,k,j)*rr12e(i,k,j)
1022  Tmpv7 =ss23e(i,k,j)*rr12e(i,k,j)
1023
1024  g_Tmpv8 =ss33e(i,k,j)*g_rr13(i,k,j) +g_ss33e(i,k,j)*rr13(i,k,j)
1025  Tmpv8 =ss33e(i,k,j)*rr13(i,k,j)
1026
1027  g_Tmpv9 =b*(c1*(g_Tmpv2 +g_Tmpv3 +g_Tmpv4) +c2*(g_Tmpv5 +g_Tmpv6 - &
1028  g_Tmpv7 -g_Tmpv8)) +g_b*(c1*(Tmpv2 +Tmpv3 +Tmpv4) +c2*(Tmpv5 +Tmpv6 -Tmpv7 -Tmpv8))
1029  Tmpv9 =b*(c1*(Tmpv2 +Tmpv3 +Tmpv4) +c2*(Tmpv5 +Tmpv6 -Tmpv7 -Tmpv8))
1030
1031  g_Tmpv10 =a*(g_Tmpv1 +g_Tmpv9) +g_a*(Tmpv1 +Tmpv9)
1032  Tmpv10 =a*(Tmpv1 +Tmpv9)
1033
1034  g_m13(i,k,j) =g_Tmpv10
1035  m13(i,k,j) =Tmpv10
1036
1037  ENDDO
1038  ENDDO
1039  ENDDO
1040  ENDIF
1041  Return
1042
1043  END SUBROUTINE g_calc_m13
1044
1045  SUBROUTINE g_calc_m23(m23,g_m23,s22,g_s22,s33,g_s33,s12,g_s12,s13, &
1046  g_s13,s23,g_s23,r12,g_r12,r13,g_r13,r23,g_r23,smnsmn,g_smnsmn,tke, &
1047  g_tke,rdzw,g_rdzw,dx,dy,fnm,fnp,config_flags,ids,ide,jds,jde,kds,kde,ims,ime, &
1048  jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
1049
1050  IMPLICIT NONE
1051
1052  REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4,Tmpv5, &
1053  g_Tmpv5,Tmpv6,g_Tmpv6,Tmpv7,g_Tmpv7,Tmpv8,g_Tmpv8,Tmpv9,g_Tmpv9, &
1054  Tmpv10,g_Tmpv10
1055
1056    REAL :: g_Sqrt
1057  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: m23,g_m23
1058
1059  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: s22,g_s22,s33,g_s33,s12,g_s12, &
1060  s13,g_s13,s23,g_s23,r12,g_r12,r13,g_r13,r23,g_r23,smnsmn,g_smnsmn, &
1061  tke,g_tke,rdzw,g_rdzw
1062
1063  REAL :: dx,dy
1064
1065  REAL,DIMENSION(kms:kme) :: fnm,fnp
1066  TYPE(grid_config_rec_type) :: config_flags
1067  INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, &
1068  its,ite,jts,jte,kts,kte
1069
1070  REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: ss22,g_ss22,ss33,g_ss33, &
1071  ss12,g_ss12,ss13,g_ss13,ss23,g_ss23,rr12,g_rr12,rr13,g_rr13,rr23,g_rr23
1072
1073  REAL,DIMENSION(its-1:ite+1,kms:kme,jts-1:jte+1) :: tkef,g_tkef,ss22f,g_ss22f, &
1074  ss33f,g_ss33f,ss12f,g_ss12f,ss13f,g_ss13f,rr12f,g_rr12f,rr13f,g_rr13f, &
1075  smnsmnf,g_smnsmnf
1076  REAL :: delta,g_delta,a,g_a,b,g_b
1077  INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf,je_ext
1078
1079  ktf =min(kte,kde-1)
1080
1081  i_start =its
1082
1083  i_end =min(ite,ide-1)
1084
1085  j_start =jts
1086
1087  j_end =jte
1088
1089  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
1090          config_flags%nested) i_start =max(ids+1,its)
1091
1092  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
1093          config_flags%nested) i_end =min(ide-2,ite)
1094
1095  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
1096          config_flags%nested) j_start =max(jds+1,jts)
1097
1098  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
1099          config_flags%nested) j_end =min(jde-1,jte)
1100
1101  IF( config_flags%periodic_x ) i_start =its
1102
1103  IF( config_flags%periodic_x ) i_end =min(ite,ide-1)
1104
1105  je_ext =1
1106
1107  j_end =j_end+je_ext
1108
1109  DO j =j_start-1,j_end
1110  DO k =kts,ktf
1111  DO i =i_start,i_end+1
1112
1113  g_ss22(i,k,j) =g_s22(i,k,j)/2.0
1114  ss22(i,k,j) =s22(i,k,j)/2.0
1115
1116  g_ss33(i,k,j) =g_s33(i,k,j)/2.0
1117  ss33(i,k,j) =s33(i,k,j)/2.0
1118
1119  g_ss12(i,k,j) =g_s12(i,k,j)/2.0
1120  ss12(i,k,j) =s12(i,k,j)/2.0
1121
1122  g_ss13(i,k,j) =g_s13(i,k,j)/2.0
1123  ss13(i,k,j) =s13(i,k,j)/2.0
1124
1125  g_ss23(i,k,j) =g_s23(i,k,j)/2.0
1126  ss23(i,k,j) =s23(i,k,j)/2.0
1127
1128  g_rr12(i,k,j) =g_r12(i,k,j)/2.0
1129  rr12(i,k,j) =r12(i,k,j)/2.0
1130
1131  g_rr13(i,k,j) =g_r13(i,k,j)/2.0
1132  rr13(i,k,j) =r13(i,k,j)/2.0
1133
1134  g_rr23(i,k,j) =g_r23(i,k,j)/2.0
1135  rr23(i,k,j) =r23(i,k,j)/2.0
1136
1137  ENDDO
1138  ENDDO
1139  ENDDO
1140
1141  DO j =j_start,j_end
1142  DO k =kts+1,ktf
1143  DO i =i_start,i_end
1144
1145  g_tkef(i,k,j) =0.5*(fnm(k)*(g_tke(i,k,j) +g_tke(i,k,j-1)) +fnp(k) &
1146 *(g_tke(i,k-1,j) +g_tke(i,k-1,j-1)))
1147  tkef(i,k,j) =0.5*(fnm(k)*(tke(i,k,j) +tke(i,k,j-1)) +fnp(k)*(tke(i,k-1,j) +tke(i,k-1,j-1)))
1148
1149  g_smnsmnf(i,k,j) =0.5*(fnm(k)*(g_smnsmn(i,k,j) +g_smnsmn(i,k,j-1)) +fnp(k) &
1150 *(g_smnsmn(i,k-1,j) +g_smnsmn(i,k-1,j-1)))
1151  smnsmnf(i,k,j) =0.5*(fnm(k)*(smnsmn(i,k,j) +smnsmn(i,k,j-1)) +fnp(k)*(smnsmn(i,k-1,j) &
1152  +smnsmn(i,k-1,j-1)))
1153
1154  g_ss22f(i,k,j) =0.5*(fnm(k)*(g_ss22(i,k,j) +g_ss22(i,k,j-1)) +fnp(k) &
1155 *(g_ss22(i,k-1,j) +g_ss22(i,k-1,j-1)))
1156  ss22f(i,k,j) =0.5*(fnm(k)*(ss22(i,k,j) +ss22(i,k,j-1)) +fnp(k)*(ss22(i,k-1,j) &
1157  +ss22(i,k-1,j-1)))
1158
1159  g_ss33f(i,k,j) =0.5*(fnm(k)*(g_ss33(i,k,j) +g_ss33(i,k,j-1)) +fnp(k) &
1160 *(g_ss33(i,k-1,j) +g_ss33(i,k-1,j-1)))
1161  ss33f(i,k,j) =0.5*(fnm(k)*(ss33(i,k,j) +ss33(i,k,j-1)) +fnp(k)*(ss33(i,k-1,j) &
1162  +ss33(i,k-1,j-1)))
1163
1164  g_ss12f(i,k,j) =0.5*(fnm(k)*(g_ss12(i,k,j) +g_ss12(i+1,k,j)) +fnp(k) &
1165 *(g_ss12(i,k-1,j) +g_ss12(i+1,k-1,j)))
1166  ss12f(i,k,j) =0.5*(fnm(k)*(ss12(i,k,j) +ss12(i+1,k,j)) +fnp(k)*(ss12(i,k-1,j) &
1167  +ss12(i+1,k-1,j)))
1168
1169  g_rr12f(i,k,j) =0.5*(fnm(k)*(g_rr12(i,k,j) +g_rr12(i+1,k,j)) +fnp(k) &
1170 *(g_rr12(i,k-1,j) +g_rr12(i+1,k-1,j)))
1171  rr12f(i,k,j) =0.5*(fnm(k)*(rr12(i,k,j) +rr12(i+1,k,j)) +fnp(k)*(rr12(i,k-1,j) &
1172  +rr12(i+1,k-1,j)))
1173
1174  g_ss13f(i,k,j) =0.25*(g_ss13(i,k,j) +g_ss13(i,k,j-1) +g_ss13(i+1,k,j-1) &
1175  +g_ss13(i+1,k,j))
1176  ss13f(i,k,j) =0.25*(ss13(i,k,j) +ss13(i,k,j-1) +ss13(i+1,k,j-1) +ss13(i+1,k,j))
1177
1178  g_rr13f(i,k,j) =0.25*(g_rr13(i,k,j) +g_rr13(i,k,j-1) +g_rr13(i+1,k,j-1) &
1179  +g_rr13(i+1,k,j))
1180  rr13f(i,k,j) =0.25*(rr13(i,k,j) +rr13(i,k,j-1) +rr13(i+1,k,j-1) +rr13(i+1,k,j))
1181
1182  ENDDO
1183  ENDDO
1184  ENDDO
1185
1186  IF( config_flags%sfs_opt .EQ. 1 ) THEN
1187
1188  DO j =j_start,j_end
1189  DO k =kts+1,ktf
1190  DO i =i_start,i_end
1191
1192  g_delta =0.33333333*(-dx *dy*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))) &
1193 *(dx *dy/rdzw(i,k,j))**(0.33333333 -1.0)
1194  delta =(dx *dy/rdzw(i,k,j))**0.33333333
1195
1196  g_a =-1.0*2.0*(cs*g_delta)*(cs*delta)
1197  a =-1.0*(cs*delta)**2
1198
1199  g_Tmpv1 =2.0*sqrt(2.0*smnsmnf(i,k,j))*g_ss23(i,k,j) +2.0*g_Sqrt(2.0* &
1200  g_smnsmnf(i,k,j), 2.0*smnsmnf(i,k,j))*ss23(i,k,j)
1201  Tmpv1 =2.0*sqrt(2.0*smnsmnf(i,k,j))*ss23(i,k,j)
1202
1203  g_Tmpv2 =ss12f(i,k,j)*g_ss13f(i,k,j) +g_ss12f(i,k,j)*ss13f(i,k,j)
1204  Tmpv2 =ss12f(i,k,j)*ss13f(i,k,j)
1205
1206  g_Tmpv3 =ss22f(i,k,j)*g_ss23(i,k,j) +g_ss22f(i,k,j)*ss23(i,k,j)
1207  Tmpv3 =ss22f(i,k,j)*ss23(i,k,j)
1208
1209  g_Tmpv4 =ss23(i,k,j)*g_ss33f(i,k,j) +g_ss23(i,k,j)*ss33f(i,k,j)
1210  Tmpv4 =ss23(i,k,j)*ss33f(i,k,j)
1211
1212  g_Tmpv5 =ss12f(i,k,j)*g_rr13f(i,k,j) +g_ss12f(i,k,j)*rr13f(i,k,j)
1213  Tmpv5 =ss12f(i,k,j)*rr13f(i,k,j)
1214
1215  g_Tmpv6 =ss22f(i,k,j)*g_rr23(i,k,j) +g_ss22f(i,k,j)*rr23(i,k,j)
1216  Tmpv6 =ss22f(i,k,j)*rr23(i,k,j)
1217
1218  g_Tmpv7 =ss13f(i,k,j)*g_rr12f(i,k,j) +g_ss13f(i,k,j)*rr12f(i,k,j)
1219  Tmpv7 =ss13f(i,k,j)*rr12f(i,k,j)
1220
1221  g_Tmpv8 =ss33f(i,k,j)*g_rr23(i,k,j) +g_ss33f(i,k,j)*rr23(i,k,j)
1222  Tmpv8 =ss33f(i,k,j)*rr23(i,k,j)
1223
1224  g_Tmpv9 =a*(g_Tmpv1 +c1*(g_Tmpv2 +g_Tmpv3 +g_Tmpv4) +c2*(g_Tmpv5 + &
1225  g_Tmpv6 +g_Tmpv7 -g_Tmpv8)) +g_a*(Tmpv1 +c1*(Tmpv2 +Tmpv3 +Tmpv4) &
1226  +c2*(Tmpv5 +Tmpv6 +Tmpv7 -Tmpv8))
1227  Tmpv9 =a*(Tmpv1 +c1*(Tmpv2 +Tmpv3 +Tmpv4) +c2*(Tmpv5 +Tmpv6 +Tmpv7 -Tmpv8))
1228
1229  g_m23(i,k,j) =g_Tmpv9
1230  m23(i,k,j) =Tmpv9
1231
1232  ENDDO
1233  ENDDO
1234  ENDDO
1235
1236  ELSE
1237
1238  DO j =j_start,j_end
1239  DO k =kts+1,ktf
1240  DO i =i_start,i_end
1241
1242  g_delta =0.33333333*(-dx *dy*g_rdzw(i,k,j)/(rdzw(i,k,j)*rdzw(i,k,j))) &
1243 *(dx *dy/rdzw(i,k,j))**(0.33333333 -1.0)
1244  delta =(dx *dy/rdzw(i,k,j))**0.33333333
1245
1246  g_a =-1.0 *ce*g_delta
1247  a =-1.0 *ce*delta
1248
1249  g_b =c3*g_delta
1250  b =c3*delta
1251
1252  g_Tmpv1 =2.0*sqrt(tkef(i,k,j))*g_ss23(i,k,j) +2.0*g_Sqrt(g_tkef(i,k,j) &
1253 , tkef(i,k,j))*ss23(i,k,j)
1254  Tmpv1 =2.0*sqrt(tkef(i,k,j))*ss23(i,k,j)
1255
1256  g_Tmpv2 =ss12f(i,k,j)*g_ss13f(i,k,j) +g_ss12f(i,k,j)*ss13f(i,k,j)
1257  Tmpv2 =ss12f(i,k,j)*ss13f(i,k,j)
1258
1259  g_Tmpv3 =ss22f(i,k,j)*g_ss23(i,k,j) +g_ss22f(i,k,j)*ss23(i,k,j)
1260  Tmpv3 =ss22f(i,k,j)*ss23(i,k,j)
1261
1262  g_Tmpv4 =ss23(i,k,j)*g_ss33f(i,k,j) +g_ss23(i,k,j)*ss33f(i,k,j)
1263  Tmpv4 =ss23(i,k,j)*ss33f(i,k,j)
1264
1265  g_Tmpv5 =ss12f(i,k,j)*g_rr13f(i,k,j) +g_ss12f(i,k,j)*rr13f(i,k,j)
1266  Tmpv5 =ss12f(i,k,j)*rr13f(i,k,j)
1267
1268  g_Tmpv6 =ss22f(i,k,j)*g_rr23(i,k,j) +g_ss22f(i,k,j)*rr23(i,k,j)
1269  Tmpv6 =ss22f(i,k,j)*rr23(i,k,j)
1270
1271  g_Tmpv7 =ss13f(i,k,j)*g_rr12f(i,k,j) +g_ss13f(i,k,j)*rr12f(i,k,j)
1272  Tmpv7 =ss13f(i,k,j)*rr12f(i,k,j)
1273
1274  g_Tmpv8 =ss33f(i,k,j)*g_rr23(i,k,j) +g_ss33f(i,k,j)*rr23(i,k,j)
1275  Tmpv8 =ss33f(i,k,j)*rr23(i,k,j)
1276
1277  g_Tmpv9 =b*(c1*(g_Tmpv2 +g_Tmpv3 +g_Tmpv4) +c2*(g_Tmpv5 +g_Tmpv6 + &
1278  g_Tmpv7 -g_Tmpv8)) +g_b*(c1*(Tmpv2 +Tmpv3 +Tmpv4) +c2*(Tmpv5 +Tmpv6 +Tmpv7 -Tmpv8))
1279  Tmpv9 =b*(c1*(Tmpv2 +Tmpv3 +Tmpv4) +c2*(Tmpv5 +Tmpv6 +Tmpv7 -Tmpv8))
1280
1281  g_Tmpv10 =a*(g_Tmpv1 +g_Tmpv9) +g_a*(Tmpv1 +Tmpv9)
1282  Tmpv10 =a*(Tmpv1 +Tmpv9)
1283
1284  g_m23(i,k,j) =g_Tmpv10
1285  m23(i,k,j) =Tmpv10
1286
1287  ENDDO
1288  ENDDO
1289  ENDDO
1290  ENDIF
1291  Return
1292
1293  END SUBROUTINE g_calc_m23
1294
1295  END MODULE g_module_sfs_nba
1296
1297 ! REAL Function g_Sqrt(g_x,x)
1298 !
1299 ! REAL g_x,x
1300 !
1301 ! IF(x.GT.0.0) THEN
1302 !   g_Sqrt =0.5*g_x/sqrt(x)
1303 ! ELSE
1304 !   Print*,''
1305 !   Print*,'g_Sqrt is incorrectly evaluated by 0!'
1306 !   Print*,'Aborted from calc_m23'
1307 !   g_Sqrt =0.0
1308 ! END IF
1309
1310 ! RETURN
1311 ! END
1312