Commit b7ebcd62 authored by kbk's avatar kbk
Browse files

parallel support

parent ade970af
......@@ -25,7 +25,6 @@
! !USES:
use domain, only: imin,imax,jmin,jmax
use domain, only: iimin,iimax,jjmin,jjmax,kmax
IMPLICIT NONE
!
private
......@@ -48,8 +47,11 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: advection_3d.F90,v $
! Revision 1.1 2002-05-02 14:00:58 gotm
! Initial revision
! Revision 1.2 2003-04-07 16:30:53 kbk
! parallel support
!
! Revision 1.1.1.1 2002/05/02 14:00:58 gotm
! recovering after CVS crash
!
! Revision 1.18 2001/09/19 13:53:08 bbh
! Typo
......@@ -106,7 +108,6 @@
! Revision 1.1 2001/05/03 20:20:33 bbh
! Stubs for baroclinicity
!
!
! !LOCAL VARIABLES:
integer :: advection_method
!EOP
......@@ -152,8 +153,7 @@
LEVEL1 'init_advection_3d()'
#ifdef STATIC
#else
#ifndef STATIC
allocate(cu(I3DFIELD),stat=rc) ! work array
if (rc /= 0) stop 'init_advection_3d: Error allocating memory (cu)'
......@@ -164,9 +164,7 @@
if (rc /= 0) stop 'init_advection_3d: Error allocating memory (hio)'
#endif
cu = _ZERO_
hi = _ZERO_
hio = _ZERO_
cu = _ZERO_ ; hi = _ZERO_ ; hio = _ZERO_
#ifdef DEBUG
write(debug,*) 'Leaving init_advection_3d()'
......@@ -202,9 +200,9 @@
integer, intent(in) :: hor_adv,ver_adv,strang
!
! !INPUT/OUTPUT PARAMETERS:
REALTYPE, intent(inout) :: f(I3DFIELD)
!
! !OUTPUT PARAMETERS:
REALTYPE, intent(out) :: f(I3DFIELD)
!
! !REVISION HISTORY:
! See the log for the module
......@@ -252,9 +250,9 @@
#endif
end if
call v_split_adv(dt,f,vv,hvn,delxv,delyv,area_inv,av,a1, &
hor_adv,az,AH)
hor_adv,az,AH)
call u_split_adv(dt,f,uu,hun,delxu,delyu,area_inv,au,a1, &
hor_adv,az,AH)
hor_adv,az,AH)
case default
FATAL 'Not valid strang parameter'
end select
......@@ -285,17 +283,17 @@
IMPLICIT NONE
!
! !INPUT PARAMETERS:
REALTYPE :: uu(I3DFIELD),vv(I3DFIELD),ww(I3DFIELD)
REALTYPE :: ho(I3DFIELD),hn(I3DFIELD)
REALTYPE :: delxv(I2DFIELD),delyu(I2DFIELD)
REALTYPE :: delxu(I2DFIELD),delyv(I2DFIELD)
REALTYPE :: area_inv(I2DFIELD),dt,AH
REALTYPE, intent(in) :: uu(I3DFIELD),vv(I3DFIELD),ww(I3DFIELD)
REALTYPE, intent(in) :: ho(I3DFIELD),hn(I3DFIELD)
REALTYPE, intent(in) :: delxv(I2DFIELD),delyu(I2DFIELD)
REALTYPE, intent(in) :: delxu(I2DFIELD),delyv(I2DFIELD)
REALTYPE, intent(in) :: area_inv(I2DFIELD),dt,AH
integer, intent(in) :: az(E2DFIELD)
REALTYPE :: f(I3DFIELD)
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
REALTYPE, intent(inout) :: f(I3DFIELD)
!
! !REVISION HISTORY:
! See the log for the module
......@@ -316,76 +314,69 @@
allocate(adv(I3DFIELD),stat=rc) ! work array
if (rc /= 0) stop 'upstream_adv: Error allocating memory (adv)'
cu(iimin-1:iimin-1,jjmin:jjmax,0:kmax)= _ZERO_
cu(iimax:iimax,jjmin:jjmax,0:kmax)= _ZERO_
adv = _ZERO_
cu = _ZERO_
do k=1,kmax ! Calculating u-interface fluxes !
do j=jjmin,jjmax
do i=iimin,iimax-1
do i=iimin-1,iimax
if (uu(i,j,k) .gt. _ZERO_) then
cu(i,j,k)=uu(i,j,k)*f(i,j,k)
else
else
cu(i,j,k)=uu(i,j,k)*f(i+1,j,k)
end if
end if
if ((AH.gt.0.).and.(az(i,j).gt.0).and.(az(i+1,j).gt.0)) &
cu(i,j,k)=cu(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))
*0.5*(hn(i+1,j,k)+hn(i,j,k))
end do
end do
end do
do k=1,kmax ! Updating the advection term for u-advection !
do j=jjmin,jjmax
do i=iimin,iimax
adv(i,j,k)=(cu(i,j,k)*delyu(i,j) &
-cu(i-1,j,k)*delyu(i-1,j))*area_inv(i,j)
adv(i,j,k)=(cu(i ,j,k)*delyu(i ,j) &
-cu(i-1,j,k)*delyu(i-1,j))*area_inv(i,j)
end do
end do
end do
cu(iimin:iimax,jjmin-1:jjmin-1,0:kmax)= _ZERO_
cu(iimin:iimax,jjmax:jjmax,0:kmax)= _ZERO_
cu = _ZERO_
do k=1,kmax ! Calculating v-interface fluxes !
do j=jjmin,jjmax-1
do j=jjmin-1,jjmax
do i=iimin,iimax
if (vv(i,j,k) .gt. _ZERO_) then
cu(i,j,k)=vv(i,j,k)*f(i,j,k)
else
else
cu(i,j,k)=vv(i,j,k)*f(i,j+1,k)
end if
end if
if ((AH.gt.0.).and.(az(i,j).gt.0).and.(az(i,j+1).gt.0)) &
cu(i,j,k)=cu(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))
cu(i,j,k)=cu(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
end do
end do
do k=1,kmax ! Updating the advection term for v-advection !
do j=jjmin,jjmax
do i=iimin,iimax
adv(i,j,k)=adv(i,j,k)+(cu(i,j,k)*delxv(i,j) &
-cu(i,j-1,k)*delxv(i,j-1))*area_inv(i,j)
adv(i,j,k)=adv(i,j,k)+(cu(i,j ,k)*delxv(i,j ) &
-cu(i,j-1,k)*delxv(i,j-1))*area_inv(i,j)
end do
end do
end do
cu(iimin:iimax,jjmin:jjmax,0)= _ZERO_
cu(iimin:iimax,jjmin:jjmax,kmax)= _ZERO_
cu = _ZERO_
if (kmax.gt.1) then
do k=1,kmax-1 ! Calculating w-interface fluxes !
do j=jjmin,jjmax
do i=iimin,iimax
if (ww(i,j,k) .gt. _ZERO_) then
cu(i,j,k)=ww(i,j,k)*f(i,j,k)
else
else
cu(i,j,k)=ww(i,j,k)*f(i,j,k+1)
end if
end do
end do
end do
do k=1,kmax ! Updating the advection term for w-advection !
do j=jjmin,jjmax
do i=iimin,iimax
......@@ -398,8 +389,8 @@
do k=1,kmax ! Doing the full advection in one step
do j=jjmin,jjmax
do i=iimin,iimax
if (az(i,j).eq.1) &
f(i,j,k)=(f(i,j,k)*ho(i,j,k)-dt*adv(i,j,k))/hn(i,j,k)
if (az(i,j) .eq. 1) &
f(i,j,k)=(f(i,j,k)*ho(i,j,k)-dt*adv(i,j,k))/hn(i,j,k)
end do
end do
end do
......@@ -859,8 +850,6 @@
return
end subroutine w_split_adv
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!BOP
!
......@@ -932,7 +921,7 @@
do j=jjmin,jjmax
do i=iimin,iimax
if (az(i,j) .eq. 1) then
cmax=0.
cmax= _ZERO_
it=1
ready=.false.
111 do ii=1,it
......@@ -940,7 +929,7 @@
cu(i,j,k) = _ZERO_
if (ww(i,j,k) .gt. _ZERO_) then
c=ww(i,j,k)/float(it)*dt/(0.5*(hi(i,j,k)+hi(i,j,k+1)))
if (c.gt.cmax) cmax=c
if (c .gt. cmax) cmax=c
if (k .gt. 1) then
fu=f(i,j,k-1) ! upstream
else
......@@ -955,7 +944,7 @@
end if
else
c=-ww(i,j,k)/float(it)*dt/(0.5*(hi(i,j,k)+hi(i,j,k+1)))
if (c.gt.cmax) cmax=c
if (c .gt. cmax) cmax=c
if (k .lt. kmax-1) then
fu=f(i,j,k+2) ! upstream
else
......@@ -990,12 +979,13 @@
end select
cu(i,j,k)=ww(i,j,k)*(fc+0.5*limit*(1-c)*(fd-fc))
end do
if (.not.READY) then
if (.not. READY) then
it=min(200,int(cmax)+1)
if (it.gt.1) write(95,*) i,j,it,cmax
if (it.gt.1) write(*,*) i,j,it,cmax
#ifdef DEBUG
if (it .gt. 1) write(95,*) i,j,it,cmax
#endif
end if
if ((it.gt.1).and.(.not.READY)) then
if ((it .gt. 1) .and. (.not. READY)) then
READY=.true.
goto 111
end if
......@@ -1026,4 +1016,3 @@
!-----------------------------------------------------------------------
! Copyright (C) 2001 - Hans Burchard and Karsten Bolding !
!-----------------------------------------------------------------------
!$Id: bottom_friction_3d.F90,v 1.2 2003-04-01 15:25:33 gotm Exp $
!$Id: bottom_friction_3d.F90,v 1.3 2003-04-07 16:29:48 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -27,8 +27,8 @@
! Original author(s): Hans Burchard & Karsten Bolding
!
! $Log: bottom_friction_3d.F90,v $
! Revision 1.2 2003-04-01 15:25:33 gotm
! used save attribute on local variables
! Revision 1.3 2003-04-07 16:29:48 kbk
! parallel support
!
! Revision 1.1.1.1 2002/05/02 14:00:53 gotm
! recovering after CVS crash
......@@ -102,6 +102,9 @@
+vv(i ,j-1,kk)/hvo(i ,j-1,kk) &
+vv(i+1,j-1,kk)/hvo(i+1,j-1,kk) )
#endif
else
uuloc(i,j) = _ZERO_
uvloc(i,j) = _ZERO_
end if
end do
end do
......@@ -122,6 +125,9 @@
+ uu(i-1,j+1,kk)/huo(i-1,j+1,kk) )
#endif
vvloc(i,j)=vv(i,j,kk)/(hvo(i,j,kk))
else
vuloc(i,j) = _ZERO_
vvloc(i,j) = _ZERO_
end if
end do
end do
......
!$Id: coordinates.F90,v 1.1 2002-05-02 14:00:53 gotm Exp $
!$Id: coordinates.F90,v 1.2 2003-04-07 16:27:32 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -11,7 +11,7 @@
! !DESCRIPTION:
!
! !USES:
use commhalo, only: update_3d_halo,wait_halo,H_TAG,HU_TAG,HV_TAG
use halo_zones, only: update_3d_halo,wait_halo,H_TAG,HU_TAG,HV_TAG
use domain, only: iimin,iimax,jjmin,jjmax,kmax,H,HU,HV,az,au,av,min_depth
use domain, only: ga,ddu,ddl,d_gamma
use variables_3d, only: dt,kmin,kumin,kvmin,ho,hn,huo,hun,hvo,hvn
......@@ -30,8 +30,11 @@
! Original author(s): Hans Burchard & Karsten Bolding
!
! $Log: coordinates.F90,v $
! Revision 1.1 2002-05-02 14:00:53 gotm
! Initial revision
! Revision 1.2 2003-04-07 16:27:32 kbk
! parallel support
!
! Revision 1.1.1.1 2002/05/02 14:00:53 gotm
! recovering after CVS crash
!
! Revision 1.15 2001/10/26 07:42:27 bbh
! Correct values for sigma and general cordinates in ga
......@@ -196,7 +199,6 @@
end do
end do
end do
do k=1,kmax
do j=jjmin,jjmax
do i=iimin-1,iimax
......@@ -229,7 +231,6 @@
case (1) ! sigma coordinates
if (equiv_sigma) then
kmaxm1= _ONE_/float(kmax)
do j=jjmin,jjmax
do i=iimin,iimax
ho(i,j,:)=(sseo(i,j)+H(i,j))*kmaxm1
......@@ -273,7 +274,6 @@
end do
end do
end if
case (2) ! z-level
case (3) ! general vertical coordinates
......@@ -336,7 +336,6 @@
case default
end select
call update_3d_halo(ho,ho,az,iimin,jjmin,iimax,jjmax,kmax,H_TAG)
call update_3d_halo(hn,hn,az,iimin,jjmin,iimax,jjmax,kmax,H_TAG)
call update_3d_halo(huo,huo,au,iimin,jjmin,iimax,jjmax,kmax,HU_TAG)
......
!$Id: m3d.F90,v 1.3 2003-04-01 15:56:55 gotm Exp $
!$Id: m3d.F90,v 1.4 2003-04-07 16:28:34 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -20,19 +20,28 @@
! !USES:
use parameters, only: avmmol
use domain, only: vert_cord
use m2d, only: D,z,Am
use m2d, only: Am
use variables_2d, only: D,z
#ifndef NO_BAROCLINIC
use temperature,only: init_temperature, do_temperature
use salinity, only: init_salinity, do_salinity
use eqstate, only: init_eqstate, do_eqstate
#endif
#ifndef NO_BAROCLINIC
use suspended_matter, only: init_spm, do_spm
#endif
use advection_3d, only: init_advection_3d
use eqstate, only: init_eqstate, do_eqstate
use bdy_3d, only: init_bdy_3d, do_bdy_3d
use variables_3d
#ifdef PARALLEL
use halo_mpi
#endif
IMPLICIT NONE
!
! !PUBLIC DATA MEMBERS:
integer :: M=1
REALTYPE :: cord_relax=0.
REALTYPE :: cord_relax=_ZERO_
logical :: calc_temp=.true.,calc_salt=.true.,calc_spm=.false.
logical :: bdy3d=.false.
integer :: bdyfmt_3d,bdyramp_3d
......@@ -42,11 +51,8 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: m3d.F90,v $
! Revision 1.3 2003-04-01 15:56:55 gotm
! initialise T, S and rho
!
! Revision 1.2 2003/04/01 15:27:56 gotm
! cleaned the code
! Revision 1.4 2003-04-07 16:28:34 kbk
! parallel support
!
! Revision 1.1.1.1 2002/05/02 14:00:51 gotm
! recovering after CVS crash
......@@ -199,7 +205,6 @@
! rewind(NAMLST)
! Allocates memory for the public data members - if not static
call init_variables_3d(runtype)
LEVEL2 'vel_hor_adv= ',vel_hor_adv
......@@ -213,38 +218,17 @@
stop 'init_3d'
#endif
end if
dt = M*timestep
hn= _ZERO_
uu= _ZERO_
vv= _ZERO_
ww= _ZERO_
rru= _ZERO_
rrv= _ZERO_
uuEx= _ZERO_
vvEx= _ZERO_
tke=1.e-10
eps=1.e-10
num=avmmol
nuh=avmmol
#ifdef UV_TVD
uadv = _ZERO_
vadv = _ZERO_
wadv = _ZERO_
huadv = _ZERO_
hvadv = _ZERO_
hoadv = _ZERO_
hnadv = _ZERO_
#endif
! Needed for interpolation of temperature and salinity
if (.not.hotstart) then
if (.not. hotstart) then
call start_macro()
call coordinates(vert_cord,cord_relax)
end if
end if
#ifndef NO_BAROCLINIC
if (runtype .eq. 3 .or. runtype .eq. 4) then
T = _ZERO_ ; S = _ZERO_ ; rho = _ZERO_
if(calc_temp) call init_temperature(1)
......@@ -259,6 +243,7 @@
call init_advection_3d(2)
end if
end if
#endif
if (bdy3d) call init_bdy_3d()
......@@ -281,7 +266,6 @@
!
! !INPUT PARAMETERS:
integer, intent(in) :: runtype,n
!
! !INPUT/OUTPUT PARAMETERS:
!
......@@ -304,19 +288,22 @@
Ncall = Ncall+1
write(debug,*) 'integrate_3d() # ',Ncall
#endif
call start_macro()
#ifndef NO_BAROCLINIC
if (bdy3d) call do_bdy_3d(0,T)
#endif
call coordinates(vert_cord,cord_relax)
#ifndef NO_BOTTFRIC
if (kmax.gt.1) then
if (kmax .gt. 1) then
call bottom_friction_3d()
end if
#endif
SS = _ZERO_
#ifndef NO_BAROCLINIC
NN = _ZERO_
if (runtype .eq. 4) call internal_pressure()
#endif
if (ufirst) then
call uu_momentum_3d(bdy3d)
call vv_momentum_3d(bdy3d)
......@@ -330,7 +317,7 @@
call ww_momentum_3d()
end if
#ifndef NO_ADVECT
if (kmax.gt.1) then
if (kmax .gt. 1) then
call uv_advect_3d(vel_hor_adv,vel_ver_adv,vel_strang)
if (Am .gt. _ZERO_) then
call uv_diffusion_3d(Am) ! Must be called after uv_advect_3d
......@@ -339,12 +326,13 @@
#else
STDERR 'NO_ADVECT 3D'
#endif
#ifdef CONST_VISC
num = 1.000e-4
nuh = 0.000e-5
nuh = 1.000e-5
#else
#ifndef NO_BOTTFRIC
if (kmax.gt.1) then
if (kmax .gt. 1) then
call stresses_3d()
#ifndef PARABOLIC_VISCOSITY
call ss_nn()
......@@ -353,6 +341,7 @@
end if
#endif
#endif
#ifndef NO_BAROCLINIC
if(runtype .eq. 4) then ! prognostic T and S
if (calc_temp) call do_temperature(n)
if (calc_salt) call do_salinity(n)
......@@ -361,17 +350,18 @@
call do_eqstate()
#endif
end if
#endif
if (kmax.gt.1) then
if (kmax .gt. 1) then
#ifndef NO_BOTTFRIC
call slow_bottom_friction()
call slow_bottom_friction()
#endif
#ifndef NO_ADVECT
#ifndef UV_ADV_DIRECT
call slow_advection()
if (Am .gt. _ZERO_) then
call slow_diffusion(Am) ! Has to be called after slow_advection.
end if
call slow_advection()
if (Am .gt. _ZERO_) then
call slow_diffusion(Am) ! Has to be called after slow_advection.
end if
#endif
#endif
end if
......
!$Id: start_macro.F90,v 1.3 2003-04-07 11:31:23 gotm Exp $
!$Id: start_macro.F90,v 1.4 2003-04-07 16:27:32 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -11,7 +11,7 @@
! !DESCRIPTION:
!
! !USES:
use commhalo, only: update_2d_halo,z_TAG,U_TAG,V_TAG
use halo_zones, only: update_2d_halo,z_TAG,U_TAG,V_TAG
use domain, only: iimin,iimax,jjmin,jjmax,H,HU,HV,min_depth
use m2d, only: MM,z,Uint,Vint
use m3d, only: M,dt
......@@ -28,11 +28,8 @@
! Original author(s): Hans Burchard & Karsten Bolding
!
! $Log: start_macro.F90,v $
! Revision 1.3 2003-04-07 11:31:23 gotm
! fixed error in assigning ssen
!
! Revision 1.2 2003/04/01 15:30:21 gotm
! default compilation without Sylt specific fix
! Revision 1.4 2003-04-07 16:27:32 kbk
! parallel support
!
! Revision 1.1.1.1 2002/05/02 14:00:55 gotm
! recovering after CVS crash
......
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