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

!==============================================================================|
!   Calculate Advection and Horizontal Diffusion Terms for Temperature         |
!==============================================================================|

   SUBROUTINE viscof_h               

!------------------------------------------------------------------------------|
   USE mod_utils
   USE all_vars

   IMPLICIT NONE
   REAL(SP) :: PUPX,PUPY,PVPX,PVPY
   REAL(SP) :: tmp1,tmp2
   INTEGER  :: I,I1,K,J


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

   SELECT CASE(horizontal_mixing_type)
   CASE ('closure')
      ! Run Subroutine
   CASE('constant')
      IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "End: viscofh (constant)"
   CASE DEFAULT
      CALL fatal_error("UNKNOW HORIZONTAL MIXING TYPE:",&
           & trim(horizontal_mixing_type) )
   END SELECT


   DO k=1,kbm1
     DO i=1,m
       pupx=0.0_sp
       pupy=0.0_sp
       pvpx=0.0_sp
       pvpy=0.0_sp

       j=1
       i1=nbve(i,j)


       pupx=pupx+u(i1,k)*dltyecec(i,j)
       pupy=pupy+u(i1,k)*dltxecec(i,j)
       pvpx=pvpx+v(i1,k)*dltyecec(i,j)
       pvpy=pvpy+v(i1,k)*dltxecec(i,j)
       

       IF(isonb(i) /= 0) THEN

         pupx=pupx+u(i1,k)*dltynec(i,j)
         pupy=pupy+u(i1,k)*dltxnec(i,j)
         pvpx=pvpx+v(i1,k)*dltynec(i,j)
         pvpy=pvpy+v(i1,k)*dltxnec(i,j)

       END IF

       DO j=2,ntve(i)-1
         i1=nbve(i,j)
         
         pupx=pupx+u(i1,k)*dltyecec(i,j)
         pupy=pupy+u(i1,k)*dltxecec(i,j)
         pvpx=pvpx+v(i1,k)*dltyecec(i,j)
         pvpy=pvpy+v(i1,k)*dltxecec(i,j)

       END DO

       j=ntve(i)
       i1=nbve(i,j)


       pupx=pupx+u(i1,k)*dltyecec(i,j)
       pupy=pupy+u(i1,k)*dltxecec(i,j)
       pvpx=pvpx+v(i1,k)*dltyecec(i,j)
       pvpy=pvpy+v(i1,k)*dltxecec(i,j)
       

       IF(isonb(i) /= 0) THEN

          pupx=pupx+u(i1,k)*(-dltynec(i,j))
          pupy=pupy+u(i1,k)*(-dltxnec(i,j))
          pvpx=pvpx+v(i1,k)*(-dltynec(i,j))
          pvpy=pvpy+v(i1,k)*(-dltxnec(i,j))

       END IF

       pupx=pupx/art1(i)
       pupy=pupy/art1(i)
       pvpx=pvpx/art1(i)
       pvpy=pvpy/art1(i)
       tmp1=pupx**2+pvpy**2
       tmp2=0.5_sp*(pupy+pvpx)**2
       viscofh(i,k)=sqrt(tmp1+tmp2)*art1(i)
       
     END DO
   END DO  
    

   IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "End: viscofh"

   END SUBROUTINE viscof_h
!==============================================================================|