wrftladj/module_sfs_driver_tl.F

   1 !WRF+/TL:MEDIATION_LAYER:PHYSICS
   2 !Created by Ning Pan, 2010-08
   3
   4 MODULE g_module_sfs_driver
   5
   6 CONTAINS
   7
   8 SUBROUTINE g_sfs_driver( grid, config_flags, &
   9                             nba_mij,g_nba_mij, n_nba_mij, &
  10                             nba_rij,g_nba_rij, n_nba_rij  )
  11
  12   USE module_domain
  13   USE module_configure
  14   USE module_tiles
  15   USE module_machine
  16   USE module_state_description
  17   USE g_module_bc
  18   USE module_sfs_nba, ONLY : calc_mij_constants
  19   USE g_module_sfs_nba
  20 #ifdef DM_PARALLEL
  21    USE module_dm
  22    USE module_comm_dm, ONLY : &
  23                            HALO_EM_NBA_RIJ_sub   &
  24                           ,PERIOD_EM_NBA_RIJ_sub   &
  25                           ,HALO_EM_NBA_MIJ_sub   &
  26                           ,PERIOD_EM_NBA_MIJ_sub
  27 #endif
  28
  29   IMPLICIT NONE
  30
  31 ! Input data.
  32
  33   TYPE(domain) , TARGET          :: grid
  34
  35   TYPE (grid_config_rec_type) , INTENT(IN)          :: config_flags
  36
  37   INTEGER, INTENT(  IN ) :: n_nba_mij, n_nba_rij
  38
  39   REAL ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,n_nba_mij) &
  40   :: nba_mij,g_nba_mij
  41
  42   REAL ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,n_nba_rij) &
  43   :: nba_rij,g_nba_rij
  44
  45 ! Local data
  46
  47   INTEGER :: k_start , k_end, its, ite, jts, jte
  48   INTEGER :: ids , ide , jds , jde , kds , kde , &
  49              ims , ime , jms , jme , kms , kme , &
  50              ips , ipe , jps , jpe , kps , kpe
  51
  52   INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, &
  53              ipsx, ipex, jpsx, jpex, kpsx, kpex, &
  54              imsy, imey, jmsy, jmey, kmsy, kmey, &
  55              ipsy, ipey, jpsy, jpey, kpsy, kpey
  56
  57   INTEGER :: ij, i, j, k
  58
  59
  60   CALL get_ijk_from_grid ( grid ,                              &
  61                            ids, ide, jds, jde, kds, kde,       &
  62                            ims, ime, jms, jme, kms, kme,       &
  63                            ips, ipe, jps, jpe, kps, kpe,       &
  64                            imsx, imex, jmsx, jmex, kmsx, kmex, &
  65                            ipsx, ipex, jpsx, jpex, kpsx, kpex, &
  66                            imsy, imey, jmsy, jmey, kmsy, kmey, &
  67                            ipsy, ipey, jpsy, jpey, kpsy, kpey  )
  68
  69   k_start         = kps
  70   k_end           = kpe
  71
  72   CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
  73
  74
  75   IF ( (config_flags%sfs_opt .EQ. 1) .OR. (config_flags%sfs_opt .EQ. 2) ) THEN
  76
  77     !$OMP PARALLEL DO   &
  78     !$OMP PRIVATE ( ij )
  79     DO ij = 1 , grid%num_tiles !----------------------------------------
  80
  81         CALL calc_mij_constants( )
  82
  83     ENDDO !-------------------------------------------------------------
  84     !$OMP END PARALLEL DO
  85
  86     !$OMP PARALLEL DO   &
  87     !$OMP PRIVATE ( ij )
  88     DO ij = 1 , grid%num_tiles !----------------------------------------
  89
  90         CALL g_calc_smnsmn( nba_rij(ims,kms,jms,P_smnsmn),g_nba_rij(ims,kms,jms,P_smnsmn),    &
  91                           grid%defor11,grid%g_defor11, grid%defor22,grid%g_defor22,  &
  92                           grid%defor33,grid%g_defor33, grid%defor12,grid%g_defor12,  &
  93                           grid%defor13,grid%g_defor13, grid%defor23,grid%g_defor23,  &
  94                           config_flags,                     &
  95                           ids, ide, jds, jde, kds, kde,     &
  96                           ims, ime, jms, jme, kms, kme,     &
  97                           ips, ipe, jps, jpe, kps, kpe,     &
  98                           grid%i_start(ij), grid%i_end(ij), &
  99                           grid%j_start(ij), grid%j_end(ij), &
 100                           k_start    , k_end                )
 101
 102     ENDDO !-------------------------------------------------------------
 103     !$OMP END PARALLEL DO
 104
 105
 106 #ifdef DM_PARALLEL
 107 #      include "HALO_EM_NBA_RIJ.inc"
 108 #      include "PERIOD_EM_NBA_RIJ.inc"
 109 #endif
 110
 111     !$OMP PARALLEL DO   &
 112     !$OMP PRIVATE ( ij )
 113     DO ij = 1 , grid%num_tiles !----------------------------------------
 114
 115         CALL g_set_physical_bc3d( nba_rij(ims,kms,jms,P_r12),g_nba_rij(ims,kms,jms,P_r12), 'd',  &
 116                                 config_flags,                     &
 117                                 ids, ide, jds, jde, kds, kde,     &
 118                                 ims, ime, jms, jme, kms, kme,     &
 119                                 ips, ipe, jps, jpe, kps, kpe,     &
 120                                 grid%i_start(ij), grid%i_end(ij), &
 121                                 grid%j_start(ij), grid%j_end(ij), &
 122                                 k_start    , k_end                )
 123
 124         CALL g_set_physical_bc3d( nba_rij(ims,kms,jms,P_r13),g_nba_rij(ims,kms,jms,P_r13), 'e',  &
 125                                 config_flags,                     &
 126                                 ids, ide, jds, jde, kds, kde,     &
 127                                 ims, ime, jms, jme, kms, kme,     &
 128                                 ips, ipe, jps, jpe, kps, kpe,     &
 129                                 grid%i_start(ij), grid%i_end(ij), &
 130                                 grid%j_start(ij), grid%j_end(ij), &
 131                                 k_start    , k_end                )
 132
 133         CALL g_set_physical_bc3d( nba_rij(ims,kms,jms,P_r23),g_nba_rij(ims,kms,jms,P_r23), 'f',  &
 134                                 config_flags,                     &
 135                                 ids, ide, jds, jde, kds, kde,     &
 136                                 ims, ime, jms, jme, kms, kme,     &
 137                                 ips, ipe, jps, jpe, kps, kpe,     &
 138                                 grid%i_start(ij), grid%i_end(ij), &
 139                                 grid%j_start(ij), grid%j_end(ij), &
 140                                 k_start    , k_end                )
 141
 142         CALL g_set_physical_bc3d( nba_rij(ims,kms,jms,P_smnsmn),g_nba_rij(ims,kms,jms,P_smnsmn), 'c', &
 143                                 config_flags,                       &
 144                                 ids, ide, jds, jde, kds, kde,       &
 145                                 ims, ime, jms, jme, kms, kme,       &
 146                                 ips, ipe, jps, jpe, kps, kpe,       &
 147                                 grid%i_start(ij), grid%i_end(ij),   &
 148                                 grid%j_start(ij), grid%j_end(ij),   &
 149                                 k_start    , k_end                  )
 150
 151     ENDDO !-------------------------------------------------------------
 152     !$OMP END PARALLEL DO
 153
 154     !$OMP PARALLEL DO   &
 155     !$OMP PRIVATE ( ij )
 156     DO ij = 1 , grid%num_tiles !----------------------------------------
 157
 158       CALL g_calc_mii( nba_mij(ims,kms,jms,P_m11),g_nba_mij(ims,kms,jms,P_m11), &
 159                           nba_mij(ims,kms,jms,P_m22),g_nba_mij(ims,kms,jms,P_m22), &
 160                           nba_mij(ims,kms,jms,P_m33),g_nba_mij(ims,kms,jms,P_m33), &
 161                           grid%defor11,grid%g_defor11, grid%defor22,grid%g_defor22,   &
 162                           grid%defor33,grid%g_defor33, grid%defor12,grid%g_defor12,   &
 163                           grid%defor13,grid%g_defor13, grid%defor23,grid%g_defor23,   &
 164                           nba_rij(ims,kms,jms,P_r12),g_nba_rij(ims,kms,jms,P_r12), &
 165                           nba_rij(ims,kms,jms,P_r13),g_nba_rij(ims,kms,jms,P_r13), &
 166                           nba_rij(ims,kms,jms,P_r23),g_nba_rij(ims,kms,jms,P_r23), &
 167                           nba_rij(ims,kms,jms,P_smnsmn),g_nba_rij(ims,kms,jms,P_smnsmn),     &
 168                           grid%tke_2,grid%g_tke_2,                      &
 169                           grid%rdzw,grid%g_rdzw, grid%dx, grid%dy,      &
 170                           config_flags,                     &
 171                           ids, ide, jds, jde, kds, kde,     &
 172                           ims, ime, jms, jme, kms, kme,     &
 173                           ips, ipe, jps, jpe, kps, kpe,     &
 174                           grid%i_start(ij), grid%i_end(ij), &
 175                           grid%j_start(ij), grid%j_end(ij), &
 176                           k_start, k_end                    )
 177
 178     ENDDO !-------------------------------------------------------------
 179     !$OMP END PARALLEL DO
 180
 181     !$OMP PARALLEL DO   &
 182     !$OMP PRIVATE ( ij )
 183     DO ij = 1 , grid%num_tiles !----------------------------------------
 184
 185       CALL g_calc_m12( nba_mij(ims,kms,jms,P_m12),g_nba_mij(ims,kms,jms,P_m12), &
 186                           grid%defor11,grid%g_defor11, grid%defor22,grid%g_defor22,   &
 187                           grid%defor12,grid%g_defor12,       &
 188                           grid%defor13,grid%g_defor13, grid%defor23,grid%g_defor23,   &
 189                           nba_rij(ims,kms,jms,P_r12),g_nba_rij(ims,kms,jms,P_r12), &
 190                           nba_rij(ims,kms,jms,P_r13),g_nba_rij(ims,kms,jms,P_r13), &
 191                           nba_rij(ims,kms,jms,P_r23),g_nba_rij(ims,kms,jms,P_r23), &
 192                           nba_rij(ims,kms,jms,P_smnsmn),g_nba_rij(ims,kms,jms,P_smnsmn),     &
 193                           grid%tke_2,grid%g_tke_2,                      &
 194                           grid%rdzw,grid%g_rdzw, grid%dx, grid%dy,      &
 195                           config_flags,                     &
 196                           ids, ide, jds, jde, kds, kde,     &
 197                           ims, ime, jms, jme, kms, kme,     &
 198                           ips, ipe, jps, jpe, kps, kpe,     &
 199                           grid%i_start(ij), grid%i_end(ij), &
 200                           grid%j_start(ij), grid%j_end(ij), &
 201                           k_start, k_end                    )
 202
 203     ENDDO !-------------------------------------------------------------
 204     !$OMP END PARALLEL DO
 205
 206     !$OMP PARALLEL DO   &
 207     !$OMP PRIVATE ( ij )
 208     DO ij = 1 , grid%num_tiles !----------------------------------------
 209
 210       CALL g_calc_m13( nba_mij(ims,kms,jms,P_m13),g_nba_mij(ims,kms,jms,P_m13), &
 211                           grid%defor11,grid%g_defor11,       &
 212                           grid%defor33,grid%g_defor33, grid%defor12,grid%g_defor12,   &
 213                           grid%defor13,grid%g_defor13, grid%defor23,grid%g_defor23,   &
 214                           nba_rij(ims,kms,jms,P_r12),g_nba_rij(ims,kms,jms,P_r12), &
 215                           nba_rij(ims,kms,jms,P_r13),g_nba_rij(ims,kms,jms,P_r13), &
 216                           nba_rij(ims,kms,jms,P_r23),g_nba_rij(ims,kms,jms,P_r23), &
 217                           nba_rij(ims,kms,jms,P_smnsmn),g_nba_rij(ims,kms,jms,P_smnsmn),     &
 218                           grid%tke_2,grid%g_tke_2,                      &
 219                           grid%rdzw,grid%g_rdzw, grid%dx, grid%dy,      &
 220                           grid%fnm, grid%fnp,               &
 221                           config_flags,                     &
 222                           ids, ide, jds, jde, kds, kde,     &
 223                           ims, ime, jms, jme, kms, kme,     &
 224                           ips, ipe, jps, jpe, kps, kpe,     &
 225                           grid%i_start(ij), grid%i_end(ij), &
 226                           grid%j_start(ij), grid%j_end(ij), &
 227                           k_start, k_end                    )
 228
 229     ENDDO !-------------------------------------------------------------
 230     !$OMP END PARALLEL DO
 231
 232     !$OMP PARALLEL DO   &
 233     !$OMP PRIVATE ( ij )
 234     DO ij = 1 , grid%num_tiles !----------------------------------------
 235
 236       CALL g_calc_m23( nba_mij(ims,kms,jms,P_m23),g_nba_mij(ims,kms,jms,P_m23),     &
 237                           grid%defor22,grid%g_defor22,       &
 238                           grid%defor33,grid%g_defor33, grid%defor12,grid%g_defor12,       &
 239                           grid%defor13,grid%g_defor13, grid%defor23,grid%g_defor23,       &
 240                           nba_rij(ims,kms,jms,P_r12),g_nba_rij(ims,kms,jms,P_r12),     &
 241                           nba_rij(ims,kms,jms,P_r13),g_nba_rij(ims,kms,jms,P_r13),     &
 242                           nba_rij(ims,kms,jms,P_r23),g_nba_rij(ims,kms,jms,P_r23),     &
 243                           nba_rij(ims,kms,jms,P_smnsmn),g_nba_rij(ims,kms,jms,P_smnsmn),     &
 244                           grid%tke_2,grid%g_tke_2,                      &
 245                           grid%rdzw,grid%g_rdzw, grid%dx, grid%dy,      &
 246                           grid%fnm, grid%fnp,               &
 247                           config_flags,                     &
 248                           ids, ide, jds, jde, kds, kde,     &
 249                           ims, ime, jms, jme, kms, kme,     &
 250                           ips, ipe, jps, jpe, kps, kpe,     &
 251                           grid%i_start(ij), grid%i_end(ij), &
 252                           grid%j_start(ij), grid%j_end(ij), &
 253                           k_start, k_end                    )
 254
 255     ENDDO !-------------------------------------------------------------
 256     !$OMP END PARALLEL DO
 257
 258 #ifdef DM_PARALLEL
 259 #      include "HALO_EM_NBA_MIJ.inc"
 260 #      include "PERIOD_EM_NBA_MIJ.inc"
 261 #endif
 262
 263     !$OMP PARALLEL DO   &
 264     !$OMP PRIVATE ( ij )
 265     DO ij = 1 , grid%num_tiles !----------------------------------------
 266
 267       CALL g_set_physical_bc3d( nba_mij(ims,kms,jms,P_m11),g_nba_mij(ims,kms,jms,P_m11), 'p',    &
 268                               config_flags,                     &
 269                               ids, ide, jds, jde, kds, kde,     &
 270                               ims, ime, jms, jme, kms, kme,     &
 271                               ips, ipe, jps, jpe, kps, kpe,     &
 272                               grid%i_start(ij), grid%i_end(ij), &
 273                               grid%j_start(ij), grid%j_end(ij), &
 274                               k_start    , k_end                )
 275
 276       CALL g_set_physical_bc3d( nba_mij(ims,kms,jms,P_m22),g_nba_mij(ims,kms,jms,P_m22), 'p',    &
 277                               config_flags,                     &
 278                               ids, ide, jds, jde, kds, kde,     &
 279                               ims, ime, jms, jme, kms, kme,     &
 280                               ips, ipe, jps, jpe, kps, kpe,     &
 281                               grid%i_start(ij), grid%i_end(ij), &
 282                               grid%j_start(ij), grid%j_end(ij), &
 283                               k_start    , k_end                )
 284
 285       CALL g_set_physical_bc3d( nba_mij(ims,kms,jms,P_m33),g_nba_mij(ims,kms,jms,P_m33), 'p',    &
 286                               config_flags,                     &
 287                               ids, ide, jds, jde, kds, kde,     &
 288                               ims, ime, jms, jme, kms, kme,     &
 289                               ips, ipe, jps, jpe, kps, kpe,     &
 290                               grid%i_start(ij), grid%i_end(ij), &
 291                               grid%j_start(ij), grid%j_end(ij), &
 292                               k_start    , k_end                )
 293
 294       CALL g_set_physical_bc3d( nba_mij(ims,kms,jms,P_m12),g_nba_mij(ims,kms,jms,P_m12), 'd',    &
 295                               config_flags,                     &
 296                               ids, ide, jds, jde, kds, kde,     &
 297                               ims, ime, jms, jme, kms, kme,     &
 298                               ips, ipe, jps, jpe, kps, kpe,     &
 299                               grid%i_start(ij), grid%i_end(ij), &
 300                               grid%j_start(ij), grid%j_end(ij), &
 301                               k_start    , k_end                )
 302
 303       CALL g_set_physical_bc3d( nba_mij(ims,kms,jms,P_m13),g_nba_mij(ims,kms,jms,P_m13), 'e',    &
 304                               config_flags,                     &
 305                               ids, ide, jds, jde, kds, kde,     &
 306                               ims, ime, jms, jme, kms, kme,     &
 307                               ips, ipe, jps, jpe, kps, kpe,     &
 308                               grid%i_start(ij), grid%i_end(ij), &
 309                               grid%j_start(ij), grid%j_end(ij), &
 310                               k_start    , k_end                )
 311
 312       CALL g_set_physical_bc3d( nba_mij(ims,kms,jms,P_m23),g_nba_mij(ims,kms,jms,P_m23), 'f',    &
 313                               config_flags,                     &
 314                               ids, ide, jds, jde, kds, kde,     &
 315                               ims, ime, jms, jme, kms, kme,     &
 316                               ips, ipe, jps, jpe, kps, kpe,     &
 317                               grid%i_start(ij), grid%i_end(ij), &
 318                               grid%j_start(ij), grid%j_end(ij), &
 319                               k_start    , k_end                )
 320
 321     ENDDO !-------------------------------------------------------------
 322     !$OMP END PARALLEL DO
 323
 324   ENDIF !(config_flags%sfs_opt .EQ. 1) .OR. (config_flags%sfs_opt .EQ. 2)
 325
 326 END SUBROUTINE g_sfs_driver
 327
 328 END MODULE g_module_sfs_driver