dyn_em/module_sfs_driver.F

   1 !WRF:MEDIATION_LAYER:PHYSICS
   2
   3 !==============================================================================
   4 !
   5 ! Copyright 2009. Lawrence Livermore National Security, LLC. All rights reserved.
   6 ! This work was produced at the Lawrence Livermore National Laboratory (LLNL) under
   7 ! contract no. DE-AC52-07NA27344 (Contract 44) between the U.S. Department of Energy (DOE)
   8 ! and Lawrence Livermore National Security, LLC (LLNS) for the operation of LLNL. Copyright
   9 ! is reserved to Lawrence Livermore National Security, LLC for purposes of controlled
  10 ! dissemination, commercialization through formal licensing, or other disposition under
  11 ! terms of Contract 44; DOE policies, regulations and orders; and U.S. statutes. The rights
  12 ! of the Federal Government are reserved under Contract 44.
  13 !
  14 ! DISCLAIMER
  15 ! This work was prepared as an account of work sponsored by an agency of the United States
  16 ! Government. Neither the United States Government nor Lawrence Livermore National
  17 ! Security, LLC nor any of their employees, makes any warranty, express or implied, or
  18 ! assumes any liability or responsibility for the accuracy, completeness, or usefulness of
  19 ! any information, apparatus, product, or process disclosed, or represents that its use
  20 ! would not infringe privately-owned rights. Reference herein to any specific commercial
  21 ! products, process, or service by trade name, trademark, manufacturer or otherwise does
  22 ! not necessarily constitute or imply its endorsement, recommendation, or favoring by the
  23 ! United States Government or Lawrence Livermore National Security, LLC. The views and
  24 ! opinions of authors expressed herein do not necessarily state or reflect those of the
  25 ! United States Government or Lawrence Livermore National Security, LLC, and shall not be
  26 ! used for advertising or product endorsement purposes.
  27 !
  28 ! LICENSING REQUIREMENTS
  29 ! Any use, reproduction, modification, or distribution of this software or documentation
  30 ! for commercial purposes requires a license from Lawrence Livermore National Security,
  31 ! LLC. Contact: Lawrence Livermore National Laboratory, Industrial Partnerships Office,
  32 ! P.O. Box 808, L-795, Livermore, CA 94551
  33 !
  34 !=============================================================================
  35 !
  36 ! Modification History:
  37 !
  38 ! Implemented 12/2009 by Jeff Mirocha, jmirocha@llnl.gov
  39 !
  40 !=============================================================================
  41
  42 MODULE module_sfs_driver
  43
  44 CONTAINS
  45
  46 !=============================================================================
  47
  48 SUBROUTINE sfs_driver( grid, config_flags, &
  49                        nba_mij, n_nba_mij, &
  50                        nba_rij, n_nba_rij  )
  51
  52 !-----------------------------------------------------------------------------
  53 !
  54 ! PURPOSE: Calls turbulence subfilter stress model subroutines and handles
  55 !          all MPI and OMP operations
  56 !
  57 !-----------------------------------------------------------------------------
  58
  59
  60 ! Driver layer modules
  61   USE module_domain
  62   USE module_model_constants
  63   USE module_configure
  64   USE module_tiles
  65   USE module_machine
  66   USE module_state_description
  67 ! Model layer modules
  68   USE module_bc
  69
  70 !! *** add new modules of schemes here
  71
  72   USE module_sfs_nba
  73 #ifdef DM_PARALLEL
  74    USE module_dm
  75    USE module_comm_dm, ONLY : &
  76                            HALO_EM_NBA_RIJ_sub   &
  77                           ,PERIOD_EM_NBA_RIJ_sub   &
  78                           ,HALO_EM_NBA_MIJ_sub   &
  79                           ,PERIOD_EM_NBA_MIJ_sub
  80 #endif
  81
  82   IMPLICIT NONE
  83
  84 ! Input data.
  85
  86   TYPE(domain) , TARGET          :: grid
  87
  88   TYPE (grid_config_rec_type) , INTENT(IN)          :: config_flags
  89
  90   INTEGER, INTENT(  IN ) :: n_nba_mij, n_nba_rij
  91
  92   REAL ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,n_nba_mij) &
  93   :: nba_mij
  94
  95   REAL ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,n_nba_rij) &
  96   :: nba_rij
  97
  98 ! Local data
  99
 100   INTEGER :: k_start , k_end, its, ite, jts, jte
 101   INTEGER :: ids , ide , jds , jde , kds , kde , &
 102              ims , ime , jms , jme , kms , kme , &
 103              ips , ipe , jps , jpe , kps , kpe
 104
 105   INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, &
 106              ipsx, ipex, jpsx, jpex, kpsx, kpex, &
 107              imsy, imey, jmsy, jmey, kmsy, kmey, &
 108              ipsy, ipey, jpsy, jpey, kpsy, kpey
 109
 110   INTEGER :: ij, i, j, k
 111
 112   CALL get_ijk_from_grid ( grid ,                              &
 113                            ids, ide, jds, jde, kds, kde,       &
 114                            ims, ime, jms, jme, kms, kme,       &
 115                            ips, ipe, jps, jpe, kps, kpe,       &
 116                            imsx, imex, jmsx, jmex, kmsx, kmex, &
 117                            ipsx, ipex, jpsx, jpex, kpsx, kpex, &
 118                            imsy, imey, jmsy, jmey, kmsy, kmey, &
 119                            ipsy, ipey, jpsy, jpey, kpsy, kpey  )
 120
 121   k_start         = kps
 122   k_end           = kpe
 123
 124 ! Compute these starting and stopping locations for each tile and number of tiles.
 125 ! See: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles
 126
 127 ! Solve_em has already called this, so should not be necessary to reset tiles here
 128   CALL set_tiles ( ZONE_SFS, grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
 129
 130   IF ( (config_flags%sfs_opt .EQ. 1) .OR. (config_flags%sfs_opt .EQ. 2) ) THEN
 131
 132 !=======================================================================
 133 !
 134 !                                BEGIN NBA
 135 !
 136 !=======================================================================
 137
 138 !  IF ( grid%itimestep .EQ. 1 ) THEN
 139 !
 140 !    IF ( (config_flags%sfs_opt .EQ. 2) .AND. (config_flags%km_opt .NE. 2)) THEN
 141 !
 142 !    CALL wrf_error_fatal( 'Must use km_opt=2 with sfs_opt=2' )
 143 !
 144 !    ENDIF
 145 !
 146 !  ENDIF
 147
 148 !_______________________________________________________________________
 149 !
 150 ! Compute NBA model constants
 151 !_______________________________________________________________________
 152
 153
 154     !$OMP PARALLEL DO   &
 155     !$OMP PRIVATE ( ij )
 156     DO ij = 1 , grid%num_tiles !----------------------------------------
 157
 158         CALL calc_mij_constants( )
 159
 160     ENDDO !-------------------------------------------------------------
 161     !$OMP END PARALLEL DO
 162
 163 !_______________________________________________________________________
 164 !
 165 ! Compute Smn*Smn
 166 !_______________________________________________________________________
 167
 168     !$OMP PARALLEL DO   &
 169     !$OMP PRIVATE ( ij )
 170     DO ij = 1 , grid%num_tiles !----------------------------------------
 171
 172         CALL calc_smnsmn( nba_rij(ims,kms,jms,P_smnsmn),    &
 173                           grid%defor11, grid%defor22,       &
 174                           grid%defor33, grid%defor12,       &
 175                           grid%defor13, grid%defor23,       &
 176                           config_flags,                     &
 177                           ids, ide, jds, jde, kds, kde,     &
 178                           ims, ime, jms, jme, kms, kme,     &
 179                           ips, ipe, jps, jpe, kps, kpe,     &
 180                           grid%i_start(ij), grid%i_end(ij), &
 181                           grid%j_start(ij), grid%j_end(ij), &
 182                           k_start    , k_end                )
 183
 184     ENDDO !-------------------------------------------------------------
 185     !$OMP END PARALLEL DO
 186
 187 !_______________________________________________________________________
 188 !
 189 ! Update halos for R12, R13, R23 and smnsmn
 190 !_______________________________________________________________________
 191
 192 #ifdef DM_PARALLEL
 193 #      include "HALO_EM_NBA_RIJ.inc"
 194 #      include "PERIOD_EM_NBA_RIJ.inc"
 195 #endif
 196
 197     !$OMP PARALLEL DO   &
 198     !$OMP PRIVATE ( ij )
 199     DO ij = 1 , grid%num_tiles !----------------------------------------
 200
 201         CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_r12), 'd',  &
 202                                 config_flags,                     &
 203                                 ids, ide, jds, jde, kds, kde,     &
 204                                 ims, ime, jms, jme, kms, kme,     &
 205                                 ips, ipe, jps, jpe, kps, kpe,     &
 206                                 grid%i_start(ij), grid%i_end(ij), &
 207                                 grid%j_start(ij), grid%j_end(ij), &
 208                                 k_start    , k_end                )
 209
 210
 211         CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_r13), 'e',  &
 212                                 config_flags,                     &
 213                                 ids, ide, jds, jde, kds, kde,     &
 214                                 ims, ime, jms, jme, kms, kme,     &
 215                                 ips, ipe, jps, jpe, kps, kpe,     &
 216                                 grid%i_start(ij), grid%i_end(ij), &
 217                                 grid%j_start(ij), grid%j_end(ij), &
 218                                 k_start    , k_end                )
 219
 220         CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_r23), 'f',  &
 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         CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_smnsmn), 'c', &
 230                                 config_flags,                       &
 231                                 ids, ide, jds, jde, kds, kde,       &
 232                                 ims, ime, jms, jme, kms, kme,       &
 233                                 ips, ipe, jps, jpe, kps, kpe,       &
 234                                 grid%i_start(ij), grid%i_end(ij),   &
 235                                 grid%j_start(ij), grid%j_end(ij),   &
 236                                 k_start    , k_end                  )
 237
 238     ENDDO !-------------------------------------------------------------
 239     !$OMP END PARALLEL DO
 240
 241 !_______________________________________________________________________
 242 !
 243 ! Calculate M11, M22 and M33
 244 !_______________________________________________________________________
 245
 246     !$OMP PARALLEL DO   &
 247     !$OMP PRIVATE ( ij )
 248     DO ij = 1 , grid%num_tiles !----------------------------------------
 249
 250       CALL calc_mii( nba_mij(ims,kms,jms,P_m11),       &
 251                      nba_mij(ims,kms,jms,P_m22),       &
 252                      nba_mij(ims,kms,jms,P_m33),       &
 253                      grid%defor11, grid%defor22,       &
 254                      grid%defor33, grid%defor12,       &
 255                      grid%defor13, grid%defor23,       &
 256                      nba_rij(ims,kms,jms,P_r12),       &
 257                      nba_rij(ims,kms,jms,P_r13),       &
 258                      nba_rij(ims,kms,jms,P_r23),       &
 259                      nba_rij(ims,kms,jms,P_smnsmn),    &
 260                      grid%tke_2,                       &
 261                      grid%rdzw, grid%dx, grid%dy,      &
 262                      config_flags,                     &
 263                      ids, ide, jds, jde, kds, kde,     &
 264                      ims, ime, jms, jme, kms, kme,     &
 265                      ips, ipe, jps, jpe, kps, kpe,     &
 266                      grid%i_start(ij), grid%i_end(ij), &
 267                      grid%j_start(ij), grid%j_end(ij), &
 268                      k_start, k_end                    )
 269
 270     ENDDO !-------------------------------------------------------------
 271     !$OMP END PARALLEL DO
 272
 273 !_______________________________________________________________________
 274 !
 275 ! Calculate M12
 276 !_______________________________________________________________________
 277
 278     !$OMP PARALLEL DO   &
 279     !$OMP PRIVATE ( ij )
 280     DO ij = 1 , grid%num_tiles !----------------------------------------
 281
 282       CALL calc_m12( nba_mij(ims,kms,jms,P_m12),       &
 283                      grid%defor11, grid%defor22,       &
 284                      grid%defor12, grid%defor13,       &
 285                      grid%defor23,                     &
 286                      nba_rij(ims,kms,jms,P_r12),       &
 287                      nba_rij(ims,kms,jms,P_r13),       &
 288                      nba_rij(ims,kms,jms,P_r23),       &
 289                      nba_rij(ims,kms,jms,P_smnsmn),    &
 290                      grid%tke_2,                       &
 291                      grid%rdzw, grid%dx, grid%dy,      &
 292                      config_flags,                     &
 293                      ids, ide, jds, jde, kds, kde,     &
 294                      ims, ime, jms, jme, kms, kme,     &
 295                      ips, ipe, jps, jpe, kps, kpe,     &
 296                      grid%i_start(ij), grid%i_end(ij), &
 297                      grid%j_start(ij), grid%j_end(ij), &
 298                      k_start, k_end                    )
 299
 300     ENDDO !-------------------------------------------------------------
 301     !$OMP END PARALLEL DO
 302
 303 !_______________________________________________________________________
 304 !
 305 ! Calculate M13
 306 !_______________________________________________________________________
 307
 308     !$OMP PARALLEL DO   &
 309     !$OMP PRIVATE ( ij )
 310     DO ij = 1 , grid%num_tiles !----------------------------------------
 311
 312       CALL calc_m13( nba_mij(ims,kms,jms,P_m13),       &
 313                      grid%defor11, grid%defor33,       &
 314                      grid%defor12, grid%defor13,       &
 315                      grid%defor23,                     &
 316                      nba_rij(ims,kms,jms,P_r12),       &
 317                      nba_rij(ims,kms,jms,P_r13),       &
 318                      nba_rij(ims,kms,jms,P_r23),       &
 319                      nba_rij(ims,kms,jms,P_smnsmn),    &
 320                      grid%tke_2,                       &
 321                      grid%rdzw, grid%dx, grid%dy,      &
 322                      grid%fnm, grid%fnp,               &
 323                      config_flags,                     &
 324                      ids, ide, jds, jde, kds, kde,     &
 325                      ims, ime, jms, jme, kms, kme,     &
 326                      ips, ipe, jps, jpe, kps, kpe,     &
 327                      grid%i_start(ij), grid%i_end(ij), &
 328                      grid%j_start(ij), grid%j_end(ij), &
 329                      k_start, k_end                    )
 330
 331     ENDDO !-------------------------------------------------------------
 332     !$OMP END PARALLEL DO
 333 !_______________________________________________________________________
 334 !
 335 ! Calculate M23
 336 !_______________________________________________________________________
 337
 338     !$OMP PARALLEL DO   &
 339     !$OMP PRIVATE ( ij )
 340     DO ij = 1 , grid%num_tiles !----------------------------------------
 341
 342       CALL calc_m23( nba_mij(ims,kms,jms,P_m23),       &
 343                      grid%defor22, grid%defor33,       &
 344                      grid%defor12, grid%defor13,       &
 345                      grid%defor23,                     &
 346                      nba_rij(ims,kms,jms,P_r12),       &
 347                      nba_rij(ims,kms,jms,P_r13),       &
 348                      nba_rij(ims,kms,jms,P_r23),       &
 349                      nba_rij(ims,kms,jms,P_smnsmn),    &
 350                      grid%tke_2,                       &
 351                      grid%rdzw, grid%dx, grid%dy,      &
 352                      grid%fnm, grid%fnp,               &
 353                      config_flags,                     &
 354                      ids, ide, jds, jde, kds, kde,     &
 355                      ims, ime, jms, jme, kms, kme,     &
 356                      ips, ipe, jps, jpe, kps, kpe,     &
 357                      grid%i_start(ij), grid%i_end(ij), &
 358                      grid%j_start(ij), grid%j_end(ij), &
 359                      k_start, k_end                    )
 360
 361     ENDDO !-------------------------------------------------------------
 362     !$OMP END PARALLEL DO
 363 !_______________________________________________________________________
 364 !
 365 ! Update boundary conditions and halos after calculating Mij
 366 !_______________________________________________________________________
 367
 368 #ifdef DM_PARALLEL
 369 #      include "HALO_EM_NBA_MIJ.inc"
 370 #      include "PERIOD_EM_NBA_MIJ.inc"
 371 #endif
 372
 373     !$OMP PARALLEL DO   &
 374     !$OMP PRIVATE ( ij )
 375     DO ij = 1 , grid%num_tiles !----------------------------------------
 376
 377       CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m11), 'p',    &
 378                               config_flags,                     &
 379                               ids, ide, jds, jde, kds, kde,     &
 380                               ims, ime, jms, jme, kms, kme,     &
 381                               ips, ipe, jps, jpe, kps, kpe,     &
 382                               grid%i_start(ij), grid%i_end(ij), &
 383                               grid%j_start(ij), grid%j_end(ij), &
 384                               k_start    , k_end                )
 385
 386       CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m22), 'p',    &
 387                               config_flags,                     &
 388                               ids, ide, jds, jde, kds, kde,     &
 389                               ims, ime, jms, jme, kms, kme,     &
 390                               ips, ipe, jps, jpe, kps, kpe,     &
 391                               grid%i_start(ij), grid%i_end(ij), &
 392                               grid%j_start(ij), grid%j_end(ij), &
 393                               k_start    , k_end                )
 394
 395       CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m33), 'p',    &
 396                               config_flags,                     &
 397                               ids, ide, jds, jde, kds, kde,     &
 398                               ims, ime, jms, jme, kms, kme,     &
 399                               ips, ipe, jps, jpe, kps, kpe,     &
 400                               grid%i_start(ij), grid%i_end(ij), &
 401                               grid%j_start(ij), grid%j_end(ij), &
 402                               k_start    , k_end                )
 403
 404       CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m12), 'd',    &
 405                               config_flags,                     &
 406                               ids, ide, jds, jde, kds, kde,     &
 407                               ims, ime, jms, jme, kms, kme,     &
 408                               ips, ipe, jps, jpe, kps, kpe,     &
 409                               grid%i_start(ij), grid%i_end(ij), &
 410                               grid%j_start(ij), grid%j_end(ij), &
 411                               k_start    , k_end                )
 412
 413       CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m13), 'e',    &
 414                               config_flags,                     &
 415                               ids, ide, jds, jde, kds, kde,     &
 416                               ims, ime, jms, jme, kms, kme,     &
 417                               ips, ipe, jps, jpe, kps, kpe,     &
 418                               grid%i_start(ij), grid%i_end(ij), &
 419                               grid%j_start(ij), grid%j_end(ij), &
 420                               k_start    , k_end                )
 421
 422       CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m23), 'f',    &
 423                               config_flags,                     &
 424                               ids, ide, jds, jde, kds, kde,     &
 425                               ims, ime, jms, jme, kms, kme,     &
 426                               ips, ipe, jps, jpe, kps, kpe,     &
 427                               grid%i_start(ij), grid%i_end(ij), &
 428                               grid%j_start(ij), grid%j_end(ij), &
 429                               k_start    , k_end                )
 430
 431     ENDDO !-------------------------------------------------------------
 432     !$OMP END PARALLEL DO
 433
 434 !=======================================================================
 435 !
 436 !                                END NBA
 437 !
 438 !=======================================================================
 439
 440   ENDIF !(config_flags%sfs_opt .EQ. 1) .OR. (config_flags%sfs_opt .EQ. 2)
 441
 442 END SUBROUTINE sfs_driver
 443
 444 END MODULE module_sfs_driver