mod_wd.f90

Go to the documentation of this file.

!/===========================================================================/
! Copyright (c) 2007, The University of Massachusetts Dartmouth 
! Produced at the School of Marine Science & Technology 
! Marine Ecosystem Dynamics Modeling group
! All rights reserved.
!
! FVCOM has been developed by the joint UMASSD-WHOI research team. For 
! details of authorship and attribution of credit please see the FVCOM
! technical manual or contact the MEDM group.
!
! 
! This file is part of FVCOM. For details, see http://fvcom.smast.umassd.edu 
! The full copyright notice is contained in the file COPYRIGHT located in the 
! root directory of the FVCOM code. This original header must be maintained
! in all distributed versions.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
! AND ANY EXPRESS OR  IMPLIED WARRANTIES, INCLUDING,  BUT NOT  LIMITED TO,
! THE IMPLIED WARRANTIES OF MERCHANTABILITY AND  FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED.  
!
!/---------------------------------------------------------------------------/
! CVS VERSION INFORMATION
! $Id$
! $Name$
! $Revision$
!/===========================================================================/

MODULE mod_wd

   USE mod_prec
   IMPLICIT NONE
   SAVE
!
!--Parameters for Wet/Dry Treatment                 
!

!-----variables controlling porosities through wet/dry determination----------------!
   
   INTEGER , ALLOCATABLE :: iswetn(:)           !!NODE POROSITY AT NODES FOR TIME N
   INTEGER , ALLOCATABLE :: iswetc(:)           !!CELL POROSITY AT CELLS FOR TIME N
   INTEGER , ALLOCATABLE :: iswetnt(:)          !!NODE POROSITY AT NODES FOR TIME N-1 INTERNAL
   INTEGER , ALLOCATABLE :: iswetct(:)          !!CELL POROSITY AT CELLS FOR TIME N-1 INTERNAL
   INTEGER , ALLOCATABLE :: iswetce(:)          !!CELL POROSITY AT CELLS FOR TIME N-1 EXTERNAL

!!   REAL(SP), ALLOCATABLE :: UAS(:)          !!VERT-AVGD X-VELOC USED FOR MASS CONS IN FLOODING/DRYING PROCESS
!!   REAL(SP), ALLOCATABLE :: VAS(:)          !!VERT-AVGD Y-VELOC USED FOR MASS CONS IN FLOODING/DRYING PROCESS
!!   REAL(SP), ALLOCATABLE :: UARDS(:)        !!UA AVGD OVER EXT INT FOR MASS CONS IN FLOODING/DRYING PROCESS
!!   REAL(SP), ALLOCATABLE :: VARDS(:)        !!VA AVGD OVER EXT INT FOR MASS CONS IN FLOODING/DRYING PROCESS
!!   REAL(SP), ALLOCATABLE :: US(:,:)         !!X-VELOCITY FOR MASS CONS IN FLOODING/DRYING PROCESS
!!   REAL(SP), ALLOCATABLE :: VS(:,:)         !!Y-VELOCITY FOR MASS CONS IN FLOODING/DRYING PROCESS

   CONTAINS !------------------------------------------------------------------!
            ! ALLOC_WD_DATA       :   ALLOCATE AND INITIALIZE WET/DRY ARRAYS   !
            ! SET_WD_DATA         :   SET VALUES IN WET/DRY ARRAYS             !
            ! WET_JUDGE           :   DETERMINE IF NODES/ELEMENTS ARE WET/DRY  ! 
            ! WD_UPDATE           :   SWAP WET/DRY VARIABLES BETWEEN TIME LEVS ! 
            ! WD_DUMP             :   DUMP WET/DRY FLAGS FOR RESTART           !
            ! WD_READ             :   READ WET/DRY FLAGS FOR RESTART           !
            ! -----------------------------------------------------------------!

!==============================================================================|
!==============================================================================|

