Commit 87b78ff7 authored by kbk's avatar kbk
Browse files

to compile with IFORT - TABS, etc.

parent 0d8bacbf
!$Id: m2d.F90,v 1.10 2004-01-06 19:07:22 kbk Exp $
!$Id: m2d.F90,v 1.11 2004-01-07 07:37:36 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -41,7 +41,10 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: m2d.F90,v $
! Revision 1.10 2004-01-06 19:07:22 kbk
! Revision 1.11 2004-01-07 07:37:36 kbk
! to compile with IFORT - TABS, etc.
!
! Revision 1.10 2004/01/06 19:07:22 kbk
! vel_depth_method in namelist
!
! Revision 1.9 2004/01/05 08:59:38 kbk
......@@ -145,7 +148,7 @@
integer :: vel_depth_method=0
namelist /m2d/ &
MM,z0_const,vel_depth_method,Am,An,residual, &
bdy2d,bdyfmt_2d,bdyramp_2d,bdyfile_2d
bdy2d,bdyfmt_2d,bdyramp_2d,bdyfile_2d
!EOP
!-------------------------------------------------------------------------
!BOC
......
!$Id: momentum.F90,v 1.6 2003-04-23 12:09:44 kbk Exp $
!$Id: momentum.F90,v 1.7 2004-01-07 07:37:36 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -28,7 +28,10 @@
! Original author(s): Hans Burchard & Karsten Bolding
!
! $Log: momentum.F90,v $
! Revision 1.6 2003-04-23 12:09:44 kbk
! Revision 1.7 2004-01-07 07:37:36 kbk
! to compile with IFORT - TABS, etc.
!
! Revision 1.6 2003/04/23 12:09:44 kbk
! cleaned code + TABS to spaces
!
! Revision 1.5 2003/04/07 15:54:16 kbk
......@@ -182,7 +185,7 @@
#endif
#if defined(SPHERICAL) || defined(CURVILINEAR)
cord_curv=(V(i,j)*(DYX-DYXIM1)-Uloc*(DXCJP1-DXC)) &
/DV(i,j)*ARVD1
/DV(i,j)*ARVD1
fU(i,j)=(cord_curv+corv(i,j))*Uloc
#else
fU(i,j)=corv(i,j)*Uloc
......@@ -293,7 +296,7 @@
#endif
#if defined(SPHERICAL) || defined(CURVILINEAR)
cord_curv=(Vloc*(DYCIP1-DYC)-U(i,j)*(DXX-DXXJM1)) &
/DU(i,j)*ARUD1
/DU(i,j)*ARUD1
fV(i,j)=(cord_curv+coru(i,j))*Vloc
#else
fV(i,j)=coru(i,j)*Vloc
......
!$Id: fct_2dh_adv.F90,v 1.1 2004-01-06 15:04:00 kbk Exp $
!$Id: fct_2dh_adv.F90,v 1.2 2004-01-07 07:37:37 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -43,7 +43,10 @@
! Original author(s): Hans Burchard & Karsten Bolding
!
! $Log: fct_2dh_adv.F90,v $
! Revision 1.1 2004-01-06 15:04:00 kbk
! Revision 1.2 2004-01-07 07:37:37 kbk
! to compile with IFORT - TABS, etc.
!
! Revision 1.1 2004/01/06 15:04:00 kbk
! FCT advection + split of advection_3d.F90 + extra adv. input checks
!
!
......@@ -138,8 +141,8 @@
+vv(i ,j ,k)/hvn(i ,j ,k) &
+vv(i+1,j-1,k)/hvn(i+1,j-1,k) &
+vv(i+1,j ,k)/hvn(i+1,j ,k))*dt/delyu(i,j)
if (uuu.gt.0) then
if (vvv.gt.0) then
if (uuu .gt. _ZERO_) then
if (vvv .gt. _ZERO_) then
CNW =f(i ,j+1,k)
CW =f(i ,j ,k)
CSW =f(i ,j-1,k)
......@@ -159,7 +162,7 @@
CS =f(i+1,j+1,k)
end if
else
if (vvv.gt.0) then
if (vvv.gt._ZERO_) then
CNW =f(i+1,j+1,k)
CW =f(i+1,j ,k)
CSW =f(i+1,j-1,k)
......@@ -207,8 +210,8 @@
+uu(i,j,k)/hun(i,j,k) &
+uu(i,j+1,k)/hun(i,j+1,k) &
)*dt/delxv(i,j)
if (uuu.gt.0) then
if (vvv.gt.0) then
if (uuu .gt. _ZERO_) then
if (vvv .gt. _ZERO_) then
CNW =f(i+1,j ,k)
CW =f(i ,j ,k)
CSW =f(i-1,j ,k)
......@@ -228,7 +231,7 @@
CS =f(i+1,j+1,k)
end if
else
if (vvv.gt.0) then
if (vvv .gt. _ZERO_) then
CNW =f(i+1,j+1,k)
CW =f(i ,j+1,k)
CSW =f(i-1,j+1,k)
......@@ -288,7 +291,7 @@
do k=1,kmax
do j=jjmin,jjmax
do i=iimin,iimax
if (az(i,j).eq.1) then
if (az(i,j) .eq. 1) then
cmin(i,j,k)= 10000.
cmax(i,j,k)=-10000.
! Calculate min and max of all values around one point
......@@ -298,31 +301,31 @@
x=min(f(i+ii,j+jj,k),fi(i+ii,j+jj,k))
if (x.lt.cmin(i,j,k)) cmin(i,j,k)=x
x=max(f(i+ii,j+jj,k),fi(i+ii,j+jj,k))
if (x.gt.cmax(i,j,k)) cmax(i,j,k)=x
if (x .gt. cmax(i,j,k)) cmax(i,j,k)=x
end if
end do
end do
! max (Cu) and min (Cl) possible concentration after a time step
CExx=(min(fhx(i ,j ,k)-flx(i ,j ,k),0.) &
-max(fhx(i-1,j ,k)-flx(i-1,j ,k),0.))/delxu(i,j) &
+(min(fhy(i ,j ,k)-fly(i ,j ,k),0.) &
-max(fhy(i ,j-1,k)-fly(i ,j-1,k),0.))/delyv(i,j)
CExx=(min(fhx(i ,j ,k)-flx(i ,j ,k),_ZERO_) &
-max(fhx(i-1,j ,k)-flx(i-1,j ,k),_ZERO_))/delxu(i,j) &
+(min(fhy(i ,j ,k)-fly(i ,j ,k),_ZERO_) &
-max(fhy(i ,j-1,k)-fly(i ,j-1,k),_ZERO_))/delyv(i,j)
Cu=(fi(i,j,k)*hi(i,j,k)-dt*CExx)/hi(i,j,k)
CExx=(max(fhx(i ,j ,k)-flx(i ,j ,k),0.) &
-min(fhx(i-1,j ,k)-flx(i-1,j ,k),0.))/delxu(i,j) &
+(max(fhy(i ,j ,k)-fly(i ,j ,k),0.) &
-min(fhy(i ,j-1,k)-fly(i ,j-1,k),0.))/delyv(i,j)
CExx=(max(fhx(i ,j ,k)-flx(i ,j ,k),_ZERO_) &
-min(fhx(i-1,j ,k)-flx(i-1,j ,k),_ZERO_))/delxu(i,j) &
+(max(fhy(i ,j ,k)-fly(i ,j ,k),_ZERO_) &
-min(fhy(i ,j-1,k)-fly(i ,j-1,k),_ZERO_))/delyv(i,j)
Cl=(fi(i,j,k)*hi(i,j,k)-dt*CExx)/hi(i,j,k)
! calculating the maximum limiters rp and rm for each conc. cell
if (Cu.eq.fi(i,j,k)) then
rp(i,j,k)=0.
if (Cu .eq. fi(i,j,k)) then
rp(i,j,k)=_ZERO_
else
rp(i,j,k)=min((cmax(i,j,k)-fi(i,j,k))/(Cu-fi(i,j,k)),1.)
rp(i,j,k)=min((cmax(i,j,k)-fi(i,j,k))/(Cu-fi(i,j,k)),_ONE_)
end if
if (Cl.eq.fi(i,j,k)) then
rm(i,j,k)=0.
if (Cl .eq. fi(i,j,k)) then
rm(i,j,k)=_ZERO_
else
rm(i,j,k)=min((fi(i,j,k)-cmin(i,j,k))/(fi(i,j,k)-Cl),1.)
rm(i,j,k)=min((fi(i,j,k)-cmin(i,j,k))/(fi(i,j,k)-Cl),_ONE_)
end if
end if
end do
......@@ -339,7 +342,7 @@
fac=min(rm(i+1,j,k),rp(i,j,k))
end if
fhx(i,j,k)=(1.-fac)*flx(i,j,k)+fac*fhx(i,j,k)
if ((AH.gt.0.).and.(az(i,j).gt.0).and.(az(i+1,j).gt.0)) &
if ((AH .gt. _ZERO_) .and. (az(i,j) .gt. 0) .and. (az(i+1,j) .gt. 0)) &
fhx(i,j,k)=fhx(i,j,k)-AH*(f(i+1,j,k)-f(i,j,k))/delxu(i,j) &
*0.5*(hn(i+1,j,k)+hn(i,j,k))
end do
......@@ -356,7 +359,7 @@
fac=min(rm(i,j+1,k),rp(i,j,k))
end if
fhy(i,j,k)=(1.-fac)*fly(i,j,k)+fac*fhy(i,j,k)
if ((AH.gt.0.).and.(az(i,j).gt.0).and.(az(i,j+1).gt.0)) &
if ((AH .gt. 0.) .and. (az(i,j) .gt. 0) .and. (az(i,j+1) .gt. 0)) &
fhy(i,j,k)=fhy(i,j,k)-AH*(f(i,j+1,k)-f(i,j,k))/delyv(i,j) &
*0.5*(hn(i,j+1,k)+hn(i,j,k))
end do
......@@ -375,8 +378,8 @@
+fhy(i,j ,k)*delxv(i,j )-fhy(i,j-1,k)*delxv(i,j-1) &
)*area_inv(i,j)))/hi(i,j,k)
! Force monotonicity, this is needed here for correcting truncations errors:
if (f(i,j,k).gt.cmax(i,j,k)) f(i,j,k)=cmax(i,j,k)
if (f(i,j,k).lt.cmin(i,j,k)) f(i,j,k)=cmin(i,j,k)
if (f(i,j,k) .gt. cmax(i,j,k)) f(i,j,k)=cmax(i,j,k)
if (f(i,j,k) .lt. cmin(i,j,k)) f(i,j,k)=cmin(i,j,k)
end if
end do
end do
......
!$Id: spm.F90,v 1.3 2003-04-23 12:16:34 kbk Exp $
!$Id: spm.F90,v 1.4 2004-01-07 07:37:37 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -44,7 +44,10 @@
! Original author(s): Manuel Ruiz Villarreal, Karsten Bolding and Hans Burchard
!
! $Log: spm.F90,v $
! Revision 1.3 2003-04-23 12:16:34 kbk
! Revision 1.4 2004-01-07 07:37:37 kbk
! to compile with IFORT - TABS, etc.
!
! Revision 1.3 2003/04/23 12:16:34 kbk
! cleaned code + TABS to spaces
!
! Revision 1.2 2003/04/07 13:36:38 kbk
......@@ -251,12 +254,12 @@
if(erosed_flux) then
if(spm_pool(i,j) > 1.e-12) then ! If there are sediments in the pool
Erosion_Flux = spm_erosion_const / rho_0 * (taub(i,j)*rho_0-spm_tauc_erosion )
Erosion_Flux = max(Erosion_Flux,0.)
Erosion_Flux = max(Erosion_Flux,_ZERO_)
else
Erosion_Flux = _ZERO_
end if
Sedimentation_Flux = spm_ws(i,j,1) * spm(i,j,1) *(1.-taub(i,j)*rho_0 / spm_tauc_sedimentation)
Sedimentation_Flux = max(Sedimentation_Flux,0.)
Sedimentation_Flux = max(Sedimentation_Flux,_ZERO_)
a4(1) = Erosion_Flux - Sedimentation_Flux
if (a4(1) > 1e-12) a4(1) = min(spm_pool(i,j)/dt, a4(1))
spm_pool(i,j) = spm_pool(i,j) - dt * a4(1)
......
......@@ -43,7 +43,10 @@
! Original author(s): Hans Burchard & Karsten Bolding
!
! $Log: diagnose.F90,v $
! Revision 1.3 2003-04-23 12:07:12 kbk
! Revision 1.4 2004-01-07 07:37:37 kbk
! to compile with IFORT - TABS, etc.
!
! Revision 1.3 2003/04/23 12:07:12 kbk
! cleaned code + TABS to spaces
!
! Revision 1.2 2003/04/07 12:32:58 kbk
......@@ -93,8 +96,8 @@
#endif
REALTYPE aa(1:500,0:25)
#ifdef HAIDVOGEL_TEST
REALTYPE :: MKE,APE,APE0,densi,zs,zzz
LOGICAL,save :: FIRST=.true.
REALTYPE :: MKE,APE,APE0,densi,zs,zzz
LOGICAL,save :: FIRST=.true.
#endif
!
!EOP
......@@ -221,11 +224,11 @@
write(92,*) loop,U(i,j)/DU(i,j),z(i,j)
do j=2,jmax-1
i=1
Flux1=Flux1+U(i,j)*DYU
i=imax/3
Flux2=Flux2+U(i,j)*DYU
i=imax/2
Flux3=Flux3+U(i,j)*DYU
Flux1=Flux1+U(i,j)*DYU
i=imax/3
Flux2=Flux2+U(i,j)*DYU
i=imax/2
Flux3=Flux3+U(i,j)*DYU
end do
write(97,*) loop,Flux1,Flux2,Flux3
......@@ -233,17 +236,17 @@
#ifdef PECS
if (abs(loop/100-loop/100.).lt.1.e-10) then
write(80,*) 'loop #',loop
do i=imin,imax
do j=jmin,jmax
do i=imin,imax
do j=jmin,jmax
if (S(i,j,1).gt.13) then
write(80,*) xx(i,j),yx(i,j)
write(80,*) xx(i-1,j),yx(i-1,j)
write(80,*) xx(i-1,j-1),yx(i-1,j-1)
write(80,*) xx(i,j-1),yx(i,j-1)
write(80,*) '>'
end if
end do
end do
write(80,*) xx(i,j),yx(i,j)
write(80,*) xx(i-1,j),yx(i-1,j)
write(80,*) xx(i-1,j-1),yx(i-1,j-1)
write(80,*) xx(i,j-1),yx(i,j-1)
write(80,*) '>'
end if
end do
end do
end if
#endif
if (loop.eq.n) then
......@@ -256,16 +259,16 @@
write(91,*) V(i,j)/DV(i,j)+V(i+1,j)/DV(i+1,j),yx(i,j)
! write(91,*) V(i,j)/DV(i,j)+V(i+1,j)/DV(i+1,j),xx(i,j)
end do
j=jmax/2
j=jmax/2
do i=1,imax
uup=0.5*(U(i-1,j+1)/DU(i-1,j+1)+U(i,j+1)/DU(i,j+1))
udn=0.5*(U(i-1,j)/DU(i-1,j)+U(i,j)/DU(i,j))
vup=0.5*(V(i,j+1)/DV(i,j+1)+V(i,j)/DV(i,j))
vdn=0.5*(V(i,j-1)/DV(i,j-1)+V(i,j)/DV(i,j))
velup=sqrt(uup**2+vup**2)
veldn=sqrt(udn**2+vdn**2)
uup=velup*cos(2.*pi*angle(i,j)/360.)
vup=velup*sin(2.*pi*angle(i,j)/360.)
uup=0.5*(U(i-1,j+1)/DU(i-1,j+1)+U(i,j+1)/DU(i,j+1))
udn=0.5*(U(i-1,j)/DU(i-1,j)+U(i,j)/DU(i,j))
vup=0.5*(V(i,j+1)/DV(i,j+1)+V(i,j)/DV(i,j))
vdn=0.5*(V(i,j-1)/DV(i,j-1)+V(i,j)/DV(i,j))
velup=sqrt(uup**2+vup**2)
veldn=sqrt(udn**2+vdn**2)
uup=velup*cos(2.*pi*angle(i,j)/360.)
vup=velup*sin(2.*pi*angle(i,j)/360.)
write(93,*) 0.5*(vup+vdn),0.5*(z(i,j)+z(i,j+1)),xv(i,j)
write(94,*) 0.5*(uup+udn),xx(i,j)
end do
......@@ -275,10 +278,10 @@
j=jmax/2
do i=1,imax-1
write(95,*) V(i,j)/DV(i,j),0.5*(z(i,j)+z(i,j+1)),(i-0.5)*dx
end do
end do
do i=1,imax-2
write(96,*) 0.5*(U(i,j)/DU(i,j)+U(i,j+1)/DU(i,j+1)),i*dx
end do
end do
i=imax/2
do j=2,jmax-1
write(90,*) U(i,j)/DU(i,j),0.5*(z(i,j)+z(i+1,j)),(j-1-0.5)*dy
......@@ -286,7 +289,7 @@
do j=2,jmax-2
write(91,*) V(i,j)/DV(i,j)+V(i+1,j)/DV(i+1,j),(j-1)*dy
end do
j=jmax/2
j=jmax/2
do i=1,imax
write(93,*) V(i,j)/DV(i,j),0.5*(z(i,j)+z(i,j+1)),(i-0.5)*dx
end do
......@@ -305,19 +308,19 @@
do k=1,kmax
do j=1,jmax
do i=1,imax
MKE=MKE+0.5*1025.*(uu(i,j,k)**2/hun(i,j,k)*dx*dy+vv(i,j,k)**2/hvn(i,j,k)*dx*dy)
end do
MKE=MKE+0.5*1025.*(uu(i,j,k)**2/hun(i,j,k)*dx*dy+vv(i,j,k)**2/hvn(i,j,k)*dx*dy)
end do
end do
end do
do j=1,jmax
do i=1,imax
zs=z(i,j)
do k=kmax,1,-1
zs=zs-0.5*hn(i,j,k)
densi=1025.-rho(i,j,k)*1025./9.82
APE=APE+dx*dy*9.82*hn(i,j,k)*densi*zs
zs=zs-0.5*hn(i,j,k)
end do
zs=zs-0.5*hn(i,j,k)
densi=1025.-rho(i,j,k)*1025./9.82
APE=APE+dx*dy*9.82*hn(i,j,k)*densi*zs
zs=zs-0.5*hn(i,j,k)
end do
end do
end do
if (FIRST) then
......@@ -328,8 +331,8 @@
do i=2,129
do j=2,4
zzz=zzz+z(i,j)
end do
end do
end do
end do
write(80,996) loop*dt/3600./24./float(M),MKE,APE-APE0,MKE+APE-APE0
end if
#endif
......@@ -349,8 +352,8 @@
do k=1,kmax
do j=1,jmax
do i=1,imax
MKE=MKE+0.5*1025.858*uu(i,j,k)**2/hun(i,j,k)*dx*dy+vv(i,j,k)**2/hvn(i,j,k)*dx*dy
end do
MKE=MKE+0.5*1025.858*uu(i,j,k)**2/hun(i,j,k)*dx*dy+vv(i,j,k)**2/hvn(i,j,k)*dx*dy
end do
end do
end do
do j=5,jmax-4
......@@ -358,12 +361,12 @@
zs=z(i,j)
do k=kmax,1,-1
zzz=-(kmax-k+0.5)*(20./float(kmax))
zs=zs-0.5*hn(i,j,k)
densi=1025.-rho(i,j,k)*1025./9.82
! write(90,*) i,j,k,S(i,j,k),densi
APE=APE+dx*dy*9.82*(hn(i,j,k)*densi*zs-20./float(kmax)*1025.858*zzz)
zs=zs-0.5*hn(i,j,k)
end do
zs=zs-0.5*hn(i,j,k)
densi=1025.-rho(i,j,k)*1025./9.82
! write(90,*) i,j,k,S(i,j,k),densi
APE=APE+dx*dy*9.82*(hn(i,j,k)*densi*zs-20./float(kmax)*1025.858*zzz)
zs=zs-0.5*hn(i,j,k)
end do
end do
end do
salmin=10000.
......@@ -372,14 +375,14 @@
do j=1,jmax
do i=1,imax
do k=kmax,1,-1
if (S(i,j,k).gt.salmax) then
salmax=S(i,j,k)
salimax=i
saljmax=j
end if
if (S(i,j,k).lt.salmin) salmin=S(i,j,k)
if ((S(i,j,k).lt.34.839).and.(k.eq.kmax)) area=area+dx*dy
end do
if (S(i,j,k).gt.salmax) then
salmax=S(i,j,k)
salimax=i
saljmax=j
end if
if (S(i,j,k).lt.salmin) salmin=S(i,j,k)
if ((S(i,j,k).lt.34.839).and.(k.eq.kmax)) area=area+dx*dy
end do
end do
end do
write(99,994) loop,MKE,APE,MKE+APE,salmin,salmax,area
......@@ -390,13 +393,13 @@
if (loop.eq.n) then
do i=5,imax-4
do j=5,jmax-4
write(96,995) (i-4.5)*30./float(imax-8), &
(j-4.5)*30./float(jmax-8),S(i,j,kmax), &
0.5*(uu(i,j,kmax)/hun(i,j,kmax)+uu(i-1,j,kmax)/hun(i-1,j,kmax)), &
0.5*(vv(i,j,kmax)/hvn(i,j,kmax)+vv(i,j-1,kmax)/hvn(i,j-1,kmax)), &
0.5*(uu(i,j,1)/hun(i,j,1)+uu(i-1,j,1)/hun(i-1,j,1)), &
0.5*(vv(i,j,1)/hvn(i,j,1)+vv(i,j-1,1)/hvn(i,j-1,1))
end do
write(96,995) (i-4.5)*30./float(imax-8), &
(j-4.5)*30./float(jmax-8),S(i,j,kmax), &
0.5*(uu(i,j,kmax)/hun(i,j,kmax)+uu(i-1,j,kmax)/hun(i-1,j,kmax)), &
0.5*(vv(i,j,kmax)/hvn(i,j,kmax)+vv(i,j-1,kmax)/hvn(i,j-1,kmax)), &
0.5*(uu(i,j,1)/hun(i,j,1)+uu(i-1,j,1)/hun(i-1,j,1)), &
0.5*(vv(i,j,1)/hvn(i,j,1)+vv(i,j-1,1)/hvn(i,j-1,1))
end do
end do
end if
#endif
......@@ -435,7 +438,7 @@
write(96,*) j*6.,aa(j,k-1)
write(96,*) j*6.,aa(j,k)
write(96,*)
end if
end if
end do
end do
stop
......@@ -450,8 +453,8 @@
do k=1,kmax
do j=1,jmax
do i=1,imax
MKE=MKE+uu(i,j,k)**2/hun(i,j,k)+vv(i,j,k)**2/hvn(i,j,k)
end do
MKE=MKE+uu(i,j,k)**2/hun(i,j,k)+vv(i,j,k)**2/hvn(i,j,k)
end do
end do
end do
MKE=MKE*0.5*dx*dy*1025.
......@@ -473,12 +476,12 @@
if ((abs(loop/14400-loop/14400.).lt.1e-10).or.(loop.eq.10)) then
do i=imin,imax
do j=jmin,jmax
out=85+loop/14400
out=85+loop/14400
write(out,995) (i-0.5)*0.5,(j-0.5)*0.5,T(i,j,kmax), &
0.5*(uu(i,j,kmax)/hun(i,j,kmax)+uu(i-1,j,kmax)/hun(i-1,j,kmax)), &
0.5*(vv(i,j,kmax)/hvn(i,j,kmax)+vv(i,j-1,kmax)/hvn(i,j-1,kmax)), &
z(i,j)
end do
z(i,j)
end do
end do
end if
i=12
......
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