!WRF:MEDIATION_LAYER:PHYSICS
!==============================================================================
!
! © 2009. Lawrence Livermore National Security, LLC. All rights reserved.
! This work was produced at the Lawrence Livermore National Laboratory (LLNL) under
! contract no. DE-AC52-07NA27344 (Contract 44) between the U.S. Department of Energy (DOE)
! and Lawrence Livermore National Security, LLC (LLNS) for the operation of LLNL. Copyright
! is reserved to Lawrence Livermore National Security, LLC for purposes of controlled
! dissemination, commercialization through formal licensing, or other disposition under
! terms of Contract 44; DOE policies, regulations and orders; and U.S. statutes. The rights
! of the Federal Government are reserved under Contract 44.
!
! DISCLAIMER
! This work was prepared as an account of work sponsored by an agency of the United States
! Government. Neither the United States Government nor Lawrence Livermore National
! Security, LLC nor any of their employees, makes any warranty, express or implied, or
! assumes any liability or responsibility for the accuracy, completeness, or usefulness of
! any information, apparatus, product, or process disclosed, or represents that its use
! would not infringe privately-owned rights. Reference herein to any specific commercial
! products, process, or service by trade name, trademark, manufacturer or otherwise does
! not necessarily constitute or imply its endorsement, recommendation, or favoring by the
! United States Government or Lawrence Livermore National Security, LLC. The views and
! opinions of authors expressed herein do not necessarily state or reflect those of the
! United States Government or Lawrence Livermore National Security, LLC, and shall not be
! used for advertising or product endorsement purposes.
!
! LICENSING REQUIREMENTS
! Any use, reproduction, modification, or distribution of this software or documentation
! for commercial purposes requires a license from Lawrence Livermore National Security,
! LLC. Contact: Lawrence Livermore National Laboratory, Industrial Partnerships Office,
! P.O. Box 808, L-795, Livermore, CA 94551
!
!=============================================================================
!
! Modification History:
!
! Implemented 12/2009 by Jeff Mirocha, jmirocha@llnl.gov
!
!=============================================================================
MODULE module_sfs_driver 1
CONTAINS
!=============================================================================
SUBROUTINE sfs_driver( grid, config_flags, & 1,27
nba_mij, n_nba_mij, &
nba_rij, n_nba_rij )
!-----------------------------------------------------------------------------
!
! PURPOSE: Calls turbulence subfilter stress model subroutines and handles
! all MPI and OMP operations
!
!-----------------------------------------------------------------------------
! Driver layer modules
USE module_domain
USE module_model_constants
USE module_configure
USE module_tiles
USE module_machine
USE module_state_description
! Model layer modules
USE module_bc
!! *** add new modules of schemes here
USE module_sfs_nba
#ifdef DM_PARALLEL
USE module_dm
USE module_comm_dm, ONLY : &
HALO_EM_NBA_RIJ_sub &
,PERIOD_EM_NBA_RIJ_sub &
,HALO_EM_NBA_MIJ_sub &
,PERIOD_EM_NBA_MIJ_sub
#endif
IMPLICIT NONE
! Input data.
TYPE(domain) , TARGET :: grid
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
INTEGER, INTENT( IN ) :: n_nba_mij, n_nba_rij
REAL ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,n_nba_mij) &
:: nba_mij
REAL ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,n_nba_rij) &
:: nba_rij
! Local data
INTEGER :: k_start , k_end, its, ite, jts, jte
INTEGER :: ids , ide , jds , jde , kds , kde , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe
INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, &
ipsx, ipex, jpsx, jpex, kpsx, kpex, &
imsy, imey, jmsy, jmey, kmsy, kmey, &
ipsy, ipey, jpsy, jpey, kpsy, kpey
INTEGER :: ij, i, j, k
CALL get_ijk_from_grid ( grid , &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
imsx, imex, jmsx, jmex, kmsx, kmex, &
ipsx, ipex, jpsx, jpex, kpsx, kpex, &
imsy, imey, jmsy, jmey, kmsy, kmey, &
ipsy, ipey, jpsy, jpey, kpsy, kpey )
k_start = kps
k_end = kpe
! Compute these starting and stopping locations for each tile and number of tiles.
! See: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles
! Solve_em has already called this, so should not be necessary to reset tiles here
CALL set_tiles ( ZONE_SFS, grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
IF ( (config_flags%sfs_opt .EQ. 1) .OR. (config_flags%sfs_opt .EQ. 2) ) THEN
!=======================================================================
!
! BEGIN NBA
!
!=======================================================================
! IF ( grid%itimestep .EQ. 1 ) THEN
!
! IF ( (config_flags%sfs_opt .EQ. 2) .AND. (config_flags%km_opt .NE. 2)) THEN
!
! CALL wrf_error_fatal( 'Must use km_opt=2 with sfs_opt=2' )
!
! ENDIF
!
! ENDIF
!_______________________________________________________________________
!
! Compute NBA model constants
!_______________________________________________________________________
!$OMP PARALLEL DO &
!$OMP PRIVATE ( ij )
DO ij = 1 , grid%num_tiles !----------------------------------------
CALL calc_mij_constants( )
ENDDO !-------------------------------------------------------------
!$OMP END PARALLEL DO
!_______________________________________________________________________
!
! Compute Smn*Smn
!_______________________________________________________________________
!$OMP PARALLEL DO &
!$OMP PRIVATE ( ij )
DO ij = 1 , grid%num_tiles !----------------------------------------
CALL calc_smnsmn( nba_rij(ims,kms,jms,P_smnsmn), &
grid%defor11, grid%defor22, &
grid%defor33, grid%defor12, &
grid%defor13, grid%defor23, &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start , k_end )
ENDDO !-------------------------------------------------------------
!$OMP END PARALLEL DO
!_______________________________________________________________________
!
! Update halos for R12, R13, R23 and smnsmn
!_______________________________________________________________________
#ifdef DM_PARALLEL
# include "HALO_EM_NBA_RIJ.inc"
# include "PERIOD_EM_NBA_RIJ.inc"
#endif
!$OMP PARALLEL DO &
!$OMP PRIVATE ( ij )
DO ij = 1 , grid%num_tiles !----------------------------------------
CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_r12), 'd', &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start , k_end )
CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_r13), 'e', &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start , k_end )
CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_r23), 'f', &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start , k_end )
CALL set_physical_bc3d( nba_rij(ims,kms,jms,P_smnsmn), 'c', &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start , k_end )
ENDDO !-------------------------------------------------------------
!$OMP END PARALLEL DO
!_______________________________________________________________________
!
! Calculate M11, M22 and M33
!_______________________________________________________________________
!$OMP PARALLEL DO &
!$OMP PRIVATE ( ij )
DO ij = 1 , grid%num_tiles !----------------------------------------
CALL calc_mii( nba_mij(ims,kms,jms,P_m11), &
nba_mij(ims,kms,jms,P_m22), &
nba_mij(ims,kms,jms,P_m33), &
grid%defor11, grid%defor22, &
grid%defor33, grid%defor12, &
grid%defor13, grid%defor23, &
nba_rij(ims,kms,jms,P_r12), &
nba_rij(ims,kms,jms,P_r13), &
nba_rij(ims,kms,jms,P_r23), &
nba_rij(ims,kms,jms,P_smnsmn), &
grid%tke_2, &
grid%rdzw, grid%dx, grid%dy, &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start, k_end )
ENDDO !-------------------------------------------------------------
!$OMP END PARALLEL DO
!_______________________________________________________________________
!
! Calculate M12
!_______________________________________________________________________
!$OMP PARALLEL DO &
!$OMP PRIVATE ( ij )
DO ij = 1 , grid%num_tiles !----------------------------------------
CALL calc_m12( nba_mij(ims,kms,jms,P_m12), &
grid%defor11, grid%defor22, &
grid%defor12, grid%defor13, &
grid%defor23, &
nba_rij(ims,kms,jms,P_r12), &
nba_rij(ims,kms,jms,P_r13), &
nba_rij(ims,kms,jms,P_r23), &
nba_rij(ims,kms,jms,P_smnsmn), &
grid%tke_2, &
grid%rdzw, grid%dx, grid%dy, &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start, k_end )
ENDDO !-------------------------------------------------------------
!$OMP END PARALLEL DO
!_______________________________________________________________________
!
! Calculate M13
!_______________________________________________________________________
!$OMP PARALLEL DO &
!$OMP PRIVATE ( ij )
DO ij = 1 , grid%num_tiles !----------------------------------------
CALL calc_m13( nba_mij(ims,kms,jms,P_m13), &
grid%defor11, grid%defor33, &
grid%defor12, grid%defor13, &
grid%defor23, &
nba_rij(ims,kms,jms,P_r12), &
nba_rij(ims,kms,jms,P_r13), &
nba_rij(ims,kms,jms,P_r23), &
nba_rij(ims,kms,jms,P_smnsmn), &
grid%tke_2, &
grid%rdzw, grid%dx, grid%dy, &
grid%fnm, grid%fnp, &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start, k_end )
ENDDO !-------------------------------------------------------------
!$OMP END PARALLEL DO
!_______________________________________________________________________
!
! Calculate M23
!_______________________________________________________________________
!$OMP PARALLEL DO &
!$OMP PRIVATE ( ij )
DO ij = 1 , grid%num_tiles !----------------------------------------
CALL calc_m23( nba_mij(ims,kms,jms,P_m23), &
grid%defor22, grid%defor33, &
grid%defor12, grid%defor13, &
grid%defor23, &
nba_rij(ims,kms,jms,P_r12), &
nba_rij(ims,kms,jms,P_r13), &
nba_rij(ims,kms,jms,P_r23), &
nba_rij(ims,kms,jms,P_smnsmn), &
grid%tke_2, &
grid%rdzw, grid%dx, grid%dy, &
grid%fnm, grid%fnp, &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start, k_end )
ENDDO !-------------------------------------------------------------
!$OMP END PARALLEL DO
!_______________________________________________________________________
!
! Update boundary conditions and halos after calculating Mij
!_______________________________________________________________________
#ifdef DM_PARALLEL
# include "HALO_EM_NBA_MIJ.inc"
# include "PERIOD_EM_NBA_MIJ.inc"
#endif
!$OMP PARALLEL DO &
!$OMP PRIVATE ( ij )
DO ij = 1 , grid%num_tiles !----------------------------------------
CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m11), 'p', &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start , k_end )
CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m22), 'p', &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start , k_end )
CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m33), 'p', &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start , k_end )
CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m12), 'd', &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start , k_end )
CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m13), 'e', &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start , k_end )
CALL set_physical_bc3d( nba_mij(ims,kms,jms,P_m23), 'f', &
config_flags, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), &
k_start , k_end )
ENDDO !-------------------------------------------------------------
!$OMP END PARALLEL DO
!=======================================================================
!
! END NBA
!
!=======================================================================
ENDIF !(config_flags%sfs_opt .EQ. 1) .OR. (config_flags%sfs_opt .EQ. 2)
END SUBROUTINE sfs_driver
END MODULE module_sfs_driver