vdif_uv.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	vdif_uv

Function/Subroutine Documentation

vdif_uv()

subroutine vdif_uv

(

)

Definition at line 46 of file vdif_uv.f90.

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

   USE all_vars
   USE mod_utils
   USE mod_wd
   IMPLICIT NONE
   INTEGER I,K,ITMP1,ITMP2,ITMP3,KI
   REAL(SP), DIMENSION(0:NT,KB) :: C,A,VHU,VHPU,VHV,VHPV
   REAL(SP) :: TMP

   IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "Start: vdif_uv"

   c = km1

   DO k = 2, kbm1
     DO i = 1, n
       IF(iswetc(i) == 1)THEN

         a(i,k-1) = -dti *(c(i,k)+umol) / (dz1(i,k-1)*dzz1(i,k-1)* d1(i)*d1(i))
         c(i,k) = -dti *(c(i,k)+umol) / (dz1(i,k)*dzz1(i,k-1)* d1(i)*d1(i))
       END IF
     END DO
   END DO

   DO i = 1, n
     IF(iswetc(i) == 1)THEN
       itmp1=isonb(nv(i,1))
       itmp2=isonb(nv(i,2))
       itmp3=isonb(nv(i,3))
       IF(itmp1 == 2 .OR. itmp2 == 2 .OR. itmp3 == 2) THEN
         tmp=0.0_sp
       ELSE
         tmp=1.0_sp
       END IF
       vhu(i,1) = a(i,1) / (a(i,1)-1.)
       vhv(i,1) = a(i,1) / (a(i,1)-1.)
       vhpu(i,1) = (-dti*wusurf(i)*tmp/(-dz1(i,1)*d1(i))-uf(i,1)) / (a(i,1)-1.)
       vhpv(i,1) = (-dti*wvsurf(i)*tmp/(-dz1(i,1)*d1(i))-vf(i,1)) / (a(i,1)-1.)
     END IF
   END DO

   DO  k = 2, kbm2
     DO i = 1, n
       IF(iswetc(i) == 1)THEN
         vhpu(i,k) = 1.0_sp / (a(i,k)+c(i,k)*(1.-vhu(i,k-1))-1.)
         vhpv(i,k) = 1.0_sp / (a(i,k)+c(i,k)*(1.-vhv(i,k-1))-1.)
         vhu(i,k)  = a(i,k) * vhpu(i,k)
         vhv(i,k)  = a(i,k) * vhpv(i,k)
         vhpu(i,k) = (c(i,k)*vhpu(i,k-1)-uf(i,k))*vhpu(i,k)
         vhpv(i,k) = (c(i,k)*vhpv(i,k-1)-vf(i,k))*vhpv(i,k)
       END IF
     END DO
   END DO

   DO  i = 1, n
     IF(iswetc(i) == 1)THEN
       tps(i) = cbc(i) * sqrt(u(i,kbm1)**2+v(i,kbm1)**2)
       uf(i,kbm1) = (c(i,kbm1)*vhpu(i,kbm2)-uf(i,kbm1))/ &
       (tps(i)*dti/(-dz1(i,kbm1)*d1(i))-1.-(vhu(i,kbm2)-1.)*c(i,kbm1))
       vf(i,kbm1) = (c(i,kbm1)*vhpv(i,kbm2)-vf(i,kbm1))/ &
       (tps(i)*dti/(-dz1(i,kbm1)*d1(i))-1.-(vhv(i,kbm2)-1.)*c(i,kbm1))
     END IF
   END DO

   DO  k = 2, kbm1
     ki = kb - k
     DO  i = 1, n
       IF(iswetc(i) == 1)THEN
         uf(i,ki) = (vhu(i,ki)*uf(i,ki+1)+vhpu(i,ki))
         vf(i,ki) = (vhv(i,ki)*vf(i,ki+1)+vhpv(i,ki))
       ELSE
         uf(i,ki) = 0.0_sp
         vf(i,ki) = 0.0_sp
       END IF
     END DO
   END DO

!
!--Damp Velocity In Sponge Region----------------------------------------------!
!
   DO k = 1, kbm1
     DO i = 1, n
!#  if defined (THIN_DAM)
!       UF(I,K) = UF(I,K)-DAM_SPONGE(I)*UF(I,K)
!       VF(I,K) = VF(I,K)-DAM_SPONGE(I)*VF(I,K)
!#  endif
!old:       UF(I,K) = UF(I,K)-CC_SPONGE(I)*UF(I,K)
!old:       VF(I,K) = VF(I,K)-CC_SPONGE(I)*VF(I,K)
! ---- new: Karsten Lettmann: 2012.06.25 -------
        uf(i,k) = uf(i,k)/(1.0_sp+cc_sponge(i)*uf(i,k)**2.0_sp)
        vf(i,k) = vf(i,k)/(1.0_sp+cc_sponge(i)*vf(i,k)**2.0_sp)
! ------- end new -------------------------------
     END DO
   END DO

   DO  i = 1, n
     IF(iswetc(i) == 1)THEN
       wubot(i) = -tps(i) * u(i,kbm1)
       wvbot(i) = -tps(i) * v(i,kbm1)
     ELSE
       wubot(i) = 0.0_sp
       wvbot(i) = 0.0_sp
     END IF
   END DO

   IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "Start: vdif_uv"

Here is the call graph for this function:

Here is the caller graph for this function: