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

!==============================================================================|
!   This subroutine is used to calculate the baroclinic pressure               !
!   gradient in the standarded z-levels. The water column is divided           !
!   into 600 standard levels, and pressure gradient is then determined         !
!   at each level. The resulting pressure gradients are converted back         !
!   to sigma-levels through vertical interpolation approach.                   !
!==============================================================================|

   SUBROUTINE phy_baropg          

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

   USE all_vars
   USE sinter
   IMPLICIT NONE
   INTEGER, PARAMETER :: KBB=601
   INTEGER, PARAMETER :: KBBM1=kbb-1
   REAL(SP) RHOZ(M,KBBM1),RHOZTMP(KBBM1),PHY_Z(KBBM1)
   REAL(SP) RHOS(KBM1),SIGZTMP(KBM1),SIG_Z(M,KBM1)
   REAL(SP) PB1(0:KBBM1),PB2(0:KBBM1),PB3(0:KBBM1)
   REAL(SP) PBXZ(KBBM1),PBYZ(KBBM1)
   REAL(SP) PBXS(KBM1) ,PBYS(KBM1)
   REAL(SP) AREAX1,AREAX2,AREAX3,AREAY1,AREAY2,AREAY3
   REAL(SP) RHOZI1,RHOZI2,RHOZI3,TMP,TEMP,DELTZ
   REAL(SP) GRAV1,GRAV2,GRAV3
   INTEGER  I,K,J1,J2,J3,NTMP

   ! USE RAMP CALCULATED IN 'internal_step.F'

!--CALCULATE Z-LEVELS TO MAX DEPTH---------------------------------------------|
   
   deltz=hmax/float(kbbm1)

   DO k=1,kbbm1
     phy_z(k)=(0.5_sp-float(k))*deltz
   END DO

!--LINEARLY INTERPOLATE TO OBTAIN DENSITY VALUES AT Z LEVELS-------------------|

   DO i=1,m
     DO k=1,kbm1
       sig_z(i,k)=zz(i,k)*dt(i)+et(i)
       sigztmp(k)=sig_z(i,k)
       rhos(k)=rho1(i,k)
     END DO

     CALL sinter_extrp_down(sigztmp,rhos,phy_z,rhoztmp,kbm1,kbbm1)

     DO k=1,kbbm1
       rhoz(i,k)=rhoztmp(k)
     END DO
   END DO

   DO i=1,n
     j1=nv(i,1)
     j2=nv(i,2)
     j3=nv(i,3)
     ntmp=0
     pb1(0)=0.0_sp
     pb2(0)=0.0_sp
     pb3(0)=0.0_sp
     DO k=1,kbbm1
       tmp=float(k)*deltz
       IF((h(j1) < tmp.OR.h(j2) < tmp.OR.h(j3) < tmp)) THEN
         pb1(k)=0.0_sp
         pb2(k)=0.0_sp
         pb3(k)=0.0_sp
       ELSE
         rhozi1=0.5_sp*(rhoz(j2,k)+rhoz(j3,k))
         rhozi2=0.5_sp*(rhoz(j3,k)+rhoz(j1,k))
         rhozi3=0.5_sp*(rhoz(j1,k)+rhoz(j2,k))
     grav1 =0.5_sp*(grav_n(j2)+grav_n(j3))
     grav2 =0.5_sp*(grav_n(j3)+grav_n(j1))
     grav3 =0.5_sp*(grav_n(j1)+grav_n(j2))
         pb1(k)=pb1(k-1)+grav1*rhozi1*deltz
         pb2(k)=pb2(k-1)+grav2*rhozi2*deltz
         pb3(k)=pb3(k-1)+grav3*rhozi3*deltz
         ntmp=ntmp+1
       END IF
     END DO
     areax1=(vy(j3)-vy(j2))*deltz
     areay1=(vx(j2)-vx(j3))*deltz
     areax2=(vy(j1)-vy(j3))*deltz
     areay2=(vx(j3)-vx(j1))*deltz
     areax3=(vy(j2)-vy(j1))*deltz
     areay3=(vx(j1)-vx(j2))*deltz
     DO k=1,kbbm1
       pbxz(k)=areax1*pb1(k)+areax2*pb2(k)+areax3*pb3(k)
       pbyz(k)=areay1*pb1(k)+areay2*pb2(k)+areay3*pb3(k)
       pbxz(k)=pbxz(k)/art(i)/deltz
       pbyz(k)=pbyz(k)/art(i)/deltz
     END DO

     DO k=1,kbm1
       j1=nv(i,1)
       j2=nv(i,2)
       j3=nv(i,3)
       sigztmp(k)=(sig_z(j1,k)+sig_z(j2,k)+sig_z(j3,k))/3.
     END DO

     IF(ntmp == 0) THEN
       DO k=1,kbm1
         pbxs(k)=0.0_sp
         pbys(k)=0.0_sp
       END DO
     ELSE IF(ntmp == 1) THEN
       DO k=1,kbm1
         pbxs(k)=pbxz(1)
         pbys(k)=pbyz(1)
       END DO
     ELSE
       CALL sinter_extrp_down(phy_z,pbxz,sigztmp,pbxs,ntmp,kbm1)
       CALL sinter_extrp_down(phy_z,pbyz,sigztmp,pbys,ntmp,kbm1)
     END IF

     DO k=1,kbm1
       drhox(i,k)=-pbxs(k)*dt1(i)*dz1(i,k)*art(i)*ramp
       drhoy(i,k)=-pbys(k)*dt1(i)*dz1(i,k)*art(i)*ramp
     END DO
   END DO

   RETURN
   END SUBROUTINE phy_baropg
!==============================================================================|