Skip to content

GitLab

G
getm
Commit 3edf40eb authored by Knut's avatar Knut
Browse files
Options

new numerical tracer variance decay analysis (old with -D_NUMERICAL_ANALYSES_OLD_)

parent f70e2535
Hide whitespace changes
Inline Side-by-side
Showing with 546 additions and 79 deletions
src/2d/adv_split_u.F90
View file @ 3edf40eb
......@@ -10,7 +10,8 @@
dxu,dyu,arcd1, &
#endif
splitfac,scheme,AH, &
mask_flux,mask_update)
mask_flux,mask_update, &
nvd)
! Note (KK): Keep in sync with interface in advection.F90
!
! !DESCRIPTION:
......@@ -181,12 +182,13 @@
!
! !INPUT/OUTPUT PARAMETERS:
REALTYPE,dimension(E2DFIELD),intent(inout) :: fi,Di,adv
REALTYPE,dimension(:,:),pointer,intent(inout) :: nvd
!
! !LOCAL VARIABLES:
REALTYPE,dimension(E2DFIELD) :: uflux
logical :: use_limiter,use_AH
REALTYPE,dimension(E2DFIELD) :: uflux,uflux2
logical :: use_limiter,use_AH,calc_nvd
integer :: i,j,isub
REALTYPE :: dti,Dio,advn,cfl,fuu,fu,fd
REALTYPE :: dti,fio,Dio,advn,adv2n,cfl,fuu,fu,fd
!
! !REVISION HISTORY:
! Original author(s): Hans Burchard & Karsten Bolding
......@@ -210,11 +212,12 @@
use_limiter = .false.
use_AH = (AH .gt. _ZERO_)
calc_nvd = associated(nvd)
dti = splitfac*dt
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP FIRSTPRIVATE(j,use_limiter) &
!$OMP PRIVATE(i,Dio,advn,cfl,fuu,fu,fd)
!$OMP PRIVATE(i,fio,Dio,advn,adv2n,cfl,fuu,fu,fd)
! Calculating u-interface fluxes !
!$OMP DO SCHEDULE(RUNTIME)
......@@ -250,13 +253,15 @@
if (use_limiter) then
fu = adv_interfacial_reconstruction(scheme,cfl,fuu,fu,fd)
end if
uflux(i,j) = U(i,j)*fu
uflux (i,j) = U(i,j)*fu
uflux2(i,j) = uflux(i,j)*fu
if (use_AH) then
! Horizontal diffusion
uflux(i,j) = uflux(i,j) - AH*DU(i,j)*(f(i+1,j)-f(i ,j))/DXU
end if
else
uflux(i,j) = _ZERO_
uflux (i,j) = _ZERO_
uflux2(i,j) = _ZERO_
end if
end do
#ifndef SLICE_MODEL
......@@ -271,13 +276,23 @@
do i=imin-HALO+1+isub,imax+HALO-1-isub
if (mask_update(i,j)) then
! Note (KK): exclude x-advection of tracer and u across W/E open bdys
fio = fi(i,j)
Dio = Di(i,j)
Di(i,j) = Dio - dti*( U(i ,j)*DYU &
-U(i-1,j)*DYUIM1)*ARCD1
advn = splitfac*( uflux(i ,j)*DYU &
-uflux(i-1,j)*DYUIM1)*ARCD1
fi(i,j) = ( Dio*fi(i,j) - dt*advn ) / Di(i,j)
fi(i,j) = ( Dio*fio - dt*advn ) / Di(i,j)
adv(i,j) = adv(i,j) + advn
if (calc_nvd) then
adv2n = splitfac*( uflux2(i ,j)*DYU &
-uflux2(i-1,j)*DYUIM1)*ARCD1
! nvd(i,j) = nvd(i,j) &
! -((Di(i,j)*fi(i,j)**2 - Dio*fio**2)/dt + adv2n)
nvd(i,j) = ( Dio*nvd(i,j) &
-((Di(i,j)*fi(i,j)**2 - Dio*fio**2)/dt + adv2n) &
)/Di(i,j)
end if
end if
end do
#ifndef SLICE_MODEL
......
src/2d/adv_split_v.F90
View file @ 3edf40eb
......@@ -10,7 +10,8 @@
dxv,dyv,arcd1, &
#endif
splitfac,scheme,AH, &
mask_flux,mask_update)
mask_flux,mask_update, &
nvd)
! Note (KK): Keep in sync with interface in advection.F90
!
! !DESCRIPTION:
......@@ -42,12 +43,13 @@
!
! !INPUT/OUTPUT PARAMETERS:
REALTYPE,dimension(E2DFIELD),intent(inout) :: fi,Di,adv
REALTYPE,dimension(:,:),pointer,intent(inout) :: nvd
!
! !LOCAL VARIABLES:
REALTYPE,dimension(E2DFIELD) :: vflux
logical :: use_limiter,use_AH
REALTYPE,dimension(E2DFIELD) :: vflux,vflux2
logical :: use_limiter,use_AH,calc_nvd
integer :: i,j,jsub
REALTYPE :: dti,Dio,advn,cfl,fuu,fu,fd
REALTYPE :: dti,fio,Dio,advn,adv2n,cfl,fuu,fu,fd
!
! !REVISION HISTORY:
! Original author(s): Hans Burchard & Karsten Bolding
......@@ -68,11 +70,12 @@
use_limiter = .false.
use_AH = (AH .gt. _ZERO_)
calc_nvd = associated(nvd)
dti = splitfac*dt
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP FIRSTPRIVATE(use_limiter) &
!$OMP PRIVATE(i,j,Dio,advn,cfl,fuu,fu,fd)
!$OMP PRIVATE(i,j,fio,Dio,advn,adv2n,cfl,fuu,fd)
! Calculating v-interface fluxes !
!$OMP DO SCHEDULE(RUNTIME)
......@@ -106,13 +109,15 @@
if (use_limiter) then
fu = adv_interfacial_reconstruction(scheme,cfl,fuu,fu,fd)
end if
vflux(i,j) = V(i,j)*fu
vflux (i,j) = V(i,j)*fu
vflux2(i,j) = vflux(i,j)*fu
if (use_AH) then
! Horizontal diffusion
vflux(i,j) = vflux(i,j) - AH*DV(i,j)*(f(i,j+1)-f(i,j ))/DYV
end if
else
vflux(i,j) = _ZERO_
vflux (i,j) = _ZERO_
vflux2(i,j) = _ZERO_
end if
end do
end do
......@@ -123,13 +128,23 @@
do i=imin-HALO,imax+HALO
if (mask_update(i,j)) then
! Note (KK): exclude y-advection of tracer and v across N/S open bdys
fio = fi(i,j)
Dio = Di(i,j)
Di(i,j) = Dio - dti*( V(i,j )*DXV &
-V(i,j-1)*DXVJM1)*ARCD1
advn = splitfac*( vflux(i,j )*DXV &
-vflux(i,j-1)*DXVJM1)*ARCD1
fi(i,j) = ( Dio*fi(i,j) - dt*advn ) / Di(i,j)
fi(i,j) = ( Dio*fio - dt*advn ) / Di(i,j)
adv(i,j) = adv(i,j) + advn
if (calc_nvd) then
adv2n = splitfac*( vflux2(i,j )*DXV &
-vflux2(i,j-1)*DXVJM1)*ARCD1
! nvd(i,j) = nvd(i,j) &
! -((Di(i,j)*fi(i,j)**2 - Dio*fio**2)/dt + adv2n)
nvd(i,j) = ( Dio*nvd(i,j) &
-((Di(i,j)*fi(i,j)**2 - Dio*fio**2)/dt + adv2n) &
)/Di(i,j)
end if
end if
end do
end do
......
src/2d/advection.F90
View file @ 3edf40eb
......@@ -94,7 +94,8 @@
dxu,dyu,arcd1, &
#endif
splitfac,scheme,AH, &
mask_flux,mask_update)
mask_flux,mask_update, &
nvd)
use domain, only: imin,imax,jmin,jmax
IMPLICIT NONE
REALTYPE,intent(in) :: dt,splitfac,AH
......@@ -107,6 +108,7 @@
logical,dimension(:,:),pointer,intent(in) :: mask_flux
logical,dimension(E2DFIELD),intent(in) :: mask_update
REALTYPE,dimension(E2DFIELD),intent(inout) :: fi,Di,adv
REALTYPE,dimension(:,:),pointer,intent(inout) :: nvd
end subroutine adv_split_u
subroutine adv_split_v(dt,f,fi,Di,adv,V,DV, &
......@@ -114,7 +116,8 @@
dxv,dyv,arcd1, &
#endif
splitfac,scheme,AH, &
mask_flux,mask_update)
mask_flux,mask_update, &
nvd)
use domain, only: imin,imax,jmin,jmax
IMPLICIT NONE
REALTYPE,intent(in) :: dt,splitfac,AH
......@@ -127,6 +130,7 @@
logical,dimension(_IRANGE_HALO_,_JRANGE_HALO_-1),intent(in) :: mask_flux
logical,dimension(E2DFIELD),intent(in) :: mask_update
REALTYPE,dimension(E2DFIELD),intent(inout) :: fi,Di,adv
REALTYPE,dimension(:,:),pointer,intent(inout) :: nvd
end subroutine adv_split_v
subroutine adv_arakawa_j7_2dh(dt,f,fi,Di,adv,U,V,Dn,DU,DV, &
......@@ -364,7 +368,7 @@
!
! !INTERFACE:
subroutine do_advection(dt,f,U,V,DU,DV,Do,Dn,split,scheme,AH,tag, &
Dires,advres)
Dires,advres,nvd)
!
! !DESCRIPTION:
!
......@@ -427,11 +431,12 @@
!
! !OUTPUT PARAMETERS:
REALTYPE,dimension(E2DFIELD),target,intent(out),optional :: Dires,advres
REALTYPE,dimension(:,:),pointer,intent(out),optional :: nvd
!
! !LOCAL VARIABLES:
type(t_adv_grid),pointer :: adv_grid
REALTYPE,dimension(E2DFIELD),target :: fi,Di,adv
REALTYPE,dimension(:,:),pointer :: p_Di,p_adv
REALTYPE,dimension(:,:),pointer :: p_Di,p_adv,p_nvd
integer :: i,j
!
!EOP
......@@ -455,6 +460,15 @@
stop 'do_advection: tag is invalid'
end select
if (present(nvd)) then
p_nvd => nvd
if (associated(nvd)) then
nvd = _ZERO_
end if
else
p_nvd => null()
end if
if (present(Dires)) then
p_Di => Dires
else
......@@ -487,14 +501,16 @@
adv_grid%dxu,adv_grid%dyu,adv_grid%arcd1, &
#endif
_ONE_,scheme,AH, &
adv_grid%mask_uflux,adv_grid%mask_uupdate)
adv_grid%mask_uflux,adv_grid%mask_uupdate, &
p_nvd)
#ifndef SLICE_MODEL
call adv_split_v(dt,f,fi,p_Di,p_adv,V,DV, &
#if defined(SPHERICAL) || defined(CURVILINEAR)
adv_grid%dxv,adv_grid%dyv,adv_grid%arcd1, &
#endif
_ONE_,scheme,AH, &
adv_grid%mask_vflux,adv_grid%mask_vupdate)
adv_grid%mask_vflux,adv_grid%mask_vupdate, &
p_nvd)
#endif
#ifdef _NEW_ADV_NOSPLIT_
......@@ -575,7 +591,8 @@
adv_grid%dxu,adv_grid%dyu,adv_grid%arcd1, &
#endif
_ONE_,scheme,AH, &
adv_grid%mask_uflux,adv_grid%mask_uupdate)
adv_grid%mask_uflux,adv_grid%mask_uupdate, &
p_nvd)
#ifndef SLICE_MODEL
#ifdef GETM_PARALLEL
if (scheme.ne.UPSTREAM .and. tag.eq.V_TAG) then
......@@ -591,7 +608,8 @@
adv_grid%dxv,adv_grid%dyv,adv_grid%arcd1, &
#endif
_ONE_,scheme,AH, &
adv_grid%mask_vflux,adv_grid%mask_vupdate)
adv_grid%mask_vflux,adv_grid%mask_vupdate, &
p_nvd)
#endif
case((UPSTREAM_2DH),(J7),(FCT),(P2_2DH))
......@@ -615,7 +633,8 @@
adv_grid%dxu,adv_grid%dyu,adv_grid%arcd1, &
#endif
_HALF_,scheme,AH, &
adv_grid%mask_uflux,adv_grid%mask_uupdate)
adv_grid%mask_uflux,adv_grid%mask_uupdate, &
p_nvd)
#ifndef SLICE_MODEL
#ifdef GETM_PARALLEL
if (scheme.ne.UPSTREAM .and. tag.eq.V_TAG) then
......@@ -631,7 +650,8 @@
adv_grid%dxv,adv_grid%dyv,adv_grid%arcd1, &
#endif
_ONE_,scheme,AH, &
adv_grid%mask_vflux,adv_grid%mask_vupdate)
adv_grid%mask_vflux,adv_grid%mask_vupdate, &
p_nvd)
#endif
#ifdef GETM_PARALLEL
if (scheme .eq. UPSTREAM) then
......@@ -657,7 +677,8 @@
adv_grid%dxu,adv_grid%dyu,adv_grid%arcd1, &
#endif
_HALF_,scheme,AH, &
adv_grid%mask_uflux,adv_grid%mask_uupdate)
adv_grid%mask_uflux,adv_grid%mask_uupdate, &
p_nvd)
case((UPSTREAM_2DH),(J7),(FCT),(P2_2DH))
......
src/2d/m2d.F90
View file @ 3edf40eb
......@@ -371,9 +371,17 @@
allocate(phydis_2d(E2DFIELD),stat=rc)
if (rc /= 0) stop 'postinit_2d: Error allocating memory (phydis_2d)'
phydis_2d = _ZERO_
allocate(numdis_u_2d(E2DFIELD),stat=rc)
if (rc /= 0) stop 'postinit_2d: Error allocating memory (numdis_u_2d)'
numdis_u_2d = _ZERO_
allocate(numdis_v_2d(E2DFIELD),stat=rc)
if (rc /= 0) stop 'postinit_2d: Error allocating memory (numdis_v_2d)'
numdis_v_2d = _ZERO_
#ifdef _NUMERICAL_ANALYSES_OLD_
allocate(numdis_2d(E2DFIELD),stat=rc)
if (rc /= 0) stop 'postinit_2d: Error allocating memory (numdis_2d)'
numdis_2d = _ZERO_
#endif
end if
!
......
src/2d/uv_advect.F90
View file @ 3edf40eb
......@@ -25,7 +25,7 @@
use m2d, only: dtm,vel2d_adv_split,vel2d_adv_hor
use variables_2d, only: UEx,VEx
use variables_2d, only: do_numerical_analyses_2d
use variables_2d, only: numdis_2d
use variables_2d, only: numdis_u_2d,numdis_v_2d,numdis_2d
use advection, only: NOADV,UPSTREAM,J7,do_advection
use halo_zones, only: update_2d_halo,wait_halo,U_TAG,V_TAG
use getm_timers, only: tic,toc,TIM_UVADV,TIM_UVADVH
......@@ -182,6 +182,7 @@
end if
!$OMP END SINGLE
#ifdef _NUMERICAL_ANALYSES_OLD_
if (do_numerical_analyses_2d) then
!$OMP DO SCHEDULE(RUNTIME)
#ifndef SLICE_MODEL
......@@ -195,13 +196,15 @@
#endif
!$OMP END DO
end if
#endif
!$OMP SINGLE
call do_advection(dtm,fadv,Uadv,Vadv,DUadv,DVadv,pDadv,pDadv, &
vel2d_adv_split,vel2d_adv_hor,_ZERO_,U_TAG, &
advres=UEx)
advres=UEx,nvd=numdis_u_2d)
!$OMP END SINGLE
#ifdef _NUMERICAL_ANALYSES_OLD_
if (do_numerical_analyses_2d) then
!$OMP SINGLE
......@@ -241,6 +244,7 @@
!$OMP END DO
end if
#endif
! Here begins dimensional split advection for v-velocity
......@@ -346,6 +350,7 @@
end if
!$OMP END SINGLE
#ifdef _NUMERICAL_ANALYSES_OLD_
if (do_numerical_analyses_2d) then
!$OMP DO SCHEDULE(RUNTIME)
#ifndef SLICE_MODEL
......@@ -359,13 +364,15 @@
#endif
!$OMP END DO
end if
#endif
!$OMP SINGLE
call do_advection(dtm,fadv,Uadv,Vadv,DUadv,DVadv,pDadv,pDadv, &
vel2d_adv_split,vel2d_adv_hor,_ZERO_,V_TAG, &
advres=VEx)
advres=VEx,nvd=numdis_v_2d)
!$OMP END SINGLE
#ifdef _NUMERICAL_ANALYSES_OLD_
if (do_numerical_analyses_2d) then
!$OMP SINGLE
......@@ -410,6 +417,7 @@
!$OMP END DO
end if
#endif
!$OMP END PARALLEL
......
src/2d/variables_2d.F90
View file @ 3edf40eb
......@@ -30,6 +30,8 @@
#include "dynamic_declarations_2d.h"
#endif
REALTYPE,dimension(:,:),pointer :: numdis_u_2d=>null()
REALTYPE,dimension(:,:),pointer :: numdis_v_2d=>null()
REALTYPE,dimension(:,:),allocatable :: numdis_2d,phydis_2d
integer :: size2d_field
......
src/3d/adv_split_w.F90
View file @ 3edf40eb
......@@ -6,7 +6,7 @@
! !INTERFACE:
subroutine adv_split_w(dt,f,fi,hi,adv,ww, &
splitfac,scheme,tag,az, &
itersmax)
itersmax,nvd)
! Note (KK): Keep in sync with interface in advection_3d.F90
!
! !DESCRIPTION:
......@@ -57,15 +57,16 @@
!
! !INPUT/OUTPUT PARAMETERS:
REALTYPE,dimension(I3DFIELD),target,intent(inout) :: fi,hi,adv
REALTYPE,dimension(:,:,:),pointer,intent(inout) :: nvd
!
! !LOCAL VARIABLES:
logical :: iterate,use_limiter,allocated_aux
logical :: iterate,use_limiter,calc_nvd,allocated_aux
integer :: i,j,k,kshift,it,iters,iters_new,rc
REALTYPE :: itersm1,dti,dtik,hio,advn,fuu,fu,fd,splitfack
REALTYPE,dimension(:),allocatable :: wflux
REALTYPE :: itersm1,dti,dtik,fio,hio,advn,adv2n,fuu,fu,fd,splitfack
REALTYPE,dimension(:),allocatable :: wflux,wflux2
REALTYPE,dimension(:),allocatable,target :: cfl0
REALTYPE,dimension(:),pointer :: fo,faux,fiaux,hiaux,advaux,cfls
REALTYPE,dimension(:),pointer :: p_fiaux,p_hiaux,p_advaux
REALTYPE,dimension(:),pointer :: fo,faux,fiaux,hiaux,advaux,nvdaux,cfls
REALTYPE,dimension(:),pointer :: p_fiaux,p_hiaux,p_advaux,p_nvdaux
!
! !REVISION HISTORY:
! Original author(s): Hans Burchard & Karsten Bolding
......@@ -88,6 +89,7 @@
end if
use_limiter = .false.
calc_nvd = associated(nvd)
dti = splitfac*dt
iterate = (itersmax .gt. 1)
......@@ -99,10 +101,11 @@
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP FIRSTPRIVATE(j,use_limiter) &
!$OMP PRIVATE(rc,wflux,fo,faux,fiaux,hiaux,advaux,cfl0,cfls) &
!$OMP PRIVATE(p_fiaux,p_hiaux,p_advaux) &
!$OMP PRIVATE(rc,wflux,wflux2,cfl0,cfls) &
!$OMP PRIVATE(fo,faux,fiaux,hiaux,advaux,nvdaux) &
!$OMP PRIVATE(p_fiaux,p_hiaux,p_advaux,p_nvdaux) &
!$OMP PRIVATE(itersm1,dtik,splitfack) &
!$OMP PRIVATE(i,k,it,iters,iters_new,hio,advn,fuu,fu,fd)
!$OMP PRIVATE(i,k,it,iters,iters_new,fio,hio,advn,adv2n,fuu,fu,fd)
if (scheme .ne. NOADV) then
......@@ -111,6 +114,11 @@
allocate(wflux(0:kmax),stat=rc) ! work array
if (rc /= 0) stop 'adv_split_w: Error allocating memory (wflux)'
if (calc_nvd) then
allocate(wflux2(0:kmax),stat=rc) ! work array
if (rc /= 0) stop 'adv_split_w: Error allocating memory (wflux2)'
end if
#ifndef _POINTER_REMAP_
allocate(fo(0:kmax),stat=rc) ! work array
if (rc /= 0) stop 'adv_split_w: Error allocating memory (fo)'
......@@ -131,6 +139,11 @@
allocate(advaux(0:kmax),stat=rc) ! work array
if (rc /= 0) stop 'adv_split_w: Error allocating memory (advaux)'
if (calc_nvd) then
allocate(nvdaux(0:kmax),stat=rc) ! work array
if (rc /= 0) stop 'adv_split_w: Error allocating memory (nvdaux)'
end if
#ifdef _POINTER_REMAP_
end if
#endif
......@@ -147,8 +160,12 @@
end if
end if
wflux(0) = _ZERO_
wflux(0 ) = _ZERO_
wflux(kmax) = _ZERO_
if (calc_nvd) then
wflux2(0 ) = _ZERO_
wflux2(kmax) = _ZERO_
end if
! Note (KK): as long as h[u|v]n([i|j]max+HALO) are trash (SMALL)
! they have to be excluded from the loop to avoid
......@@ -178,6 +195,7 @@
fiaux (0:) => fi (i,j,:)
hiaux (0:) => hi (i,j,:)
advaux(0:) => adv(i,j,:)
nvdaux(0:) => nvd(i,j,:)
end if
#else
fo = f(i,j,:)
......@@ -186,6 +204,7 @@
p_fiaux => fiaux
p_hiaux => hiaux
p_advaux => advaux
p_nvdaux => nvdaux
it = 1
......@@ -197,6 +216,9 @@
fiaux = fi (i,j,:)
hiaux = hi (i,j,:)
advaux = adv(i,j,:)
if (calc_nvd) then
nvdaux = nvd(i,j,:)
end if
end if
#ifdef _POINTER_REMAP_
......@@ -271,6 +293,9 @@
fu = adv_interfacial_reconstruction(scheme,cfls(k)*itersm1,fuu,fu,fd)
end if
wflux(k) = ww(i,j,k)*fu
if (calc_nvd) then
wflux2(k) = wflux(k)*fu
end if
end do
#ifdef _POINTER_REMAP_
......@@ -278,16 +303,26 @@
p_fiaux (0:) => fi (i,j,:)
p_hiaux (0:) => hi (i,j,:)
p_advaux(0:) => adv(i,j,:)
p_nvdaux(0:) => nvd(i,j,:)
end if
#endif
do k=1,kmax-kshift
! Note (KK): in case of W_TAG do not advect at k=kmax
fio = fiaux(k)
hio = hiaux(k)
p_hiaux(k) = hio - dtik*(ww(i,j,k )-ww(i,j,k-1))
advn = splitfack*(wflux(k )-wflux(k-1))
p_fiaux(k) = ( hio*fiaux(k) - dt*advn ) / p_hiaux(k)
p_fiaux(k) = ( hio*fio - dt*advn ) / p_hiaux(k)
p_advaux(k) = advaux(k) + advn
if (calc_nvd) then
adv2n = splitfack*(wflux2(k )-wflux2(k-1))
! p_nvdaux(k) = nvdaux(k) &
! -((p_hiaux(k)*p_fiaux(k)**2 - hio*fio**2)/dt + adv2n)
p_nvdaux(k) = ( hio*nvdaux(k) &
-((p_hiaux(k)*p_fiaux(k)**2 - hio*fio**2)/dt + adv2n) &
)/p_hiaux(k)
end if
end do
faux => p_fiaux
......@@ -299,6 +334,9 @@
fi (i,j,1:kmax-kshift) = p_fiaux (1:kmax-kshift)
hi (i,j,1:kmax-kshift) = p_hiaux (1:kmax-kshift)
adv(i,j,1:kmax-kshift) = p_advaux(1:kmax-kshift)
if (calc_nvd) then
nvd(i,j,1:kmax-kshift) = p_nvdaux(1:kmax-kshift)
end if
#endif
end if
......@@ -313,6 +351,11 @@
deallocate(wflux,stat=rc)
if (rc /= 0) stop 'adv_split_w: Error deallocating memory (wflux)'
if (calc_nvd) then
deallocate(wflux2,stat=rc)
if (rc /= 0) stop 'adv_split_w: Error deallocating memory (wflux2)'
end if
#ifndef _POINTER_REMAP_
deallocate(fo,stat=rc)
if (rc /= 0) stop 'adv_split_w: Error deallocating memory (fo)'
......@@ -331,6 +374,11 @@
deallocate(advaux,stat=rc)
if (rc /= 0) stop 'adv_split_w: Error deallocating memory (advaux)'
if (calc_nvd) then
deallocate(nvdaux,stat=rc)
if (rc /= 0) stop 'adv_split_w: Error deallocating memory (nvdaux)'
end if
#ifdef _POINTER_REMAP_
end if
#endif
......
src/3d/advection_3d.F90
View file @ 3edf40eb
......@@ -55,7 +55,7 @@
interface
subroutine adv_split_w(dt,f,fi,hi,adv,ww, &
splitfac,scheme,tag,az, &
itersmax)
itersmax,nvd)
use domain, only: imin,imax,jmin,jmax,kmax
IMPLICIT NONE
REALTYPE,intent(in) :: dt,splitfac
......@@ -64,6 +64,7 @@
integer,intent(in) :: scheme,tag,itersmax
integer,dimension(E2DFIELD),intent(in) :: az
REALTYPE,dimension(I3DFIELD),target,intent(inout) :: fi,hi,adv
REALTYPE,dimension(:,:,:),pointer,intent(inout) :: nvd
end subroutine adv_split_w
end interface
......@@ -119,7 +120,7 @@
! !INTERFACE:
subroutine do_advection_3d(dt,f,uu,vv,ww,hu,hv,ho,hn, &
split,hscheme,vscheme,AH,tag, &
hires,advres)
hires,advres,nvd)
!
! !DESCRIPTION:
!
......@@ -243,11 +244,20 @@
!