!!$   SUBROUTINE SETUP_WETDRY 
!!$!------------------------------------------------------------------------------|
!!$!  READ IN PARAMETERS CONTROLLING WET/DRY TREATMENT                            |
!!$!------------------------------------------------------------------------------|
!!$   IMPLICIT NONE
!!$   INTEGER  :: ISCAN
!!$   CHARACTER(LEN=120) :: FNAME
!!$
!!$   ! NO PARAMETERS NECISARRY FOR WET DRY?
!!$        ONLY MAKE FILE OPTIONS
!!$!------------------------------------------------------------------------------|
!!$!   READ IN VARIABLES AND SET VALUES                                           |
!!$!------------------------------------------------------------------------------|
!!$ END SUBROUTINE SETUP_WETDRY


!==============================================================================|
!==============================================================================|
   SUBROUTINE set_wd_data 
!------------------------------------------------------------------------------|
!  INITIALIZE ARRAYS USED FOR WET/DRY TREATMENT                                |
!------------------------------------------------------------------------------|

   USE all_vars
   USE mod_par
   IMPLICIT NONE
   INTEGER :: I

   IF (dbg_set(dbg_sbr)) WRITE(ipt,*) "START: SET_WD_DATA"

   IF(startup_type == startup_type_coldstart) THEN

!-------- SET WET/DRY FLAGS AND MODIFY WATER SURFACE ELEVATION-----------------!

     CALL wet_judge

!-------- EXCHANGE MODIFIED FREE SURFACE ELEVATION ACROSS PROCESSOR BOUNDS-----!


!-------- TRANSFER ELEVATION FIELD TO DEPTH AND OLD TIME LEVELS----------------!
     el1 = elf1
     d1  = h1 + el1
     el = elf
     et = el
     d  = el + h
     dt = d
     dtfa = d
     et1 = el1
     dt1 = d1


   END IF 

   IF (dbg_set(dbg_sbr)) WRITE(ipt,*) "END: SET_WD_DATA"
   RETURN
   END SUBROUTINE set_wd_data

!==============================================================================|
!==============================================================================|

   SUBROUTINE alloc_wd_data  

!------------------------------------------------------------------------------|
!  ALLOCATE AND INITIALIZE WET/DRY TREATMENT ARRAYS                            |
!------------------------------------------------------------------------------|

   USE mod_prec
   USE all_vars
   USE mod_par
   IMPLICIT NONE
   INTEGER NCT,NDB

   IF (dbg_set(dbg_sbr)) WRITE(ipt,*) "START: ALLOC_WD_DATA"

   ndb = 1       !!GWC BASE THIS ON KIND

!-----variables controlling porosities through wet/dry determination----------------!
                                                                                                                          
   ALLOCATE(iswetn(0:mt))        ; iswetn     = 1
   ALLOCATE(iswetc(0:nt))        ; iswetc     = 1
   ALLOCATE(iswetnt(0:mt))       ; iswetnt    = 1
   ALLOCATE(iswetct(0:nt))       ; iswetct    = 1
   ALLOCATE(iswetce(0:nt))       ; iswetce    = 1

   memcnt = memcnt + 3*nt + 2*mt

!!   ALLOCATE(US(0:NT,KB))         ;US    = ZERO   !!X-VELOCITY FOR MASS CONSERVATION
!!   ALLOCATE(VS(0:NT,KB))         ;VS    = ZERO   !!Y-VELOCITY FOR MASS CONSERVATION

!!   ALLOCATE(UAS(0:NT))           ;UAS       = ZERO  !!VERT AVGD X-VELOC FOR MASS CONSERVATION
!!   ALLOCATE(VAS(0:NT))           ;VAS       = ZERO  !!VERT AVGD Y-VELOC FOR MASS CONSERVATION
!!   ALLOCATE(UARDS(0:NT))         ;UARDS     = ZERO  !!UA AVGD OVER EXTERNAL INT FOR MASS CONSERVATION
!!   ALLOCATE(VARDS(0:NT))         ;VARDS     = ZERO  !!VA AVGD OVER EXTERNAL INT FOR MASS CONSERVATION

!!   memcnt = memcnt + KB*NT*NDB + KB*MT*NDB +NT*4*NDB

   IF (dbg_set(dbg_sbr)) WRITE(ipt,*) "END: ALLOC_WD_DATA"
   RETURN
   END SUBROUTINE alloc_wd_data

!==============================================================================|
!==============================================================================|

   SUBROUTINE wet_judge

!------------------------------------------------------------------------------|
!  DETERMINE IF NODES/ELEMENTS ARE WET OR DRY                                  |
!------------------------------------------------------------------------------|

   USE mod_prec
   USE all_vars
   USE mod_par
   IMPLICIT NONE
   REAL(SP) :: DTMP
   INTEGER  :: ITA_TEMP
   INTEGER  :: I,IL,IA,IB,K1,K2,K3,K4,K5,K6

   integer :: KT

   IF (dbg_set(dbg_sbr)) WRITE(ipt,*) "START: WET_JUDGE"
!
!--Determine If Node Points Are Wet/Dry Based on Depth Threshold---------------!
!
   iswetn = 1
   DO i = 1, m
     dtmp = h(i) + elf(i)

     IF((dtmp - min_depth) < 1.0e-5_sp) iswetn(i) = 0
   END DO

!
!--Determine if Cells are Wet/Dry Based on Depth Threshold---------------------!
!
   iswetc = 1
   DO i = 1, n
     dtmp =  max(elf(nv(i,1)),elf(nv(i,2)),elf(nv(i,3)))  + &
             min(  h(nv(i,1)),  h(nv(i,2)),  h(nv(i,3)))

     IF((dtmp - min_depth) < 1.0e-5_sp) iswetc(i) = 0
   END DO


   ! ------ Karsten Lettmann, 2016, May ----------------
   ! exchange the wet/dry information of elements between CPU
   ! --------------------------------------------------

!
!--A Secondary Condition for Nodal Dryness-(All Elements Around Node Are Dry)--!
!
   DO i = 1, m
     IF(sum(iswetc(nbve(i,1:ntve(i)))) == 0)  iswetn(i) = 0
   END DO

!
!--Adjust Water Surface So It Does Not Go Below Minimum Depth------------------!
!
   elf = max(elf,-h + min_depth)

!
!--Recompute Element Based Depths----------------------------------------------!
!
   DO i = 1, n
     elf1(i) = one_third*(elf(nv(i,1))+elf(nv(i,2))+elf(nv(i,3)))
   END DO

!
!--Extend Element/Node Based Wet/Dry Flags to Domain Halo----------------------!
!

   IF (dbg_set(dbg_sbr)) WRITE(ipt,*) "END: WET_JUDGE"
   RETURN
   END SUBROUTINE wet_judge

!==============================================================================|
!==============================================================================|

   SUBROUTINE wd_update(INCASE)

!------------------------------------------------------------------------------|
!  SHIFT WET/DRY VARIABLES TO NEW TIME LEVELS                                  |
!------------------------------------------------------------------------------|

   USE mod_prec
   USE all_vars
   USE mod_par
   IMPLICIT NONE
   INTEGER, INTENT(IN) :: INCASE
   INTEGER :: I

   IF (dbg_set(dbg_sbr)) WRITE(ipt,*) "START: WD_UPDATE"

   SELECT CASE(incase)

!------------------------------------------------------------------------------!
   CASE(1)    !! SHIFT AT END OF EXTERNAL MODE
!------------------------------------------------------------------------------!
   iswetce=iswetc
!------------------------------------------------------------------------------!
   CASE(2)    !! UPDATE NODE WET/DRY AFTER DEPTH ADJUSTMENT
!------------------------------------------------------------------------------!
   DO i = 1,m
     IF(dtfa(i)-min_depth <= 1.0e-5_sp) THEN
       iswetn(i) = 0
     END IF
   END DO
   
! ------- New: Karsten Lettmann, 2017 Jan --------------------------   
! ----------------- end new ----------------------------------------

!------------------------------------------------------------------------------!
   CASE(3)    !! SHIFT VARIABLES AT END OF INTERNAL MODE
!------------------------------------------------------------------------------!

   iswetct=iswetc
   iswetnt=iswetn

   END SELECT

   IF (dbg_set(dbg_sbr)) WRITE(ipt,*) "END: WD_UPDATE"
   RETURN
   END SUBROUTINE wd_update

END MODULE mod_wd