external_step.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$
!/===========================================================================/

SUBROUTINE external_step

  USE mod_nesting
  USE mod_utils
  USE all_vars
  USE mod_time
  USE mod_obcs
  USE mod_wd


  USE mod_ice
  USE mod_ice2d




  IMPLICIT NONE
  REAL(SP) :: TMP
  INTEGER :: K, I, J, JN, J1,i1,i2

!------------------------------------------------------------------------------|

  if(dbg_set(dbg_sbr)) write(ipt,*) "Start: external_step"
 
  !! David for VISIT
  !!=======================================================
  !!=======================================================


!----SET RAMP FACTOR TO EASE SPINUP--------------------------------------------!
  IF(iramp /= 0) THEN
     tmp = real(iint-1,sp)+real(iext,sp)/real(isplit,sp)
     ramp=tanh(tmp/real(iramp,sp))
  ELSE
     ramp = 1.0_sp
  END IF

!
!------SURFACE BOUNDARY CONDITIONS FOR EXTERNAL MODEL--------------------------!
!
  CALL bcond_gcn(9,0)



!
!------SAVE VALUES FROM CURRENT TIME STEP--------------------------------------!
!
  elrk1 = el1
  elrk  = el
  uark  = ua
  vark  = va


! New Open Boundary Condition ----5
  
  
!
!------BEGIN MAIN LOOP OVER EXTERNAL MODEL 4 STAGE RUNGE-KUTTA INTEGRATION-----!
!

  DO k=1,4
     
     rktime = exttime + imdte * (alpha_rk(k) - 1.0_dp)

!     CALL PRINT_REAL_TIME(RKTIME,IPT,"RUNGE-KUTTA")


! New Open Boundary Condition ----6
     
     
!FREE SURFACE AMPLITUDE UPDATE  --> ELF
     CALL extel_edge(k)
     
     
       
       

     ! New Open Boundary Condition ----7

     ! VALUES FOR THE OPEN BOUNDARY ARE ONLY UPDATED IN THE LOCAL DOMAIN
     ! THE HALO IS NOT SET HERE
     CALL bcond_gcn(1,k)
 
     IF(nesting_on )THEN
        CALL set_var(exttime,el=elf)
     END IF
     
     DO i=1,ibcn(1)
        jn = obc_lst(1,i)
        j=i_obc_n(jn)
        elf(j)=elrk(j)+alpha_rk(k)*(elf(j)-elrk(j))
     END DO

     
     ! DAVID ADDED THIS EXCHANGE CALL:
     ! IT SEEMS LIKELY THAT THE HALO VALUES OF ELF WILL BE USED
     ! BEFORE THEY ARE SET CORRECTLY OTHERWISE

!---------------For Dam Model-----------------------
! Jadon


     CALL n2e2d(elf,elf1)
          
     IF(wetting_drying_on)CALL wet_judge

     CALL flux_obn(k)

     !CALCULATE ADVECTIVE, DIFFUSIVE, AND BAROCLINIC MODES --> UAF ,VAF
     CALL advave_edge_gcn(advua,advva)           !Compute Ext Mode Adv/Diff


     CALL extuv_edge(k)


     CALL bcond_gcn(2,k)


     IF(nesting_on )THEN
       CALL set_var(exttime,ua=uaf)
       CALL set_var(exttime,va=vaf)
     END IF



     
     !UPDATE WATER SURFACE ELEVATION
     CALL assign_elm1_to_elm2

     el  = elf
     el1 = elf1


     
     !!INTERPOLATE DEPTH FROM NODE-BASED TO ELEMENT-BASED VALUES
     CALL n2e2d(el,el1)
     
     !UPDATE DEPTH AND VERTICALLY AVERAGED VELOCITY FIELD
     d   = h + el
     d1  = h1 + el1
     ua  = uaf
     va  = vaf
     dtfa = d

     
     ! New Open Boundary Condition ----8

     
     !!ENSURE ALL CELLS ARE WET IN NO FLOOD/DRY CASE  
     
     !EXCHANGE ELEMENT-BASED VALUES ACROSS THE INTERFACE

     !SAVE VALUES FOR 3D MOMENTUM CORRECTION AND UPDATE
     IF(k == 3)THEN
        uard = uard + ua*d1
        vard = vard + va*d1
        egf  = egf  + el/isplit
        


!!#   if defined (1)
!!        UARDS = UARDS + UAS*D1
!!        VARDS = VARDS + VAS*D1
!!#   endif
     END IF
     
     !CALCULATE VALUES USED FOR SALINITY/TEMP BOUNDARY CONDITIONS
     IF(k == 4.AND.iobcn > 0) THEN
        DO i=1,iobcn
           j=i_obc_n(i)
           tmp=-(elf(j)-elrk(j))*art1(j)/dte-xflux_obcn(i)
           uard_obcn(i)=uard_obcn(i)+tmp/float(isplit)
        END DO
     END IF
!end !defined (TWO_D_MODEL)

     
     !UPDATE WET/DRY FACTORS
     IF(wetting_drying_on)CALL wd_update(1)

  END DO     !! END RUNGE-KUTTA LOOP
  

  if(dbg_set(dbg_sbr)) write(ipt,*) "End: external_step"

END SUBROUTINE external_step