81 lines
2.3 KiB
FortranFixed
81 lines
2.3 KiB
FortranFixed
subroutine cont1
|
|
use lsgvar
|
|
implicit none
|
|
!
|
|
! ------------------------------------------------------------------
|
|
!
|
|
!**** *cont1*.
|
|
!
|
|
! by E. Maier-Reimer.
|
|
! Last modified by U. Mikolajewicz 9/87.
|
|
!
|
|
! Purpose.
|
|
! --------
|
|
! *cont1* computes the vertical velocities *w* from the total
|
|
! velocities *utot* and *vtot* using the equation of continuity.
|
|
!
|
|
!** Input.
|
|
! ------
|
|
! utot,vtot horizontal velocities ( common/lsgfie/).
|
|
!
|
|
! Output.
|
|
! -------
|
|
! w vertical velocities (common/lsgfie/).
|
|
! trup sum of vertical transports up (m**3/s).
|
|
! trdo " " " " down " .
|
|
! both in common /lsgdia/.
|
|
!
|
|
! Interface.
|
|
! ----------
|
|
! *call* *cont1*.
|
|
!
|
|
! ------------------------------------------------------------
|
|
!
|
|
! Declaration of local variables.
|
|
! -------------------------------
|
|
integer :: i,j,k,il
|
|
real (kind=8) :: hordiv,wups
|
|
!
|
|
!* 1. Initialisation.
|
|
! ---------------
|
|
w(:,:,:) = 0.0
|
|
!
|
|
!* 2. Computation of the vertical velocity from bottom upward.
|
|
! --------------------------------------------------------
|
|
!
|
|
! Determination of the values of the neighbour cell.
|
|
!
|
|
do k=ken-1,1,-1
|
|
do j=3,jen-2
|
|
do i=1,ien
|
|
il=i-1
|
|
if (il<1) il=ien
|
|
hordiv=utot(il,j,k+1)*delta(il,j,k+1)*dphi-utot(i,j,k+1) &
|
|
& *delta(i,j,k+1)*dphi+vtot(i,j+1,k+1)*delta(i,j+1,k+1) &
|
|
& *dl(j+1)-vtot(il,j-1,k+1)*delta(il,j-1,k+1)*dl(j-1)
|
|
w(i,j,k)=w(i,j,k+1)+hordiv/(dl(j)*dphi)*wet(i,j,k+1)
|
|
end do
|
|
end do
|
|
end do
|
|
!
|
|
!* 3. Computation of control parameters.
|
|
! ----------------------------------
|
|
! The parameters *trup* and *trdo* describe the sum of
|
|
! the transports up and down.
|
|
!
|
|
do k=1,ken
|
|
trup(k)=0.
|
|
trdo(k)=0.
|
|
do j=1,jen
|
|
do i=1,ien
|
|
wups=sign(0.5_8,w(i,j,k))
|
|
trup(k)=trup(k)+w(i,j,k)*(wups+abs(wups))*dlh(i,j)
|
|
trdo(k)=trdo(k)+w(i,j,k)*(abs(wups)-wups)*dlh(i,j)
|
|
end do
|
|
end do
|
|
trup(k)=trup(k)*dphi
|
|
trdo(k)=trdo(k)*dphi
|
|
end do
|
|
return
|
|
end subroutine cont1
|