adcor.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 adcor

   USE all_vars
   USE mod_spherical
   USE mod_northpole
   USE mod_wd


   IMPLICIT NONE
   REAL(SP) :: UFC(0:NT,KB),VFC(0:NT,KB)
   REAL(SP),PARAMETER :: BETA0=0.5_sp
   REAL(SP) ::CURCOR,PRECOR
   INTEGER :: I,K  
   REAL(SP) :: U_TMP,V_TMP,UF_TMP,VF_TMP  


   ufc=0.0_sp
   vfc=0.0_sp

   DO i = 1, n

       DO k = 1, kbm1
         curcor=beta0*cor(i)*vf(i,k)
         precor=(1._sp-beta0)*cor(i)*v(i,k)
         ufc(i,k)=ubeta(i,k)-(curcor+precor)*dt1(i)*dz1(i,k)*art(i)*epor(i)
       END DO
   
   END DO

   DO i = 1, n

       DO k = 1, kbm1
         curcor=beta0*cor(i)*uf(i,k)
         precor=(1._sp-beta0)*cor(i)*u(i,k)
         vfc(i,k)=vbeta(i,k)+(curcor+precor)*dt1(i)*dz1(i,k)*art(i)*epor(i)
       END DO

   END DO

   DO i=1,n
       DO k=1,kbm1
         uf(i,k)=u(i,k)*dt1(i)/d1(i)-dti*ufc(i,k)/art(i)/(d1(i)*dz1(i,k))
         vf(i,k)=v(i,k)*dt1(i)/d1(i)-dti*vfc(i,k)/art(i)/(d1(i)*dz1(i,k))
       END DO
   END DO

   DO i =1,n
      IF(iswetct(i)*iswetc(i) .NE. 1)THEN
         DO k=1,kbm1
            uf(i,k)=0.0_sp
            vf(i,k)=0.0_sp
         END DO
      END IF
   END DO

   RETURN
   END SUBROUTINE adcor