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

!==============================================================================|
!     ACCUMLATE FLUXES FOR EXTERNAL MODE                                       |
!==============================================================================|

   SUBROUTINE extuv_edge(K)       

!==============================================================================|
   USE all_vars
   USE mod_utils
   USE mod_wd

   USE mod_northpole




   IMPLICIT NONE
   INTEGER, INTENT(IN) :: K
   REAL(SP), DIMENSION(0:NT) :: RESX,RESY,TMP
   REAL(SP) :: UAFT,VAFT
   INTEGER  :: I

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

   if(dbg_set(dbg_sbr)) write(ipt,*) "Start: extuv_edge.F"

!
!--ACCUMULATE RESIDUALS FOR EXTERNAL MODE EQUATIONS----------------------------|
!
   uaft = uaf(0)
   vaft = vaf(0)

   ! THIS APPEARS TO BE TO PREVENT DIVISION BY ZERO, BUT IT IS A
   ! STRANGE WAY TO DO IT!
   h1(0)= h1(1)

!!#  if defined (1)
!!   IF(K == 3)THEN

!!#    if !defined (NH)
!!     RESX = ADX2D + ADVUA + DRX2D + PSTX - COR*VA*D1*ART  &
!!            -(WUSURF2 + WUBOT)*ART
!!     RESY = ADY2D + ADVVA + DRY2D + PSTY + COR*UA*D1*ART  &
!!            -(WVSURF2 + WVBOT)*ART
!!#    else
!!     RESX = ADX2D + ADVUA + DRX2D + PSTX - COR*VA*D1*ART  &
!!            -(WUSURF2 + WUBOT)*ART + NHQ2DX
!!     RESY = ADY2D + ADVVA + DRY2D + PSTY + COR*UA*D1*ART  &
!!            -(WVSURF2 + WVBOT)*ART + NHQ2DY
!!#    endif

!!#  if defined (SPHERICAL)
!!     RESX = RESX -UA*VA/REARTH*TAN(DEG2RAD*YC)*D1*ART
!!     RESY = RESY +UA*UA/REARTH*TAN(DEG2RAD*YC)*D1*ART
!!#  endif

!!!
!!!--UPDATE----------------------------------------------------------------------|
!!!

!!     UAF = (UARK*(H1+ELRK1)-ALPHA_RK(K)*DTE*RESX/ART)/(H1+ELF1)
!!     VAF = (VARK*(H1+ELRK1)-ALPHA_RK(K)*DTE*RESY/ART)/(H1+ELF1)
!!     UAS = UAF
!!     VAS = VAF
!!   END IF
!!#  endif

   DO i=1,nt
     IF(iswetce(i)*iswetc(i) == 1)THEN

       resx(i) = adx2d(i)+advua(i)+drx2d(i)+pstx(i)-cor(i)*va(i)*d1(i)*art(i)  &
                 -(wusurf2(i)+wubot(i))*art(i)
       resy(i) = ady2d(i)+advva(i)+dry2d(i)+psty(i)+cor(i)*ua(i)*d1(i)*art(i)  &
                 -(wvsurf2(i)+wvbot(i))*art(i)



!
!--UPDATE----------------------------------------------------------------------|
!

       uaf(i)  =  (uark(i)*(h1(i)+elrk1(i))-alpha_rk(k)*dte*resx(i)/art(i))/(h1(i)+elf1(i))
       vaf(i)  =  (vark(i)*(h1(i)+elrk1(i))-alpha_rk(k)*dte*resy(i)/art(i))/(h1(i)+elf1(i))
     ELSE
       uaf(i) = 0.0_sp
       vaf(i) = 0.0_sp
     END IF
   END DO

   
   vaf(0) = vaft
   uaf(0) = uaft

!
!--ADJUST EXTERNAL VELOCITY IN SPONGE REGION-----------------------------------|
!
!old:   UAF = UAF-CC_SPONGE*UAF
!old:   VAF = VAF-CC_SPONGE*VAF
! ---- new: Karsten Lettmann: 2012.06.25 -------
   uaf = uaf/(1.0_sp+cc_sponge*uaf**2.0_sp)
   vaf = vaf/(1.0_sp+cc_sponge*vaf**2.0_sp)
! ------- end new -------------------------------


!
!--STORE VARIABLES FOR MOMENTUM BALANCE CHECK----------------------------------|
!

   if(dbg_set(dbg_sbr)) write(ipt,*) "End: extuv_edge.F"

   END SUBROUTINE extuv_edge
!==============================================================================|