extuv_edge.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	extuv_edge (K)

Function/Subroutine Documentation

extuv_edge()

subroutine extuv_edge

(

integer, intent(in)

K

)

Definition at line 45 of file extuv_edge.f90.

!==============================================================================|
   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"

Here is the call graph for this function:

Here is the caller graph for this function: