phy_baropg.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	phy_baropg

Function/Subroutine Documentation

phy_baropg()

subroutine phy_baropg

(

)

Definition at line 49 of file phy_baropg.f90.

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

   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

Here is the call graph for this function:

Here is the caller graph for this function: