wrftladj/module_sfs_driver_ad.F

   1 !WRF+/AD:MEDIATION_LAYER:PHYSICS
   2 !Created by Ning Pan, 2010-08
   3
   4 MODULE a_module_sfs_driver
   5
   6 CONTAINS
   7
   8 SUBROUTINE a_sfs_driver( grid, config_flags, &
   9                            nba_mij,a_nba_mij, n_nba_mij, &
  10                            nba_rij,a_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 module_bc
  18   USE a_module_bc
  19   USE module_sfs_nba, ONLY : calc_mij_constants, calc_smnsmn
  20   USE a_module_sfs_nba
  21 #ifdef DM_PARALLEL
  22    USE module_dm
  23    USE module_comm_dm, ONLY : &
  24                            HALO_EM_NBA_RIJ_sub   &
  25                           ,PERIOD_EM_NBA_RIJ_sub   &
  26                           ,HALO_EM_NBA_MIJ_sub   &
  27                           ,PERIOD_EM_NBA_MIJ_sub
  28 #endif
  29
  30   IMPLICIT NONE
  31
  32 ! Input data.
  33
  34   TYPE(domain) , TARGET          :: grid
  35
  36   TYPE (grid_config_rec_type) , INTENT(IN)          :: config_flags
  37
  38   INTEGER, INTENT(  IN ) :: n_nba_mij, n_nba_rij
  39
  40   REAL ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,n_nba_mij) &
  41   :: nba_mij,a_nba_mij
  42
  43   REAL ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,n_nba_rij) &
  44   :: nba_rij,a_nba_rij
  45
  46 ! Local data
  47
  48   INTEGER :: k_start , k_end, its, ite, jts, jte
  49   INTEGER :: ids , ide , jds , jde , kds , kde , &
  50              ims , ime , jms , jme , kms , kme , &
  51              ips , ipe , jps , jpe , kps , kpe
  52
  53   INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, &
  54              ipsx, ipex, jpsx, jpex, kpsx, kpex, &
  55              imsy, imey, jmsy, jmey, kmsy, kmey, &
  56              ipsy, ipey, jpsy, jpey, kpsy, kpey
  57
  58   INTEGER :: ij, i, j, k
  59
  60
  61   CALL get_ijk_from_grid ( grid ,                              &
  62                            ids, ide, jds, jde, kds, kde,       &
  63                            ims, ime, jms, jme, kms, kme,       &
  64                            ips, ipe, jps, jpe, kps, kpe,       &
  65                            imsx, imex, jmsx, jmex, kmsx, kmex, &
  66                            ipsx, ipex, jpsx, jpex, kpsx, kpex, &
  67                            imsy, imey, jmsy, jmey, kmsy, kmey, &
  68                            ipsy, ipey, jpsy, jpey, kpsy, kpey  )
  69
  70   k_start         = kps
  71   k_end           = kpe
  72
  73   CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
  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 calc_smnsmn( nba_rij(ims,kms,jms,P_smnsmn),    &
  91                           grid%defor11, grid%defor22,       &
  92                           grid%defor33, grid%defor12,       &
  93                           grid%defor13, grid%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 #ifdef DM_PARALLEL
 106 #      include "HALO_EM_NBA_RIJ.inc"
 107 #      include "PERIOD_EM_NBA_RIJ.inc"
 108 #endif
 109
 110     !$OMP PARALLEL DO   &
 111     !$OMP PRIVATE ( ij )
 112     DO ij = 1 , grid%num_tiles !----------------------------------------
 113
 114         CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_r12), 'd',  &
 115                                 config_flags,                     &
 116                                 ids, ide, jds, jde, kds, kde,     &
 117                                 ims, ime, jms, jme, kms, kme,     &
 118                                 ips, ipe, jps, jpe, kps, kpe,     &
 119                                 grid%i_start(ij), grid%i_end(ij), &
 120                                 grid%j_start(ij), grid%j_end(ij), &
 121                                 k_start    , k_end                )
 122
 123         CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_r13), 'e',  &
 124                                 config_flags,                     &
 125                                 ids, ide, jds, jde, kds, kde,     &
 126                                 ims, ime, jms, jme, kms, kme,     &
 127                                 ips, ipe, jps, jpe, kps, kpe,     &
 128                                 grid%i_start(ij), grid%i_end(ij), &
 129                                 grid%j_start(ij), grid%j_end(ij), &
 130                                 k_start    , k_end                )
 131
 132         CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_r23), 'f',  &
 133                                 config_flags,                     &
 134                                 ids, ide, jds, jde, kds, kde,     &
 135                                 ims, ime, jms, jme, kms, kme,     &
 136                                 ips, ipe, jps, jpe, kps, kpe,     &
 137                                 grid%i_start(ij), grid%i_end(ij), &
 138                                 grid%j_start(ij), grid%j_end(ij), &
 139                                 k_start    , k_end                )
 140
 141         CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_smnsmn), 'c', &
 142                                 config_flags,                       &
 143                                 ids, ide, jds, jde, kds, kde,       &
 144                                 ims, ime, jms, jme, kms, kme,       &
 145                                 ips, ipe, jps, jpe, kps, kpe,       &
 146                                 grid%i_start(ij), grid%i_end(ij),   &
 147                                 grid%j_start(ij), grid%j_end(ij),   &
 148                                 k_start    , k_end                  )
 149
 150     ENDDO !-------------------------------------------------------------
 151     !$OMP END PARALLEL DO
 152
 153 #ifdef DM_PARALLEL
 154 #      include "HALO_EM_NBA_MIJ.inc"
 155 #      include "PERIOD_EM_NBA_MIJ.inc"
 156 #endif
 157
 158     !$OMP PARALLEL DO   &
 159     !$OMP PRIVATE ( ij )
 160     DO ij = grid%num_tiles,1,-1 !----------------------------------------
 161
 162       CALL a_set_physical_bc3d( a_nba_mij(ims,kms,jms,P_m23), 'f',    &
 163                               config_flags,                     &
 164                               ids, ide, jds, jde, kds, kde,     &
 165                               ims, ime, jms, jme, kms, kme,     &
 166                               ips, ipe, jps, jpe, kps, kpe,     &
 167                               grid%i_start(ij), grid%i_end(ij), &
 168                               grid%j_start(ij), grid%j_end(ij), &
 169                               k_start    , k_end                )
 170
 171       CALL a_set_physical_bc3d( a_nba_mij(ims,kms,jms,P_m13), 'e',    &
 172                               config_flags,                     &
 173                               ids, ide, jds, jde, kds, kde,     &
 174                               ims, ime, jms, jme, kms, kme,     &
 175                               ips, ipe, jps, jpe, kps, kpe,     &
 176                               grid%i_start(ij), grid%i_end(ij), &
 177                               grid%j_start(ij), grid%j_end(ij), &
 178                               k_start    , k_end                )
 179
 180       CALL a_set_physical_bc3d( a_nba_mij(ims,kms,jms,P_m12), 'd',    &
 181                               config_flags,                     &
 182                               ids, ide, jds, jde, kds, kde,     &
 183                               ims, ime, jms, jme, kms, kme,     &
 184                               ips, ipe, jps, jpe, kps, kpe,     &
 185                               grid%i_start(ij), grid%i_end(ij), &
 186                               grid%j_start(ij), grid%j_end(ij), &
 187                               k_start    , k_end                )
 188
 189       CALL a_set_physical_bc3d( a_nba_mij(ims,kms,jms,P_m33), 'p',    &
 190                               config_flags,                     &
 191                               ids, ide, jds, jde, kds, kde,     &
 192                               ims, ime, jms, jme, kms, kme,     &
 193                               ips, ipe, jps, jpe, kps, kpe,     &
 194                               grid%i_start(ij), grid%i_end(ij), &
 195                               grid%j_start(ij), grid%j_end(ij), &
 196                               k_start    , k_end                )
 197
 198       CALL a_set_physical_bc3d( a_nba_mij(ims,kms,jms,P_m22), 'p',    &
 199                               config_flags,                     &
 200                               ids, ide, jds, jde, kds, kde,     &
 201                               ims, ime, jms, jme, kms, kme,     &
 202                               ips, ipe, jps, jpe, kps, kpe,     &
 203                               grid%i_start(ij), grid%i_end(ij), &
 204                               grid%j_start(ij), grid%j_end(ij), &
 205                               k_start    , k_end                )
 206
 207       CALL a_set_physical_bc3d( a_nba_mij(ims,kms,jms,P_m11), 'p',    &
 208                               config_flags,                     &
 209                               ids, ide, jds, jde, kds, kde,     &
 210                               ims, ime, jms, jme, kms, kme,     &
 211                               ips, ipe, jps, jpe, kps, kpe,     &
 212                               grid%i_start(ij), grid%i_end(ij), &
 213                               grid%j_start(ij), grid%j_end(ij), &
 214                               k_start    , k_end                )
 215
 216     ENDDO !-------------------------------------------------------------
 217     !$OMP END PARALLEL DO
 218
 219     !$OMP PARALLEL DO   &
 220     !$OMP PRIVATE ( ij )
 221     DO ij = grid%num_tiles,1,-1 !----------------------------------------
 222
 223       CALL a_calc_m23( nba_mij(ims,kms,jms,P_m23),a_nba_mij(ims,kms,jms,P_m23),  &
 224                           grid%defor22,grid%a_defor22,                               &
 225                           grid%defor33,grid%a_defor33, grid%defor12,grid%a_defor12,  &
 226                           grid%defor13,grid%a_defor13, grid%defor23,grid%a_defor23,  &
 227                           nba_rij(ims,kms,jms,P_r12),a_nba_rij(ims,kms,jms,P_r12), &
 228                           nba_rij(ims,kms,jms,P_r13),a_nba_rij(ims,kms,jms,P_r13), &
 229                           nba_rij(ims,kms,jms,P_r23),a_nba_rij(ims,kms,jms,P_r23), &
 230                           nba_rij(ims,kms,jms,P_smnsmn),a_nba_rij(ims,kms,jms,P_smnsmn),     &
 231                           grid%tke_2,grid%a_tke_2,                      &
 232                           grid%rdzw,grid%a_rdzw, grid%dx, grid%dy,      &
 233                           grid%fnm, grid%fnp,               &
 234                           config_flags,                     &
 235                           ids, ide, jds, jde, kds, kde,     &
 236                           ims, ime, jms, jme, kms, kme,     &
 237                           ips, ipe, jps, jpe, kps, kpe,     &
 238                           grid%i_start(ij), grid%i_end(ij), &
 239                           grid%j_start(ij), grid%j_end(ij), &
 240                           k_start, k_end                    )
 241
 242     ENDDO !-------------------------------------------------------------
 243     !$OMP END PARALLEL DO
 244
 245     !$OMP PARALLEL DO   &
 246     !$OMP PRIVATE ( ij )
 247     DO ij = 1 , grid%num_tiles !----------------------------------------
 248
 249       CALL a_calc_m13( nba_mij(ims,kms,jms,P_m13),a_nba_mij(ims,kms,jms,P_m13),  &
 250                           grid%defor11,grid%a_defor11,       &
 251                           grid%defor33,grid%a_defor33, grid%defor12,grid%a_defor12,  &
 252                           grid%defor13,grid%a_defor13, grid%defor23,grid%a_defor23,  &
 253                           nba_rij(ims,kms,jms,P_r12),a_nba_rij(ims,kms,jms,P_r12), &
 254                           nba_rij(ims,kms,jms,P_r13),a_nba_rij(ims,kms,jms,P_r13), &
 255                           nba_rij(ims,kms,jms,P_r23),a_nba_rij(ims,kms,jms,P_r23), &
 256                           nba_rij(ims,kms,jms,P_smnsmn),a_nba_rij(ims,kms,jms,P_smnsmn),     &
 257                           grid%tke_2,grid%a_tke_2,                      &
 258                           grid%rdzw,grid%a_rdzw, grid%dx, grid%dy,      &
 259                           grid%fnm, grid%fnp,               &
 260                           config_flags,                     &
 261                           ids, ide, jds, jde, kds, kde,     &
 262                           ims, ime, jms, jme, kms, kme,     &
 263                           ips, ipe, jps, jpe, kps, kpe,     &
 264                           grid%i_start(ij), grid%i_end(ij), &
 265                           grid%j_start(ij), grid%j_end(ij), &
 266                           k_start, k_end                    )
 267
 268     ENDDO !-------------------------------------------------------------
 269     !$OMP END PARALLEL DO
 270
 271     !$OMP PARALLEL DO   &
 272     !$OMP PRIVATE ( ij )
 273     DO ij = grid%num_tiles,1,-1 !----------------------------------------
 274
 275       CALL a_calc_m12( nba_mij(ims,kms,jms,P_m12),a_nba_mij(ims,kms,jms,P_m12),  &
 276                           grid%defor11,grid%a_defor11, grid%defor22,grid%a_defor22,  &
 277                           grid%defor12,grid%a_defor12,       &
 278                           grid%defor13,grid%a_defor13, grid%defor23,grid%a_defor23,  &
 279                           nba_rij(ims,kms,jms,P_r12),a_nba_rij(ims,kms,jms,P_r12), &
 280                           nba_rij(ims,kms,jms,P_r13),a_nba_rij(ims,kms,jms,P_r13), &
 281                           nba_rij(ims,kms,jms,P_r23),a_nba_rij(ims,kms,jms,P_r23), &
 282                           nba_rij(ims,kms,jms,P_smnsmn),a_nba_rij(ims,kms,jms,P_smnsmn),     &
 283                           grid%tke_2,grid%a_tke_2,                      &
 284                           grid%rdzw,grid%a_rdzw, grid%dx, grid%dy,      &
 285                           config_flags,                     &
 286                           ids, ide, jds, jde, kds, kde,     &
 287                           ims, ime, jms, jme, kms, kme,     &
 288                           ips, ipe, jps, jpe, kps, kpe,     &
 289                           grid%i_start(ij), grid%i_end(ij), &
 290                           grid%j_start(ij), grid%j_end(ij), &
 291                           k_start, k_end                    )
 292
 293     ENDDO !-------------------------------------------------------------
 294     !$OMP END PARALLEL DO
 295
 296     !$OMP PARALLEL DO   &
 297     !$OMP PRIVATE ( ij )
 298     DO ij = grid%num_tiles,1,-1 !----------------------------------------
 299
 300       CALL a_calc_mii( nba_mij(ims,kms,jms,P_m11),a_nba_mij(ims,kms,jms,P_m11),  &
 301                           nba_mij(ims,kms,jms,P_m22),a_nba_mij(ims,kms,jms,P_m22), &
 302                           nba_mij(ims,kms,jms,P_m33),a_nba_mij(ims,kms,jms,P_m33), &
 303                           grid%defor11,grid%a_defor11, grid%defor22,grid%a_defor22,  &
 304                           grid%defor33,grid%a_defor33, grid%defor12,grid%a_defor12,  &
 305                           grid%defor13,grid%a_defor13, grid%defor23,grid%a_defor23,  &
 306                           nba_rij(ims,kms,jms,P_r12),a_nba_rij(ims,kms,jms,P_r12), &
 307                           nba_rij(ims,kms,jms,P_r13),a_nba_rij(ims,kms,jms,P_r13), &
 308                           nba_rij(ims,kms,jms,P_r23),a_nba_rij(ims,kms,jms,P_r23), &
 309                           nba_rij(ims,kms,jms,P_smnsmn),a_nba_rij(ims,kms,jms,P_smnsmn),     &
 310                           grid%tke_2,grid%a_tke_2,                      &
 311                           grid%rdzw,grid%a_rdzw, grid%dx, grid%dy,      &
 312                           config_flags,                     &
 313                           ids, ide, jds, jde, kds, kde,     &
 314                           ims, ime, jms, jme, kms, kme,     &
 315                           ips, ipe, jps, jpe, kps, kpe,     &
 316                           grid%i_start(ij), grid%i_end(ij), &
 317                           grid%j_start(ij), grid%j_end(ij), &
 318                           k_start, k_end                    )
 319
 320     ENDDO !-------------------------------------------------------------
 321     !$OMP END PARALLEL DO
 322
 323     !$OMP PARALLEL DO   &
 324     !$OMP PRIVATE ( ij )
 325     DO ij = grid%num_tiles,1,-1 !----------------------------------------
 326
 327         CALL a_set_physical_bc3d( a_nba_rij(ims,kms,jms,P_smnsmn), 'c', &
 328                                 config_flags,                       &
 329                                 ids, ide, jds, jde, kds, kde,       &
 330                                 ims, ime, jms, jme, kms, kme,       &
 331                                 ips, ipe, jps, jpe, kps, kpe,       &
 332                                 grid%i_start(ij), grid%i_end(ij),   &
 333                                 grid%j_start(ij), grid%j_end(ij),   &
 334                                 k_start    , k_end                  )
 335
 336         CALL a_set_physical_bc3d( a_nba_rij(ims,kms,jms,P_r23), 'f',  &
 337                                 config_flags,                     &
 338                                 ids, ide, jds, jde, kds, kde,     &
 339                                 ims, ime, jms, jme, kms, kme,     &
 340                                 ips, ipe, jps, jpe, kps, kpe,     &
 341                                 grid%i_start(ij), grid%i_end(ij), &
 342                                 grid%j_start(ij), grid%j_end(ij), &
 343                                 k_start    , k_end                )
 344
 345         CALL a_set_physical_bc3d( a_nba_rij(ims,kms,jms,P_r13), 'e',  &
 346                                 config_flags,                     &
 347                                 ids, ide, jds, jde, kds, kde,     &
 348                                 ims, ime, jms, jme, kms, kme,     &
 349                                 ips, ipe, jps, jpe, kps, kpe,     &
 350                                 grid%i_start(ij), grid%i_end(ij), &
 351                                 grid%j_start(ij), grid%j_end(ij), &
 352                                 k_start    , k_end                )
 353
 354         CALL a_set_physical_bc3d( a_nba_rij(ims,kms,jms,P_r12), 'd',  &
 355                                 config_flags,                     &
 356                                 ids, ide, jds, jde, kds, kde,     &
 357                                 ims, ime, jms, jme, kms, kme,     &
 358                                 ips, ipe, jps, jpe, kps, kpe,     &
 359                                 grid%i_start(ij), grid%i_end(ij), &
 360                                 grid%j_start(ij), grid%j_end(ij), &
 361                                 k_start    , k_end                )
 362
 363
 364     ENDDO !-------------------------------------------------------------
 365     !$OMP END PARALLEL DO
 366
 367     !$OMP PARALLEL DO   &
 368     !$OMP PRIVATE ( ij )
 369     DO ij = grid%num_tiles,1,-1 !----------------------------------------
 370
 371         CALL a_calc_smnsmn( nba_rij(ims,kms,jms,P_smnsmn),a_nba_rij(ims,kms,jms,P_smnsmn),    &
 372                           grid%defor11,grid%a_defor11, grid%defor22,grid%a_defor22,  &
 373                           grid%defor33,grid%a_defor33, grid%defor12,grid%a_defor12,  &
 374                           grid%defor13,grid%a_defor13, grid%defor23,grid%a_defor23,  &
 375                           config_flags,                     &
 376                           ids, ide, jds, jde, kds, kde,     &
 377                           ims, ime, jms, jme, kms, kme,     &
 378                           ips, ipe, jps, jpe, kps, kpe,     &
 379                           grid%i_start(ij), grid%i_end(ij), &
 380                           grid%j_start(ij), grid%j_end(ij), &
 381                           k_start    , k_end                )
 382
 383     ENDDO !-------------------------------------------------------------
 384     !$OMP END PARALLEL DO
 385
 386   ENDIF !(config_flags%sfs_opt .EQ. 1) .OR. (config_flags%sfs_opt .EQ. 2)
 387
 388 END SUBROUTINE a_sfs_driver
 389
 390 END MODULE a_module_sfs_driver