!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

CONTAINS

!=============================================================================

SUBROUTINE sfs_driver( grid, config_flags, &
                       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
