Commit ade970af authored by kbk's avatar kbk
Browse files

changed order of some loops

parent 406a3772
!$Id: slow_advection.F90,v 1.2 2003-03-24 12:48:21 gotm Exp $
!$Id: slow_advection.F90,v 1.3 2003-04-07 16:24:04 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -12,13 +12,14 @@
!
! !USES:
use domain, only: iimin,iimax,jjmin,jjmax,HU,HV,az,au,av
use domain, only: H,min_depth
#if defined(SPHERICAL) || defined(CURVILINEAR)
use domain, only: dyc,arud1,dxx,dyx,arvd1,dxc
#else
use domain, only: dx,dy,ard1
#endif
use m2d, only: UEx,VEx,Uint,Vint
use variables_3d, only: ssun,ssvn
use variables_2d, only: UEx,VEx,Uint,Vint
use variables_3d, only: ssun,ssvn
IMPLICIT NONE
!
! !INPUT PARAMETERS:
......@@ -31,8 +32,8 @@
! Original author(s): Hans Burchard & Karsten Bolding
!
! $Log: slow_advection.F90,v $
! Revision 1.2 2003-03-24 12:48:21 gotm
! Fixed one loop bdy + cleaned up
! Revision 1.3 2003-04-07 16:24:04 kbk
! changed order of some loops
!
! Revision 1.1.1.1 2002/05/02 14:00:54 gotm
! recovering after CVS crash
......@@ -59,12 +60,11 @@
! Revision 1.1.1.1 2001/04/17 08:43:08 bbh
! initial import into CVS
!
!
! !LOCAL VARIABLES:
integer :: i,j,ii,jj
REALTYPE :: PP(iimin-1:iimax,jjmin-1:jjmax)
REALTYPE :: DUi(iimin-1:iimax+1,jjmin-1:jjmax+1)
REALTYPE :: DVi(iimin-1:iimax+1,jjmin-1:jjmax+1)
REALTYPE :: PP(I2DFIELD)
REALTYPE :: DUi(I2DFIELD)
REALTYPE :: DVi(I2DFIELD)
REALTYPE :: ps
!EOP
!-----------------------------------------------------------------------
......@@ -74,15 +74,11 @@
Ncall = Ncall+1
write(debug,*) 'slow_advection() # ',Ncall
#endif
do j=jjmin-1,jjmax+1
do i=iimin-1,iimax+1
!KBK DUi(i,j)=max(ssun(i,j)+HU(i,j),min_depth)
!KBK DVi(i,j)=max(ssvn(i,j)+HV(i,j),min_depth)
DUi(i,j)=ssun(i,j)+HU(i,j)
end do
end do
do j=jjmin-1,jjmax+1
do i=iimin-1,iimax+1
DVi(i,j)=ssvn(i,j)+HV(i,j)
end do
end do
......@@ -90,7 +86,8 @@
! Upstream for dx(U^2/D)
do j=jjmin,jjmax
do i=iimin,iimax+1 ! PP defined on T-points
if (az(i,j).ge.1) then
!KBK PP(i,j) = _ZERO_
if (az(i,j) .ge. 1) then
PP(i,j)=0.5*(Uint(i-1,j)+Uint(i,j))
if (PP(i,j) .gt. _ZERO_ ) then
ii=i-1
......@@ -103,16 +100,19 @@
end do
do j=jjmin,jjmax
do i=iimin,iimax ! UEx defined on U-points
if (au(i,j).ge.1) then
if (au(i,j) .ge. 1) then
UEx(i,j)=(PP(i+1,j)-PP(i ,j))*ARUD1
end if
else
!KBK UEx(i,j)= _ZERO_
end if
end do
end do
! Upstream for dy(UV/D)
do i=iimin-1,iimax
do j=jjmin-1,jjmax ! PP defined on X-points
if ((au(i,j).ge.1).or.(au(i,j+1).ge.1)) then
! Upstream for dy(UV/D)
do j=jjmin-1,jjmax ! PP defined on X-points
do i=iimin-1,iimax
!KBK PP(i,j) = _ZERO_
if (au(i,j) .ge. 1 .or. au(i,j+1) .ge. 1) then
PP(i,j)=0.5*(Vint(i+1,j)+Vint(i,j))
if (PP(i,j) .gt. _ZERO_) then
jj=j
......@@ -125,7 +125,7 @@
end do
do j=jjmin,jjmax
do i=iimin,iimax !UEx defined on U-points
if (au(i,j).ge.1) then
if (au(i,j) .ge. 1) then
UEx(i,j)=UEx(i,j)+(PP(i,j )-PP(i,j-1))*ARUD1
end if
end do
......@@ -134,30 +134,33 @@
! Upstream for dx(UV/D)
do j=jjmin-1,jjmax
do i=iimin-1,iimax ! PP defined on X-points
if ((av(i,j).ge.1).or.(av(i+1,j).ge.1)) then
!KBK PP(i,j) = _ZERO_
if (av(i,j) .ge. 1 .or. av(i+1,j) .ge. 1) then
PP(i,j)=0.5*(Uint(i,j)+Uint(i,j+1))
if (PP(i,j) .gt. _ZERO_) then
ii=i
else
ii=i+1
end if
PP(i,j)=PP(i,j)*Vint(ii,j)/DVi(ii,j)*DYX
PP(i,j)=PP(i,j)*Vint(ii,j)/DVi(ii,j)*DYX
end if
end do
end do
do j=jjmin,jjmax
do i=iimin,iimax ! VEx defined on V-points
if (av(i,j).ge.1) then
if (av(i,j) .ge. 1) then
VEx(i,j)=(PP(i ,j)-PP(i-1,j))*ARVD1
else
!KBK VEx(i,j)= _ZERO_
end if
end do
end do
! Upstream for dy(V^2/D)
do j=jjmin,jjmax+1
do i=iimin,iimax ! PP defined on T-points
! Upstream for dy(V^2/D)
do j=jjmin,jjmax+1 ! PP defined on T-points
do i=iimin,iimax
PP(i,j) = _ZERO_
if (az(i,j).ge.1) then
if (az(i,j) .ge. 1) then
PP(i,j)=0.5*(Vint(i,j-1)+Vint(i,j))
if (PP(i,j) .gt. _ZERO_) then
jj=j-1
......@@ -168,9 +171,9 @@
end if
end do
end do
do j=jjmin,jjmax
do i=iimin,iimax ! VEx defined on V-points
if (av(i,j).ge.1) then
do j=jjmin,jjmax ! VEx defined on V-points
do i=iimin,iimax
if (av(i,j) .ge. 1) then
VEx(i,j)=VEx(i,j)+(PP(i,j+1)-PP(i,j ))*ARVD1
end if
end do
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment