Commit 45c37235 authored by kbk's avatar kbk
Browse files

possible to store calculated mean fields

parent 24a878f4
!$Id: integration.F90,v 1.3 2003-04-23 12:03:46 kbk Exp $
!$Id: integration.F90,v 1.4 2004-03-29 15:35:51 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -20,7 +20,10 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: integration.F90,v $
! Revision 1.3 2003-04-23 12:03:46 kbk
! Revision 1.4 2004-03-29 15:35:51 kbk
! possible to store calculated mean fields
!
! Revision 1.3 2003/04/23 12:03:46 kbk
! cleaned code + TABS to spaces
!
! Revision 1.2 2003/04/07 16:39:16 kbk
......@@ -59,7 +62,6 @@
! Revision 1.1.1.1 2001/04/17 08:43:09 bbh
! initial import into CVS
!
!
! !LOCAL VARIABLES:
!EOP
!-----------------------------------------------------------------------
......@@ -91,7 +93,7 @@
use rivers, only: do_rivers
#endif
use input, only: do_input
use output, only: do_output
use output, only: do_output,meanout
#ifdef TEST_NESTING
use nesting, only: nesting_file
#endif
......@@ -157,13 +159,19 @@
#endif
call update_time(n)
if(meanout .ge. 0) then
call calc_mean_fields(n,meanout)
end if
call do_output(runtype,n,timestep)
#ifdef DIAGNOSE
call diagnose(n,MaxN,runtype)
#endif
end do
if (meanout .eq. 0) then
call calc_mean_fields(n,n)
end if
#ifdef DEBUG
write(debug,*) 'Leaving time_loop()'
write(debug,*)
......
!$Id: init_mean_ncdf.F90,v 1.1 2004-03-29 15:38:10 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_mean_ncdf -
!
! !INTERFACE:
subroutine init_mean_ncdf(fn,title,starttime)
!
! !DESCRIPTION:
!
! !USES:
use ncdf_mean
use domain, only: ioff,joff,imin,imax,jmin,jmax
use domain, only: iimin,iimax,jjmin,jjmax,kmax
#if defined(SPHERICAL)
use domain, only: lonc,latc
#endif
#if ! defined(SPHERICAL)
use domain, only: xc,yc
#endif
use domain, only: grid_type,vert_cord
IMPLICIT NONE
!
! !INPUT PARAMETERS:
character(len=*), intent(in) :: fn,title,starttime
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
! !REVISION HISTORY:
! Original author(s): Adolf Stips & Karsten Bolding
!
! $Log: init_mean_ncdf.F90,v $
! Revision 1.1 2004-03-29 15:38:10 kbk
! possible to store calculated mean fields
!
!
! !LOCAL VARIABLES:
integer :: i,j,k,err
character(32) :: xname,yname,zname,xunits,yunits,zunits
character(32) :: gridname,vertname
integer :: scalar(1),axisdim(1),f3_dims(3),f4_dims(4)
REALTYPE :: fv,mv,vr(2)
REALTYPE :: x
character(len=80) :: history,tts
!EOP
!-------------------------------------------------------------------------
!BOC
include "netcdf.inc"
xlen = iimax-iimin+1
ylen = jjmax-jjmin+1
zlen = kmax+1
select case (grid_type)
case (1)
xname = 'xax'
yname = 'yax'
xunits = 'meters'
yunits = 'meters'
gridname='cartesian'
case (2)
xname = 'lon'
yname = 'lat'
xunits = 'degrees_east'
yunits = 'degrees_north'
gridname='spherical'
case (3)
xname = 'xdim'
yname = 'ydim'
xunits = 'curvi-x'
yunits = 'curvi-y'
gridname='curvi-linear'
case default
end select
select case (vert_cord)
case (1)
zname = 'zax'
zunits = 'sigma_level'
vertname='sigma coordinates'
case (2)
zname = 'zax'
zunits = 'meters'
vertname='z-levels'
case (3)
zname = 'zax'
zunits = 'level'
vertname='general vertical coordinates'
case default
end select
err = nf_create(fn, NF_CLOBBER, ncid)
if (err .NE. NF_NOERR) go to 10
! dimensions
err = nf_def_dim(ncid,xname,xlen,x_dim)
if (err .NE. NF_NOERR) go to 10
err = nf_def_dim(ncid,yname,ylen,y_dim)
if (err .NE. NF_NOERR) go to 10
err = nf_def_dim(ncid,zname,zlen,z_dim)
if (err .NE. NF_NOERR) go to 10
err = nf_def_dim(ncid,'time',NF_UNLIMITED,time_dim)
if (err .NE. NF_NOERR) go to 10
f3_dims(3)= time_dim
f3_dims(2)= y_dim
f3_dims(1)= x_dim
f4_dims(4)= time_dim
f4_dims(3)= z_dim
f4_dims(2)= y_dim
f4_dims(1)= x_dim
history = 'Generated by getm, ver. '//RELEASE
tts = 'seconds since '//starttime
! info on offset, grid type and vertical coordinates
scalar(1) = 0
err = nf_def_var(ncid,'grid_type',NF_INT,0,scalar,grid_type_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,grid_type_id,units=gridname)
err = nf_def_var(ncid,'vert_cord',NF_INT,0,scalar,vert_cord_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,vert_cord_id,units=vertname)
err = nf_def_var(ncid,'ioff',NF_INT,0,scalar,ioff_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,ioff_id,long_name='index offset (i)')
err = nf_def_var(ncid,'joff',NF_INT,0,scalar,joff_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,joff_id,long_name='index offset (j)')
! time
axisdim(1) = time_dim
err = nf_def_var(ncid,'time',NF_REAL,1,axisdim,time_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,time_id,units=trim(tts),long_name='time')
! coordinate variables
select case (grid_type)
case (1)
#if ! ( defined(SPHERICAL) || defined(CURVILINEAR) )
axisdim(1) = x_dim
err = nf_def_var(ncid,xname,NF_REAL,1,axisdim,xc_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,xc_id,units=xunits)
axisdim(1) = y_dim
err = nf_def_var(ncid,yname,NF_REAL,1,axisdim,yc_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,yc_id,units=yunits)
#endif
case (2)
#if defined(SPHERICAL)
axisdim(1) = x_dim
err = nf_def_var(ncid,xname,NF_REAL,1,axisdim,lonc_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,lonc_id,units=xunits)
axisdim(1) = y_dim
err = nf_def_var(ncid,yname,NF_REAL,1,axisdim,latc_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,latc_id,units=yunits)
#endif
case (3)
#if defined(CURVILINEAR)
! do something about curvi-linear coordinates - define xu,xv,....
#endif
case default
end select
axisdim(1) = z_dim
err = nf_def_var(ncid,zname,NF_REAL,1,axisdim,z_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,z_id,units=zunits)
! bathymetry
err = nf_def_var(ncid,'bathymetry',NF_REAL,2,f3_dims,bathymetry_id)
if (err .NE. NF_NOERR) go to 10
fv = h_missing
mv = h_missing
vr(1) = -5.
vr(2) = 4000.
call set_attributes(ncid,bathymetry_id, &
long_name='bathymetry',units='meters', &
FillValue=fv,missing_value=mv,valid_range=vr)
! now to the variables
! short wave radiation
fv = swr_missing; mv = swr_missing; vr(1) = 0; vr(2) = 1500.
err = nf_def_var(ncid,'swrmean',NF_REAL,3,f3_dims,swrmean_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,swrmean_id, &
long_name='mean short wave radiation',units='W/m2', &
FillValue=fv,missing_value=mv,valid_range=vr)
! Ustar at bottom
fv = vel_missing; mv = vel_missing; vr(1) = -1; vr(2) = 1.
err = nf_def_var(ncid,'ustarmean',NF_REAL,3,f3_dims,ustarmean_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,ustarmean_id, &
long_name='bottom friction velocity',units='m/s', &
FillValue=fv,missing_value=mv,valid_range=vr)
! Standard deviation of ustar
fv = vel_missing; mv = vel_missing; vr(1) = 0; vr(2) = 1.
err = nf_def_var(ncid,'ustar2mean',NF_REAL,3,f3_dims,ustar2mean_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,ustar2mean_id, &
long_name='stdev of bottom friction velocity',units='m/s', &
FillValue=fv,missing_value=mv,valid_range=vr)
select case (vert_cord)
case (1)
case (2)
STDERR 'store z-levels'
stop 'init_mean_ncdf'
case (3)
fv = h_missing
mv = h_missing
err = nf_def_var(ncid,'hmean',NF_REAL,4,f4_dims,hmean_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,hmean_id, &
long_name='mean layer thickness', &
units='meters',FillValue=fv,missing_value=mv)
case default
end select
fv = vel_missing
mv = vel_missing
vr(1) = -3.
vr(2) = 3.
! zonal velocity
err = nf_def_var(ncid,'uumean',NF_REAL,4,f4_dims,uumean_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,uumean_id, &
long_name='mean zonal vel.',units='m/s', &
FillValue=fv,missing_value=mv,valid_range=vr)
! meridional velocity
err = nf_def_var(ncid,'vvmean',NF_REAL,4,f4_dims,vvmean_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,vvmean_id, &
long_name='mean meridional vel.',units='m/s', &
FillValue=fv,missing_value=mv,valid_range=vr)
! vertical velocity
err = nf_def_var(ncid,'wmean',NF_REAL,4,f4_dims,wmean_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,wmean_id, &
long_name='mean vertical vel.',units='m/s', &
FillValue=fv,missing_value=mv,valid_range=vr)
fv = salt_missing
mv = salt_missing
vr(1) = 0.
vr(2) = 40.
err = nf_def_var(ncid,'saltmean',NF_REAL,4,f4_dims,saltmean_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,saltmean_id, &
long_name='mean salinity',units='PSU', &
FillValue=fv,missing_value=mv,valid_range=vr)
fv = temp_missing
mv = temp_missing
vr(1) = 0.
vr(2) = 40.
err = nf_def_var(ncid,'tempmean',NF_REAL,4,f4_dims,tempmean_id)
if (err .NE. NF_NOERR) go to 10
call set_attributes(ncid,tempmean_id, &
long_name='mean temperature',units='degC',&
FillValue=fv,missing_value=mv,valid_range=vr)
! globals
err = nf_put_att_text(ncid,NF_GLOBAL,'title',LEN_TRIM(title),title)
if (err .NE. NF_NOERR) go to 10
err = nf_put_att_text(ncid,NF_GLOBAL,'history',LEN_TRIM(history),history)
if (err .NE. NF_NOERR) go to 10
! leave define mode
err = nf_enddef(ncid)
if (err .NE. NF_NOERR) go to 10
return
10 FATAL 'init_mean_ncdf: ',nf_strerror(err)
stop 'init_mean_ncdf'
end subroutine init_mean_ncdf
!EOC
!-----------------------------------------------------------------------
! Copyright (C) 2004 - Adolf Stips and Karsten Bolding (BBH) !
!-----------------------------------------------------------------------
!$Id: ncdf_mean.F90,v 1.1 2004-03-29 15:38:10 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !MODULE: ncdf_mean() - saves Mean-fields.
!
! !INTERFACE:
module ncdf_mean
!
! !DESCRIPTION:
!
! !USES:
use output
use ncdf_common
IMPLICIT NONE
!
! private
!
! !PUBLIC DATA MEMBERS:
integer :: ncid=-1
integer :: x_dim,y_dim,z_dim,time_dim
integer :: ioff_id,joff_id,grid_type_id,vert_cord_id
integer :: xc_id,xx_id,xu_id,xv_id
integer :: yc_id,yx_id,yu_id,yv_id
integer :: z_id
integer :: dx_id,dy_id
integer :: lonc_id,latc_id
integer :: time_id
integer :: bathymetry_id
integer :: h_id=-1
integer :: swrmean_id,ustarmean_id,ustar2mean_id
integer :: uumean_id,vvmean_id,wmean_id
integer :: saltmean_id,tempmean_id,hmean_id
integer :: xlen,ylen,zlen
integer, parameter :: size_3d=9000000
REAL_4B :: ws(size_3d)
REALTYPE, parameter :: h_missing=-10.0
REALTYPE, parameter :: swr_missing=-9999.0
REALTYPE, parameter :: vel_missing=-9999.0
REALTYPE, parameter :: salt_missing=-9999.0
REALTYPE, parameter :: temp_missing=-9999.0
REALTYPE, parameter :: tke_missing=-9999.0
REALTYPE, parameter :: eps_missing=-9999.0
!
! Original author(s): Adolf Stips & Karsten Bolding
!
! $Log: ncdf_mean.F90,v $
! Revision 1.1 2004-03-29 15:38:10 kbk
! possible to store calculated mean fields
!
!
!EOP
!-----------------------------------------------------------------------
end module ncdf_mean
!-----------------------------------------------------------------------
! Copyright (C) 2001 - Hans Burchard and Karsten Bolding (BBH) !
!-----------------------------------------------------------------------
!$Id: save_mean_ncdf.F90,v 1.1 2004-03-29 15:38:10 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: save_mean_ncdf() - saves mean-fields.
!
! !INTERFACE:
subroutine save_mean_ncdf(secs)
!
! !DESCRIPTION:
!
! !USES:
use ncdf_mean
use domain, only: ioff,joff,imin,imax,jmin,jmax
use domain, only: iimin,iimax,jjmin,jjmax,kmax
use domain, only: H,az
use domain, only: grid_type,vert_cord,ga
use variables_3d, only: kmin
#if defined(SPHERICAL)
use domain, only: lonc,latc
#endif
#if ! defined(SPHERICAL)
use domain, only: xc,yc
#endif
use diagnostic_variables
IMPLICIT NONE
!
! !INPUT PARAMETERS:
REALTYPE, intent(in) :: secs
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
! !REVISION HISTORY:
! Original author(s): Adolf Stips & Karsten Bolding
!
! $Log: save_mean_ncdf.F90,v $
! Revision 1.1 2004-03-29 15:38:10 kbk
! possible to store calculated mean fields
!
!
! !LOCAL VARIABLES:
integer :: err
integer :: start(4),edges(4)
integer, save :: n3d=0
integer :: i,j,k,itmp(1)
!EOP
!-----------------------------------------------------------------------
!BOC
include "netcdf.inc"
n3d = n3d + 1
if (n3d .eq. 1) then
if( xlen*ylen*zlen .gt. size_3d ) then
FATAL 'Increase size_3d in ncdf_save_mean() - this needs a fix'
stop 'ncdf_mean_save'
end if
! save info on offset, grid type and vertical coordinates
itmp(1) = grid_type
err = nf_put_var_int(ncid,grid_type_id,itmp)
if (err .NE. NF_NOERR) go to 10
itmp(1) = vert_cord
err = nf_put_var_int(ncid,vert_cord_id,itmp)
if (err .NE. NF_NOERR) go to 10
itmp(1) = ioff
err = nf_put_var_int(ncid,ioff_id,itmp)
if (err .NE. NF_NOERR) go to 10
itmp(1) = joff
err = nf_put_var_int(ncid,joff_id,itmp)
if (err .NE. NF_NOERR) go to 10
! save coordinate information
select case (grid_type)
case (1)
#if ! ( defined(SPHERICAL) || defined(CURVILINEAR) )
do i=imin,imax
ws(i) = xc(i)
end do
err = nf_put_var_real(ncid,xc_id,ws)
if (err .NE. NF_NOERR) go to 10
do j=jmin,jmax
ws(j) = yc(j)
end do
err = nf_put_var_real(ncid,yc_id,ws)
if (err .NE. NF_NOERR) go to 10
#endif
case (2)
#if defined(SPHERICAL)
do i=imin,imax
ws(i) = lonc(i,1)
end do
err = nf_put_var_real(ncid,lonc_id,ws)
if (err .NE. NF_NOERR) go to 10
do j=jmin,jmax
ws(j) = latc(1,j)
end do
err = nf_put_var_real(ncid,latc_id,ws)
if (err .NE. NF_NOERR) go to 10
#endif
case (3)
#if defined(CURVILINEAR)
STDERR 'xc and yc are read from input file directly'
#endif
case default
end select
select case (vert_cord)
case (1,2,3)
do k=0,kmax
ws(k+1) = ga(k)
end do
err = nf_put_var_real(ncid,z_id,ws)
if (err .NE. NF_NOERR) go to 10
case default
end select
start(1) = 1
start(2) = 1
edges(1) = xlen
edges(2) = ylen
call cnv_2d(imin,jmin,imax,jmax,az,H,h_missing, &
imin,jmin,imax,jmax,ws)
err = nf_put_vara_real(ncid,bathymetry_id,start,edges,ws)
if (err .NE. NF_NOERR) go to 10
err = nf_sync(ncid)
if (err .NE. NF_NOERR) go to 10
end if ! (n3d .eq. 1)
start(1) = n3d
edges(1) = 1
ws(1) = secs
err = nf_put_vara_real(ncid,time_id,start,edges,ws(1))
start(1) = 1
start(2) = 1
start(3) = n3d
edges(1) = xlen
edges(2) = ylen
edges(3) = 1
! Short wave radiation
call cnv_2d(imin,jmin,imax,jmax,az,swrmean,swr_missing, &
imin,jmin,imax,jmax,ws)
err = nf_put_vara_real(ncid, swrmean_id, start, edges, ws)
if (err .NE. NF_NOERR) go to 10
! mean friction velocity
call cnv_2d(imin,jmin,imax,jmax,az,ustarmean,vel_missing, &
imin,jmin,imax,jmax,ws)
err = nf_put_vara_real(ncid,ustarmean_id,start,edges,ws)
if (err .NE. NF_NOERR) go to 10
! mean standard deviation of friction velocity
call cnv_2d(imin,jmin,imax,jmax,az,ustar2mean,vel_missing, &
imin,jmin,imax,jmax,ws)
err = nf_put_vara_real(ncid,ustar2mean_id,start,edges,ws)
if (err .NE. NF_NOERR) go to 10
start(1) = 1
start(2) = 1
start(3) = 1