!----- AGPL --------------------------------------------------------------------
!
! Copyright (C) Stichting Deltares, 2015.
!
! This file is part of Delft3D (D-Flow Flexible Mesh component).
!
! Delft3D is free software: you can redistribute it and/or modify
! it under the terms of the GNU Affero General Public License as
! published by the Free Software Foundation version 3.
!
! Delft3D is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU Affero General Public License for more details.
!
! You should have received a copy of the GNU Affero General Public License
! along with Delft3D. If not, see .
!
! contact: delft3d.support@deltares.nl
! Stichting Deltares
! P.O. Box 177
! 2600 MH Delft, The Netherlands
!
! All indications and logos of, and references to, "Delft3D",
! "D-Flow Flexible Mesh" and "Deltares" are registered trademarks of Stichting
! Deltares, and remain the property of Stichting Deltares. All rights reserved.
!
!-------------------------------------------------------------------------------
! $Id: unstruc_netcdf.f90 43393 2015-12-03 12:28:01Z jagers $
! $HeadURL: https://repos.deltares.nl/repos/ds/trunk/additional/unstruc/src/unstruc_netcdf.f90 $
! TODO: FB: #define NC_CHECK if(ierr .ne. 0 ) call mess(LEVEL_ERROR, nf90_strerror(ierr))
! TODO: AvD:
! * flowgeom should work now for CFOLD and UGRID. Test this before moving to map writer.
! * map writer: start adding data variables
! * waq writer: migrate to new UGRID?
! * com writer: stay at old CF for now???
! * zk in ugrid flowgeom
! * Solve all TODO's.
!> Reads and writes unstructured net/flow data in netCDF format.
module unstruc_netcdf
use precision
use netcdf
use unstruc_messages
use unstruc_version_module
use io_ugrid
implicit none
integer :: nerr_
logical :: err_firsttime_
character(len=255) :: err_firstline_
!> All NetCDF files should be opened through unc_open or unc_create,
!! such that all opened files are maintained and can be properly closed
!! upon exit of the program by unc_closeall.
integer, parameter :: maxopenfiles = 50
character(len=255) :: open_files_(maxopenfiles) !< Names of open NetCDF files.
integer :: open_datasets_(maxopenfiles) !< Dataset IDs of open NetCDF files.
integer :: nopen_files_ = 0 !< Nr. of NetCDF files currently open.
private :: nerr_, err_firsttime_, err_firstline_, &
!prepare_error, check_error, &
open_files_, open_datasets_, nopen_files_
integer, parameter :: UNC_CONV_CFOLD = 1 !< Old CF-only conventions.
integer, parameter :: UNC_CONV_UGRID = 2 !< New CF+UGRID conventions.
! The following location codes generalize for 1D/2D/3D models. See function unc_def_var_map for the details.
integer, parameter :: UNC_LOC_CN = 1 !< Data location: corner point.
integer, parameter :: UNC_LOC_S = 2 !< Data location: pressure point.
integer, parameter :: UNC_LOC_U = 3 !< Data location: horizontal velocity point.
integer, parameter :: UNC_LOC_S3D = 4 !< Data location: pressure point in all layers.
integer, parameter :: UNC_LOC_U3D = 5 !< Data location: horizontal velocity point in all layers.
integer, parameter :: UNC_LOC_W = 6 !< Data location: vertical velocity point.
! The following edge type codes define for each netlink (UGRID 'edge') the type (or absence) of flowlink.
integer, parameter :: UNC_EDGETYPE_INTERNAL_CLOSED = 0
integer, parameter :: UNC_EDGETYPE_INTERNAL = 1
integer, parameter :: UNC_EDGETYPE_BND = 2
integer, parameter :: UNC_EDGETYPE_BND_CLOSED = 3
!> This type collects all NetCDF ids that are relevant for repeated file writing.
!! Not only the file pointer, but also all variable ids, dimension ids, etc.
!! Create a separate variable of this type for each map file.
type t_unc_mapids
!
! Toplevel
!
integer :: ncid = 0 !< NetCDF data set id (typically NetCDF file pointer)
type(t_ug_meshids) :: meshids1d
type(t_ug_meshids) :: meshids2d
type(t_ug_meshids) :: meshids3d
!
! Dimensions
!
integer :: id_timedim = -1 !< Time dimension (the only nf90_unlimited in file).
integer :: id_laydim = -1 !< Layer (center) dimension. TODO: AvD: to be moved to meshids3d
integer :: id_wdim = -1 !< Layer interfaces dimension. TODO: AvD: to be moved to meshids3d.
! id_flowelemdim, &
integer :: id_maxfracdim = -1 !<
integer :: id_erolaydim = -1 !< Dimension ID for location of erodable layer thickness.
integer :: id_sedtotdim = -1 !< Dimension ID for number of all sediment fractions.
integer :: id_sedsusdim = -1 !< Dimension ID for number of suspended sediment fractions.
! TODO: AvD: replace all data var ids below by 1D/2D/3D generalization.
!
! Data variables
!
integer :: id_flowelemba(3) = -1 !< Variable ID for flow node bottom area (on 1D, 2D, 3D grid parts resp.).
integer :: id_flowelembl(3) = -1 !< Variable ID for flow node bed level (on 1D, 2D, 3D grid parts resp.).
integer :: id_time = -1 !< Variable ID for
integer :: id_timestep = -1 !< Variable ID for
integer :: id_numlimdt(3) = -1 !< Variable ID for
integer :: id_s1(3) = -1 !< Variable ID for water level (on 1D, 2D, 3D grid parts resp.)
integer :: id_s0(3) = -1 !< Variable ID for
integer :: id_hs(3) = -1 !< Variable ID for
integer :: id_taus(3) = -1 !< Variable ID for
integer :: id_ucx(3) = -1 !< Variable ID for
integer :: id_ucy(3) = -1 !< Variable ID for
integer :: id_ucz = -1 !< Variable ID for
integer :: id_q1(3) = -1 !< Variable ID for
integer :: id_u1(3) = -1 !< Variable ID for
integer :: id_u0(3) = -1 !< Variable ID for
integer :: id_ww1 = -1 !< Variable ID for
integer :: id_sa1(3) = -1 !< Variable ID for
integer :: id_tem1(3) = -1 !< Variable ID for
integer, dimension(:,:), allocatable :: id_const !< Variable ID for (3, NUM_CONST) constituents (on 1D, 2D, 3D grid parts resp.)
integer :: id_sed(3) = -1 !< Variable ID for
integer :: id_ero(3) = -1 !< Variable ID for
integer :: id_cftrt = -1 !< Variable ID for netlink data of friction from trachytopes
integer :: id_czs(3) = -1 !< Variable ID for flow node data of chezy roughness
integer :: id_qsun(3) = -1 !< Variable ID for
integer :: id_qeva(3) = -1 !< Variable ID for
integer :: id_qcon(3) = -1 !< Variable ID for
integer :: id_qlong(3) = -1 !< Variable ID for
integer :: id_qfreva(3) = -1 !< Variable ID for
integer :: id_qfrcon(3) = -1 !< Variable ID for
integer :: id_qtot(3) = -1 !< Variable ID for
integer :: id_wind(3) = -1 !< Variable ID for
integer :: id_patm(3) = -1 !< Variable ID for
integer :: id_tair(3) = -1 !< Variable ID for
integer :: id_rhum(3) = -1 !< Variable ID for
integer :: id_clou(3) = -1 !< Variable ID for
integer :: id_E(3) = -1 !< Variable ID for
integer :: id_R(3) = -1 !< Variable ID for
integer :: id_H(3) = -1 !< Variable ID for
integer :: id_D(3) = -1 !< Variable ID for
integer :: id_DR(3) = -1 !< Variable ID for
integer :: id_urms(3) = -1 !< Variable ID for
integer :: id_thetamean(3) = -1 !< Variable ID for
integer :: id_cwav(3) = -1 !< Variable ID for
integer :: id_cgwav(3) = -1 !< Variable ID for
integer :: id_sigmwav(3)= -1 !< Variable ID for
integer :: id_ust(3) = -1 !< Variable ID for
integer :: id_vst(3) = -1 !< Variable ID for
integer :: id_Fx(3) = -1 !< Variable ID for
integer :: id_Fy(3) = -1 !< Variable ID for
integer :: id_windx = -1 !< Variable ID for
integer :: id_windy = -1 !< Variable ID for
integer :: id_sbcx(3) = -1 !< Variable ID for
integer :: id_sbcy(3) = -1 !< Variable ID for
integer :: id_sbwx(3) = -1 !< Variable ID for
integer :: id_sbwy(3) = -1 !< Variable ID for
integer :: id_sswx(3) = -1 !< Variable ID for
integer :: id_sswy(3) = -1 !< Variable ID for
integer :: id_sourse(3) = -1 !< Variable ID for
integer :: id_sinkse(3) = -1
integer :: id_zk(3) = -1 ! TODO: AvD: HK's timedep zk
integer :: id_bl(3) = -1 ! TODO: AvD: HK's timedep bl
!
! Other
!
integer :: idx_curtime = 0 !< Index of current time (typically of latest snapshot being written).
end type t_unc_mapids
type(t_crs) :: crs !< crs read from net file, to be written to flowgeom. TODO: AvD: temp, move this global CRS into ug_meshgeom (now a bit difficult with old and new file format)
contains
!> Defines a NetCDF variable that has no spatial dimension, also setting the most used attributes.
!! Typically only used for variables without a space dimension.
!! For variables with either his-station-range or map-grid-range in the dimensions:
!! @see unc_def_var_map @see unc_def_var_his
function unc_def_var_nonspatial(ncid, id_var, itype, idims, var_name, standard_name, long_name, unit) result(ierr)
use dfm_error
implicit none
integer, intent(in) :: ncid !< NetCDF file unit
integer, intent(inout) :: id_var !< Returned variable id.
integer, intent(in) :: itype !< Variable's data type, one of nf90_double, nf90_int, etc.
integer, intent(in) :: idims(:) !< Array with the dimension ids across which this new variable should range. For example (/ id_flowelem, id_time /).
character(len=*), intent(in) :: var_name !< Name for this variable in the file.
character(len=*), intent(in) :: standard_name !< Standard name for this variable. May be empty, otherwise it should be CF-compliant.
character(len=*), intent(in) :: long_name !< Description text, used in long_name attribute.
character(len=*), intent(in) :: unit !< Unit for this variable, should be UDUNITS-compliant.
integer :: ierr !< Result status, DFM_NOERR if successful.
ierr = DFM_NOERR
ierr = nf90_def_var(ncid, var_name , itype, idims , id_var)
if (len_trim(standard_name) > 0) then
ierr = nf90_put_att(ncid, id_var, 'standard_name', standard_name)
end if
if (len_trim(long_name) > 0) then
ierr = nf90_put_att(ncid, id_var, 'long_name' , long_name)
end if
ierr = nf90_put_att(ncid, id_var, 'units' , unit)
end function unc_def_var_nonspatial
!> Defines a NetCDF variable inside a map file, taking care or proper attributes and coordinate references.
!! Produces a UGRID-compliant map file.
!! Typical call: unc_def_var(mapids, mapids%id_s1(:), nf90_double, UNC_LOC_S, 's1', 'sea_surface_height', 'water level', 'm')
function unc_def_var_map(mapids, id_var, itype, iloc, var_name, standard_name, long_name, unit, is_timedep, dimids) result(ierr)
use m_flowgeom
use m_flow, only: kmx
use dfm_error
use m_missing
implicit none
type(t_unc_mapids), intent(in) :: mapids !< Map file and other NetCDF ids.
integer, intent(out) :: id_var(:) !< Resulting variable ids, one for each submesh (1d/2d/3d if applicable)
integer, intent(in) :: itype !< NetCDF data type (e.g. nf90_double).
integer, intent(in) :: iloc !< Stagger location for this variable (one of UNC_LOC_S, UNC_LOC_U, UNC_LOC_W).
character(len=*), intent(in) :: var_name !< Variable name for in NetCDF variable, will be prefixed with mesh name.
character(len=*), intent(in) :: standard_name !< Standard name (CF-compliant) for 'standard_name' attribute in this variable.
character(len=*), intent(in) :: long_name !< Long name for 'long_name' attribute in this variable (use empty string if not wanted).
character(len=*), intent(in) :: unit !< Unit of this variable (CF-compliant) (use empty string for dimensionless quantities).
integer, optional, intent(in) :: is_timedep !< (Optional) Whether or not (1/0) this variable is time-dependent. (Default: 1)
integer, optional, intent(in) :: dimids(:) !< (Optional) Array with dimension ids, replaces default dimension ordering. Default: ( layerdim, spatialdim, timedim ).
!! This array may contain special dummy values: -1 will be replaced by time dim, -2 by spatial dim, -3 by layer dim. Example: (/ -2, id_seddim, -1 /).
integer :: ierr !< Result status, DFM_NOERR if successful.
! TODO: AvD: inject vectormax dim here AND timedim!!
character(len=10) :: cell_method !< Cell_method for this variable (one of 'mean', 'point', see CF for details).
integer :: ndx1d, lnx2d
integer, parameter :: maxrank = 4 ! TODO: AvD: 3D kmx dim
integer :: idims(maxrank) !< The (max maxrank) dimensions for this variable, pattern: (id_vectormaxdim, id_spacedim, id_timedim). For time-independent scalar data it is filled as: (, , id_spacedim)
integer :: idx_timedim !< Will point to the position in idims where the time dimension should be injected (typically the slowest index).
integer :: idx_spacedim !< Will point to the position in idims where the spatial dimension (face/node/edge) should be injected.
integer :: idx_laydim !< Will point to the position in idims where the layer dimension (3D) should be injected (only if applicable).
integer :: idx_fastdim !< Will point to the first relevant position in idims (i.e. the fastest varying dimension).
integer :: is_timedep_
integer :: ndims, i
ierr = DFM_NOERR
idims = 0
if (present(is_timedep)) then
is_timedep_ = is_timedep
else
is_timedep_ = 1
end if
! Special case: caller supplied its own idims array:
idx_timedim = -1
if (present(dimids)) then
ndims = size(dimids, 1)
if (ndims > maxrank) then
ierr = UG_NOTIMPLEMENTED
goto 888
end if
! idims will be filled backward, starting from last element
idx_fastdim = maxrank-ndims+1
idims(idx_fastdim:maxrank) = dimids(1:ndims)
is_timedep_ = 0 ! Test for timedep in following loop
! Loop all given dimension ids and detect any macro ids that need to be replaced later with time/space/layer dimension id.
do i=idx_fastdim,maxrank
if (idims(i) == -1 .or. idims(i) == mapids%id_timedim) then
is_timedep_ = 1
idx_timedim = i
else if (idims(i) == -2) then
idx_spacedim = i
else if (idims(i) == -3) then
idx_laydim = i
end if
end do
else
if (is_timedep_ > 0) then
idx_timedim = maxrank
idx_spacedim = maxrank-1
else
idx_spacedim = maxrank
end if
! TODO: AvD: here 3D kmx handling
idx_fastdim = idx_spacedim
end if
! TODO: AvD: here vector max handling
! Set the time dimension
if (idx_timedim > 0) then
idims(idx_timedim) = mapids%id_timedim
end if
cell_method = 'mean' !< Default cell average for now. ! TODO: AvD: change this
select case (iloc)
case(UNC_LOC_CN) ! Corner point location
ndx1d = ndxi - ndx2d
if (ndx1d > 0) then
ierr = UG_NOTIMPLEMENTED ! Not implemented corner location for 1D grids yet
goto 888
end if
if (ndx2d > 0) then
cell_method = 'point'
idims(idx_spacedim) = mapids%meshids2d%id_nodedim
ierr = ug_def_var(mapids%ncid, mapids%meshids2d, id_var(2), idims(idx_fastdim:maxrank), itype, UG_LOC_NODE, &
'mesh2d', var_name, standard_name, long_name, unit, cell_method, ifill=-999, dfill=dmiss)
end if
case(UNC_LOC_S) ! Pressure point location
ndx1d = ndxi - ndx2d
if (ndx1d > 0) then
idims(idx_spacedim) = mapids%meshids1d%id_nodedim
ierr = ug_def_var(mapids%ncid, mapids%meshids1d, id_var(1), idims(idx_fastdim:maxrank), itype, UG_LOC_NODE, &
'mesh1d', var_name, standard_name, long_name, unit, cell_method, ifill=-999, dfill=dmiss)
end if
if (ndx2d > 0) then
idims(idx_spacedim) = mapids%meshids2d%id_facedim
ierr = ug_def_var(mapids%ncid, mapids%meshids2d, id_var(2), idims(idx_fastdim:maxrank), itype, UG_LOC_FACE, &
'mesh2d', var_name, standard_name, long_name, unit, cell_method, ifill=-999, dfill=dmiss)
end if
case(UNC_LOC_U) ! Horizontal velocity point location
if (lnx1d > 0) then
idims(idx_spacedim) = mapids%meshids1d%id_edgedim
ierr = ug_def_var(mapids%ncid, mapids%meshids1d, id_var(1), idims(idx_fastdim:maxrank), itype, UG_LOC_EDGE, &
'mesh1d', var_name, standard_name, long_name, unit, cell_method, ifill=-999, dfill=dmiss)
end if
lnx2d = lnxi - lnx1d
if (lnx2d > 0) then
idims(idx_spacedim) = mapids%meshids2d%id_edgedim
ierr = ug_def_var(mapids%ncid, mapids%meshids2d, id_var(2), idims(idx_fastdim:maxrank), itype, UG_LOC_EDGE, &
'mesh2d', var_name, standard_name, long_name, unit, cell_method, ifill=-999, dfill=dmiss)
end if
case default
ierr = UG_INVALID_DATALOCATION
goto 888
end select
return ! Successful return.
888 continue
! Some error occurred
end function unc_def_var_map
! TODO: AvD: support integer/other data types
! TODO: AvD: support in/exclude boundary points/links
!> Writes a map field of a flow variable to a NetCDF map file, taking care of 1D/2D/3D specifics and s/u/w-point specifics.
!! Assumes that the mapids%it_map contains the new time index where to write to.
!! Produces a UGRID-compliant map file.
!! Typical call: unc_put_var(mapids, mapids%id_s1(:), UNC_LOC_S, s1)
function unc_put_var_map(mapids, id_var, iloc, values, default_value) result(ierr)
use m_flowgeom
use network_data, only: numk, numl, numl1d
use m_flow, only: kmx
use dfm_error
use m_missing
implicit none
type(t_unc_mapids), intent(in) :: mapids !< Map file and other NetCDF ids.
integer, intent(in) :: id_var(:) !< Ids of variable to write values into, one for each submesh (1d/2d/3d if applicable)
integer, intent(in) :: iloc !< Stagger location for this variable (one of UNC_LOC_S, UNC_LOC_U, UNC_LOC_W).
double precision, intent(in) :: values(:) !< The data values to be written. Should in standard FM order (1d/2d/3d node/link conventions, @see m_flow).
double precision, optional, intent(in) :: default_value !< Optional default value, used for writing dummy data on closed edges (i.e. netlinks with no flowlink). NOTE: is not a _FillValue!
integer :: ierr !< Result status, DFM_NOERR if successful.
integer :: ndx1d, lnx2d, numl2d
ierr = DFM_NOERR
select case (iloc)
case(UNC_LOC_CN) ! Corner point location
ndx1d = ndxi - ndx2d
if (ndx1d > 0) then
ierr = UG_NOTIMPLEMENTED ! TODO: AvD putting data on 1D corners not implemented yet.
goto 888
end if
if (ndx2d > 0) then
ierr = nf90_put_var(mapids%ncid, id_var(2), values(1:numk), start = (/ 1, mapids%idx_curtime /))
end if
case(UNC_LOC_S) ! Pressure point location
ndx1d = ndxi - ndx2d
if (ndx1d > 0) then
ierr = nf90_put_var(mapids%ncid, id_var(1), values(ndx2d+1:ndxi), start = (/ 1, mapids%idx_curtime /))
end if
if (ndx2d > 0) then
ierr = nf90_put_var(mapids%ncid, id_var(2), values(1:ndx2d), start = (/ 1, mapids%idx_curtime /))
end if
! TODO: AVD: handle 3D non-depth-averaged data here! Maybe with UNC_LOC_SK?
case(UNC_LOC_U) ! Horizontal velocity point location
if (lnx1d > 0) then
ierr = nf90_put_var(mapids%ncid, id_var(1), values(1:lnx1d), start = (/ 1, mapids%idx_curtime /))
end if
lnx2d = lnx - lnx1d ! TODO: AvD: now also includes 1D bnds, dont want that.
if (lnx2d > 0) then
ierr = nf90_put_var(mapids%ncid, id_var(2), values(lnx1d+1:lnx), start = (/ 1, mapids%idx_curtime /))
end if
! Default value is different from a fill value, use for example for zero velocities on closed edges.
if (present(default_value)) then
numl2d = numl - numl1d
ierr = nf90_put_var(mapids%ncid, id_var(2), (/ default_value /), start = (/ lnx2d+1, mapids%idx_curtime /), count = (/ numl2d - lnx2d, 1 /), map = (/ 0 /)) ! Use map = 0 to write a single value on multiple edges in file.
end if
! TODO: AVD: handle 3D non-depth-averaged data here!
! TODO: AVD: handle UNC_LOC_W
case default
ierr = UG_INVALID_DATALOCATION
goto 888
end select
return ! Successful return.
888 continue
! Some error occurred
end function unc_put_var_map
!> Puts global attributes in NetCDF data set.
!! This includes: institution, Conventions, etc.
subroutine unc_addglobalatts(ncid)
!use unstruc_model, only : md_ident
integer, intent(in) :: ncid
character*8 :: cdate
character*10 :: ctime
character*5 :: czone
integer :: ierr, jaInDefine
ierr = nf90_noerr
jaInDefine = 0
ierr = nf90_redef(ncid)
if (ierr == nf90_eindefine) jaInDefine = 1 ! Was still in define mode.
if (ierr /= nf90_noerr .and. ierr /= nf90_eindefine) then
write (msgbuf, '(a,i0,a,i0,a,a)') 'Could not put global attributes in NetCDF #', ncid, '. Error code ', ierr, ': ', nf90_strerror(ierr)
call err_flush()
return
end if
ierr = nf90_put_att(ncid, nf90_global, 'institution', trim(unstruc_company))
ierr = nf90_put_att(ncid, nf90_global, 'references', trim(unstruc_company_url))
ierr = nf90_put_att(ncid, nf90_global, 'source', &
unstruc_version_full// &
', model ')!''//trim(md_ident)//'''')
call date_and_time(cdate, ctime, czone)
ierr = nf90_put_att(ncid, nf90_global, 'history', &
'Created on '//cdate(1:4)//'-'//cdate(5:6)//'-'//cdate(7:8)//'T'//ctime(1:2)//':'//ctime(3:4)//':'//ctime(5:6)//czone(1:5)// &
', '//trim(unstruc_program))
ierr = nf90_put_att(ncid, nf90_global, 'date_created', cdate(1:4)//'-'//cdate(5:6)//'-'//cdate(7:8)//'T'//ctime(1:2)//':'//ctime(3:4)//':'//ctime(5:6)//czone(1:5))
ierr = nf90_put_att(ncid, nf90_global, 'date_modified', cdate(1:4)//'-'//cdate(5:6)//'-'//cdate(7:8)//'T'//ctime(1:2)//':'//ctime(3:4)//':'//ctime(5:6)//czone(1:5))
ierr = nf90_put_att(ncid, nf90_global, 'Conventions', 'CF-1.5 Deltares-0.1')
! Leave the dataset in the same mode as we got it.
if (jaInDefine == 0) then
ierr = nf90_enddef(ncid)
end if
end subroutine unc_addglobalatts
! TODO: AvD: add these (incrementally) to map/his files:
!> :time_coverage_start = "2010-04-23T00:00:00+01:00" ;
!> :time_coverage_end = "2010-05-20T00:00:00+01:00" ;
! (can be done outside of definition mode, if att was already created before.)
!> Opens a NetCDF file for reading.
!! The file is maintained in the open-file-list.
function unc_open(filename, cmode, ncid)
character(len=*), intent(in ) :: filename
integer, intent(in ) :: cmode
integer, intent(out) :: ncid
integer :: unc_open
unc_open = nf90_open(trim(filename), cmode, ncid)
if (unc_open == nf90_noerr) then
nopen_files_ = nopen_files_ + 1
open_files_(nopen_files_) = filename
open_datasets_(nopen_files_) = ncid
write (msgbuf, '(a,a,a,i10,a)') 'Opened ''', trim(filename), ''' as #', ncid, '.'
call dbg_flush()
else
call mess(LEVEL_WARN, 'could not open '//trim(filename))
call dbg_flush()
call qnerror('Failed to open: '//trim(filename), ' ', ' ')
end if
end function unc_open
!> Creates or opens a NetCDF file for writing.
!! The file is maintained in the open-file-list.
function unc_create(filename, cmode, ncid)
character(len=*), intent(in ) :: filename
integer, intent(in ) :: cmode
integer, intent(out) :: ncid
integer :: unc_create
unc_create = nf90_create(filename, cmode, ncid)
if (unc_create == nf90_noerr) then
nopen_files_ = nopen_files_ + 1
open_files_(nopen_files_) = filename
open_datasets_(nopen_files_) = ncid
write (msgbuf, '(a,a,a,i0,a)') 'Opened NetCDF file ''', trim(filename), ''' as #', ncid, '.'
call dbg_flush()
call unc_addglobalatts(ncid)
else
write (msgbuf, '(a,a,a,i0,a,i0,a,a)') 'Cannot open NetCDF file ''', trim(filename), ''' as #', ncid, '. Error code: ', unc_create, ': ', nf90_strerror(unc_create)
call dbg_flush()
end if
end function unc_create
!> Closes a NetCDF file.
!! The file is removed from the open-file-list
integer function unc_close(ncid)
integer, intent(inout) :: ncid
integer :: i, j
logical :: jafound
unc_close = 0
jafound = .false.
! Search dataset ID
do i=nopen_files_,1,-1
if (open_datasets_(i) == ncid) then
jafound = .true.
exit
end if
end do
! If found, shift all entries behind it one to the left.
if (jafound) then
unc_close = nf90_close(ncid)
write (msgbuf, '(a,a,a)') 'Closed NetCDF file ''', trim(open_files_(nopen_files_)), '.'
call dbg_flush()
do j=nopen_files_-1,-1,i
open_files_(j) = open_files_(j+1)
open_datasets_(j) = open_datasets_(j+1)
end do
open_files_(nopen_files_) = ' '
open_datasets_(nopen_files_) = 0
nopen_files_ = nopen_files_ - 1
ncid = 0
else
write (msgbuf, '(a,i3,a)') 'Tried to close NetCDF id ', ncid, ', not found.'
call dbg_flush()
end if
end function unc_close
!> Closes all NetCDF files that are still open.
subroutine unc_closeall()
integer :: i, istat
do i = nopen_files_,1,-1
istat = unc_close(open_datasets_(i))
end do
end subroutine unc_closeall
!> Adds coordinate attributes according to CF conventions, based on jsferic.
!! Non-standard attributes (such as long_name) should be set elsewhere.
function unc_addcoordatts(ncid, id_varx, id_vary, jsferic)
integer, intent(in) :: ncid !< NetCDF dataset id
integer, intent(in) :: id_varx !< NetCDF horizontal variable id
integer, intent(in) :: id_vary !< NetCDF vertical variable id
integer, intent(in) :: jsferic !< Sferical coords or not (1/0)
integer :: unc_addcoordatts !< Result status of NetCDF primitives
integer :: ierr
if (jsferic == 0) then
ierr = nf90_put_att(ncid, id_varx, 'units', 'm')
ierr = nf90_put_att(ncid, id_vary, 'units', 'm')
ierr = nf90_put_att(ncid, id_varx, 'standard_name', 'projection_x_coordinate')
ierr = nf90_put_att(ncid, id_vary, 'standard_name', 'projection_y_coordinate')
ierr = nf90_put_att(ncid, id_varx, 'long_name' , 'x')
ierr = nf90_put_att(ncid, id_vary, 'long_name' , 'y')
else
ierr = nf90_put_att(ncid, id_varx, 'units', 'degrees_east')
ierr = nf90_put_att(ncid, id_vary, 'units', 'degrees_north')
ierr = nf90_put_att(ncid, id_varx, 'standard_name', 'longitude')
ierr = nf90_put_att(ncid, id_vary, 'standard_name', 'latitude')
ierr = nf90_put_att(ncid, id_varx, 'long_name' , 'longitude')
ierr = nf90_put_att(ncid, id_vary, 'long_name' , 'latitude')
end if
unc_addcoordatts = ierr
end function unc_addcoordatts
!> Add longitude and latitude coordinates to a NetCDF dataset.
!!
!! Lon/lat coordinates are required by CF-standards, even if the coordinates
!! used are projected Cartesian. Two new coordinate variables are added
!! to the NetCDF id (e.g. a .nc file), but only if jsferic==0.
!! The names for the new variables are based on varbasename and a postfix.
function unc_add_lonlat_vars(ncid, varnameprefix, varnamepostfix, id_dims, id_varlon, id_varlat, jsferic) result(ierr)
integer, intent(in) :: ncid !< NetCDF dataset id
character(len=*), intent(in) :: varnameprefix !< Base text string for new lon lat variable names.
character(len=*), intent(in) :: varnamepostfix !< Text string to be appended for new lon lat variable names.
integer, dimension(:), intent(in) :: id_dims !< Array with NetCDF dimension ids for the coordinate variables.
integer, intent(out) :: id_varlon !< NetCDF horizontal variable id
integer, intent(out) :: id_varlat !< NetCDF vertical variable id
integer, intent(in) :: jsferic !< Spherical coords or not (1/0). If 1, nothing happens.
integer :: ierr !< Result status of NetCDF primitives
ierr = 0
! If current system is already spherical, lon/lat should already be present.
if (jsferic == 1) then
return
end if
! Define lon and lat variables
ierr = nf90_def_var(ncid, trim(varnameprefix)//'_lon'//trim(varnamepostfix), nf90_double, id_dims, id_varlon)
call check_error(ierr, 'Add longitude variable for '//trim(varnameprefix))
ierr = nf90_def_var(ncid, trim(varnameprefix)//'_lat'//trim(varnamepostfix), nf90_double, id_dims, id_varlat)
call check_error(ierr, 'Add latitude variable for '//trim(varnameprefix))
! Add standard spherical coordinate attributes
ierr = unc_addcoordatts(ncid, id_varlon, id_varlat, 1)
!ierr = unc_addcoordmapping(ncid, 1)
!call check_error(ierr, 'Add grid_mapping variable for '//trim(varnameprefix)//'_lon'//trim(varnamepostfix)//'/_lat'//trim(varnamepostfix))
!ierr = unc_add_gridmapping_att(ncid, (/ id_varlon, id_varlat /), 1)
!call check_error(ierr, 'Add grid_mapping attributes to '//trim(varnameprefix)//'_lon'//trim(varnamepostfix)//'/_lat'//trim(varnamepostfix))
end function unc_add_lonlat_vars
!> Adds coordinate mapping attributes according to CF conventions, based on jsferic.
!! Attributes are put in a scalar integer variable.
function unc_addcoordmapping(ncid, jsferic)
use m_sferic, only: ra
integer, intent(in) :: ncid !< NetCDF dataset id
integer, intent(in) :: jsferic !< Spherical coords or not (1/0)
integer :: unc_addcoordmapping !< Result status of NetCDF primitives
integer :: ierr, id_crs
integer :: epsg
character(len=11) :: epsgstring
character(len=30) :: varname !< Name of the created grid mapping variable.
epsgstring = ' '
! AvD: TODO: Name and params are now hardcoded globally based on a single jsferic=0/1 flag.
! generalize this!
crs%is_spherical = (jsferic == 1)
ierr = ug_add_coordmapping(ncid, crs) ! TODO: AvD: temp, this now uses the global crs instead of in meshgeom/jsferic
if (ierr /= ug_noerr) then
ierr = ug_get_message(msgbuf)
if (len_trim(msgbuf) > 0) then
call warn_flush()
end if
end if
unc_addcoordmapping = ierr
return
!! RETURN !!
varname = ' '
if (jsferic == 0) then
varname = 'projected_coordinate_system'
else
varname = 'wgs84'
end if
ierr = nf90_inq_varid(ncid, trim(varname), id_crs)
if (ierr == nf90_noerr) then
! A variable with that name already exists. Return.
unc_addcoordmapping = ierr
return
end if
ierr = nf90_def_var(ncid, trim(varname), nf90_int, id_crs)
if (jsferic == 0) then
epsg = 28992
epsgstring = 'EPGS:28992'
ierr = nf90_put_att(ncid, id_crs, 'name', 'Unknown projected' ) ! CF
ierr = nf90_put_att(ncid, id_crs, 'epsg', epsg ) ! CF
ierr = nf90_put_att(ncid, id_crs, 'grid_mapping_name', 'Unknown projected' ) ! CF
ierr = nf90_put_att(ncid, id_crs, 'longitude_of_prime_meridian', 0d0 ) ! CF
ierr = nf90_put_att(ncid, id_crs, 'semi_major_axis', ra ) ! CF
ierr = nf90_put_att(ncid, id_crs, 'semi_minor_axis', 6356752.314245d0 ) ! CF
ierr = nf90_put_att(ncid, id_crs, 'inverse_flattening', 298.257223563d0 ) ! CF
ierr = nf90_put_att(ncid, id_crs, 'proj4_params', ' ' ) ! ADAGUC
ierr = nf90_put_att(ncid, id_crs, 'EPSG_code', trim(epsgstring) ) ! ADAGUC
ierr = nf90_put_att(ncid, id_crs, 'projection_name', ' ' ) ! ADAGUC
ierr = nf90_put_att(ncid, id_crs, 'wkt', ' ' ) ! WKT
ierr = nf90_put_att(ncid, id_crs, 'comment', ' ' )
ierr = nf90_put_att(ncid, id_crs, 'value', 'value is equal to EPSG code')
else
epsg = 4326
epsgstring = 'EPGS:4326'
ierr = nf90_put_att(ncid, id_crs, 'name', 'WGS84' ) ! CF
ierr = nf90_put_att(ncid, id_crs, 'epsg', epsg ) ! CF
ierr = nf90_put_att(ncid, id_crs, 'grid_mapping_name', 'latitude_longitude') ! CF
ierr = nf90_put_att(ncid, id_crs, 'longitude_of_prime_meridian', 0d0 ) ! CF
ierr = nf90_put_att(ncid, id_crs, 'semi_major_axis', ra ) ! CF
ierr = nf90_put_att(ncid, id_crs, 'semi_minor_axis', 6356752.314245d0 ) ! CF
ierr = nf90_put_att(ncid, id_crs, 'inverse_flattening', 298.257223563d0 ) ! CF
ierr = nf90_put_att(ncid, id_crs, 'proj4_params', ' ' ) ! ADAGUC
ierr = nf90_put_att(ncid, id_crs, 'EPSG_code', trim(epsgstring) ) ! ADAGUC
ierr = nf90_put_att(ncid, id_crs, 'projection_name', ' ' ) ! ADAGUC
ierr = nf90_put_att(ncid, id_crs, 'wkt', ' ' ) ! WKT
ierr = nf90_put_att(ncid, id_crs, 'comment', ' ' )
ierr = nf90_put_att(ncid, id_crs, 'value', 'value is equal to EPSG code')
end if
unc_addcoordmapping = ierr
end function unc_addcoordmapping
!> Add the grid mapping attribute to one or more NetCDF variables.
!!
!! The specified gridmappingname should be an existing variable in the NetCDF dataset.
function unc_add_gridmapping_att(ncid, id_vars, jsferic) result(ierr)
integer, intent(in) :: ncid !< NetCDF dataset id
integer, dimension(:), intent(in) :: id_vars !< Array of NetCDF variable ids
integer, intent(in) :: jsferic !< Spherical coords or not (1/0)
integer :: ierr !< Result status of NetCDF primitives
integer :: i, n, ierr_
character(len=30) :: gridmappingvar !< Name of grid mapping variable
gridmappingvar = ' '
if (jsferic == 0) then
gridmappingvar = 'projected_coordinate_system' ! TODO: AvD: this works, but we have parts in ug_add_coord_mapping, and parts here. Unify!
else
gridmappingvar = 'wgs84'
end if
ierr = nf90_noerr
n = size(id_vars)
do i=1,n
if (id_vars(i) == nf90_global) then
cycle ! Sometimes id_vars has value 0 (== unintended nf90_global)
end if
ierr_ = nf90_put_att(ncid, id_vars(i), 'grid_mapping', trim(gridmappingvar))
if (ierr_ /= nf90_noerr) then
ierr = ierr_
end if
end do
end function unc_add_gridmapping_att
!> Defines 3d net data structure for an already opened netCDF dataset.
subroutine unc_append_3dflowgeom_def(imapfile)
use m_flow !only kmx, zws, layertype
use m_flowparameters !only jafullgridoutput
integer, intent(in) :: imapfile
integer, save :: ierr, &
id_laydim,id_wdim, &
id_timedim, &
id_flowelemdim, &
id_flowelemzcc, &
id_flowelemzw, &
id_laycoordcc, &
id_laycoordw
!define file structure
ierr = nf90_def_dim(imapfile, 'laydim', kmx, id_laydim)
ierr = nf90_def_dim(imapfile, 'wdim', kmx+1, id_wdim)
!
if (layertype<3) then !time-independent sigma layer and z layer
ierr = nf90_def_var(imapfile, 'LayCoord_cc', nf90_double, (/id_laydim/), id_laycoordcc)
ierr = nf90_def_var(imapfile, 'LayCoord_w' , nf90_double, (/id_wdim/), id_laycoordw)
!
!define and write compact form output of sigma or z-layer
if (layertype==1) then !all sigma layers
ierr = nf90_put_att(imapfile, id_laycoordcc, 'standard_name', 'ocean_sigma_coordinate')
ierr = nf90_put_att(imapfile, id_laycoordcc, 'long_name' , 'Sigma layer coordinate at flow element center')
ierr = nf90_put_att(imapfile, id_laycoordcc, 'units' , '')
ierr = nf90_put_att(imapfile, id_laycoordcc, 'positive' , 'up')
ierr = nf90_put_att(imapfile, id_laycoordcc, 'formula_terms', 'sigma: LayCoord_cc eta: s1 bedlevel: FlowElem_bl')
!
ierr = nf90_put_att(imapfile, id_laycoordw , 'standard_name', 'ocean_sigma_coordinate')
ierr = nf90_put_att(imapfile, id_laycoordw , 'long_name' , 'Sigma layer coordinate at vertical interface')
ierr = nf90_put_att(imapfile, id_laycoordw , 'units' , '')
ierr = nf90_put_att(imapfile, id_laycoordw , 'positive' , 'up')
ierr = nf90_put_att(imapfile, id_laycoordw , 'formula_terms', 'sigma: LayCoord_w eta: s1 bedlevel: FlowElem_bl')
!
elseif (layertype==2) then !all z layers
ierr = nf90_put_att(imapfile, id_laycoordcc, 'standard_name', '')
ierr = nf90_put_att(imapfile, id_laycoordcc, 'long_name' , 'Z layer coordinate at flow element center')
ierr = nf90_put_att(imapfile, id_laycoordcc, 'positive' , 'up')
ierr = nf90_put_att(imapfile, id_laycoordcc, 'units' , 'm')
!
ierr = nf90_put_att(imapfile, id_laycoordw , 'standard_name', '')
ierr = nf90_put_att(imapfile, id_laycoordw , 'long_name' , 'Z layer coordinate at vertical interface')
ierr = nf90_put_att(imapfile, id_laycoordw , 'positive' , 'up')
ierr = nf90_put_att(imapfile, id_laycoordw , 'units' , 'm')
!
endif
else
if (jafullgridoutput==0) then
call mess(LEVEL_WARN, 'No grid outputdata given - Set "FullGridOutput = 1" in .mdu file to output grid data')
endif
endif
!
if ( jafullgridoutput.eq.1 ) then
! structured 3d time-dependant output data
ierr = nf90_inq_dimid(imapfile, 'time', id_timedim)
ierr = nf90_inq_dimid(imapfile, 'nFlowElem', id_flowelemdim)
if (ierr /= nf90_noerr) then
ierr = nf90_inq_dimid(imapfile, 'nFlowElemWithBnd', id_flowelemdim)
end if
!
ierr = nf90_def_var(imapfile, 'FlowElem_zcc', nf90_double, (/ id_laydim, id_flowelemdim, id_timedim /) , id_flowelemzcc)
ierr = nf90_def_var(imapfile, 'FlowElem_zw' , nf90_double, (/ id_wdim, id_flowelemdim, id_timedim /) , id_flowelemzw)
!
ierr = nf90_put_att(imapfile, id_flowelemzcc, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_flowelemzcc, 'standard_name', '')
ierr = nf90_put_att(imapfile, id_flowelemzcc, 'long_name' , 'Flow element center z')
ierr = nf90_put_att(imapfile, id_flowelemzcc, 'units' , 'm')
!
ierr = nf90_put_att(imapfile, id_flowelemzw , 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_flowelemzw , 'standard_name', '')
ierr = nf90_put_att(imapfile, id_flowelemzw , 'long_name' , 'Flow element z at vertical interface')
ierr = nf90_put_att(imapfile, id_flowelemzw , 'units' , 'm')
end if
!
end subroutine unc_append_3dflowgeom_def
subroutine unc_append_3dflowgeom_put(imapfile, jaseparate, itim_in)
use m_flow !only kmx, zws, layertype
use m_flowgeom !only Ndxi
use m_flowparameters !only jafullgridoutput
! use network_data !
integer, intent(in) :: imapfile
integer, intent(in) :: jaseparate
integer,optional, intent(in) :: itim_in
integer :: iid, kk, kb, kt, itim
integer, save :: ierr
integer, dimension(2), save :: &
id_laydim,id_wdim, &
id_timedim, &
id_flowelemdim, &
id_flowelemzcc, &
id_flowelemzw, &
id_laycoordcc, &
id_laycoordw
logical, dimension(2), save :: firststep = .true.
if (present(itim_in)) then
itim = itim_in
else
itim = 1
end if
if (jaseparate == 2) then
! comfile, store/use ids number 2
iid = 2
else
! mapfile, store/use ids number 1
iid = 1
endif
!
! inquire ids of netcdf file if it is the first step of writing to the file
! or if it is a seperate write file
!
if (firststep(iid) .or. jaseparate>0) then
firststep(iid) = .false.
ierr = nf90_inq_dimid(imapfile, 'laydim', id_laydim(iid))
ierr = nf90_inq_dimid(imapfile, 'wdim', id_wdim(iid))
!
if (layertype<3) then
!time-independent sigma layer and z layer
ierr = nf90_inq_varid(imapfile, 'LayCoord_cc', id_laycoordcc(iid))
ierr = nf90_inq_varid(imapfile, 'LayCoord_w' , id_laycoordw(iid))
!
! write 3d time-independent output data to netcdf file
!
if (layertype == 1) then
! structured 3d time-independent output data (sigma-layer)
ierr = nf90_put_var(imapfile, id_laycoordcc(iid), 0.5d0*(zslay(1:kmx,1)+zslay(0:kmx-1,1)), start=(/ 1 /), count=(/ kmx /))
ierr = nf90_put_var(imapfile, id_laycoordw (iid), zslay(0:kmx,1), start=(/ 1 /), count=(/ kmx+1 /))
elseif (layertype == 2) then
! structured 3d time-independent output data (z-layer)
! ierr = nf90_put_var(imapfile, id_laycoordcc(iid), 0.5d0*(zslay(1:kmx,1)+zslay(0:kmx-1,1)), start=(/ 1 /), count=(/ kmx /))
! ierr = nf90_put_var(imapfile, id_laycoordw(iid) , zslay(0:kmx,1), start=(/ 1 /), count=(/ kmx+1 /))
endif
endif
!
if ( jafullgridoutput.eq.1 ) then
! get id's for structured 3d time-dependant output data
ierr = nf90_inq_dimid(imapfile, 'time', id_timedim(iid))
ierr = nf90_inq_dimid(imapfile, 'nFlowElem', id_flowelemdim(iid))
if (ierr /= nf90_noerr) then
ierr = nf90_inq_dimid(imapfile, 'nFlowElemWithBnd', id_flowelemdim(iid))
end if
!
ierr = nf90_inq_varid(imapfile, 'FlowElem_zcc', id_flowelemzcc(iid))
ierr = nf90_inq_varid(imapfile, 'FlowElem_zw' , id_flowelemzw(iid))
!
end if
endif
!
if ( jafullgridoutput.eq.1 ) then
! write structured 3d time-dependant output data
do kk=1,Ndxi
call getkbotktop(kk,kb,kt)
ierr = nf90_put_var(imapfile, id_flowelemzcc(iid), 0.5d0*(zws(kb:kt)+zws(kb-1:kt-1)), start=(/ 1, kk, itim /), count=(/ kt-kb+1, 1, 1 /))
ierr = nf90_put_var(imapfile, id_flowelemzw(iid), zws(kb-1:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+2, 1, 1 /))
end do
end if
!
end subroutine unc_append_3dflowgeom_put
!> Writes the unstructured flow net + flow data to a netCDF file.
!! If file exists, it will be overwritten. Therefore, only use this routine
!! for separate snapshots, the automated rst file should be filled by calling
!! unc_write_rst_filepointer directly.
subroutine unc_write_rst(filename)
character(len=*), intent(in) :: filename
integer :: irstfile, ierr
ierr = unc_create(filename, 0, irstfile)
if (ierr /= nf90_noerr) then
call mess(LEVEL_ERROR, 'Could not create rst file '''//trim(filename)//'''.')
call check_error(ierr)
return
end if
call unc_write_rst_filepointer(irstfile, 0d0)
ierr = unc_close(irstfile)
end subroutine unc_write_rst
!> Writes rst/flow data to a newly opened netCDF dataset.
!! The netnode and -links have been written already.
subroutine unc_write_rst_filepointer(irstfile, tim)
use m_flow
use m_flowtimes
use m_flowgeom
use m_sferic
use network_data
use m_sediment
use m_transport, only: NUMCONST, ISALT, ITEMP, ISED1, ITRA1, ITRAN, constituents, itrac2const, const_names
use m_xbeach_data, only: E, H, R
integer, intent(in) :: irstfile
real(kind=hp), intent(in) :: tim
integer, save :: ierr
integer, save :: &
!id_netcelldim, id_netcellmaxnodedim, id_netcellcontourptsdim, &
id_laydim, id_wdim, &
id_flowelemdim, &
id_maxfracdim, &
id_erolaydim, &
id_flowlinkdim, &
id_timedim, &
id_bndsaldim, &
id_bndtemdim, &
id_bndseddim, &
id_time, id_timestep, &
id_s1, id_taus, id_ucx, id_ucy, id_ucz, id_unorm, id_q1, id_ww1, id_sa1, id_tem1, id_sed, id_ero, id_s0, id_u0, &
id_cftrt, id_czs, id_E, id_R, id_H, id_D, id_DR, id_urms, id_thetamean, &
id_cwav, id_cgwav, id_sigmwav, id_ust, id_Fx, id_Fy, id_vst, &
id_tsalbnd, id_zsalbnd, id_ttembnd, id_ztembnd, id_tsedbnd, id_zsedbnd
integer, allocatable, save :: id_tr1(:), id_bndtradim(:), id_ttrabnd(:), id_ztrabnd(:)
integer :: i, numContPts, numNodes, itim, k, kb, kt, kk, LL, Lb, Lt, iconst, L, j
double precision, allocatable :: max_threttim(:)
double precision, dimension(:), allocatable :: dum
character(len=8) :: numformat
character(len=2) :: numtrastr
! Grid and flow geometry
! hk: not now call unc_write_net_filepointer(irstfile) ! Write standard net data as well
! please fix call unc_write_flowgeom_filepointer(irstfile) ! Write time-independent flow geometry data
! ierr = nf90_inq_dimid(irstfile, 'nFlowElem', id_flowelemdim)
! ierr = nf90_inq_dimid(irstfile, 'nFlowLink', id_flowlinkdim)
numformat = '(I2.2)'
if (lnx > 0) then
ierr = nf90_def_dim(irstfile, 'nFlowLink', lnx, id_flowlinkdim)
endif
if (ndx > 0) then
ierr = nf90_def_dim(irstfile, 'nFlowElem', ndxi, id_flowelemdim)
endif
! Definition and attributes of time
ierr = nf90_def_dim(irstfile, 'time', nf90_unlimited, id_timedim)
call check_error(ierr, 'def time dim')
ierr = nf90_def_var(irstfile, 'time', nf90_double, id_timedim, id_time)
ierr = nf90_put_att(irstfile, id_time, 'units' , 'seconds since '//refdat(1:4)//'-'//refdat(5:6)//'-'//refdat(7:8)//' 00:00:00')
ierr = nf90_put_att(irstfile, id_time, 'standard_name', 'time')
! Definition and attributes of 3D geometry
if (kmx > 0) then
! call unc_append_3dflowgeom_def(irstfile) ! Append definition of time-independent 3d flow geometry data
! ierr = nf90_inq_dimid(irstfile, 'laydim', id_laydim)
! ierr = nf90_inq_dimid(irstfile, 'wdim', id_wdim)
ierr = nf90_def_dim(irstfile, 'laydim', kmx, id_laydim)
ierr = nf90_def_dim(irstfile, 'wdim', kmx+1, id_wdim)
end if
! Thatcher-Harleman boundary data dimensions
! TODO: AvD, GvO: NOTE! I renamed al TH-stuf below consistent with the original meaning of numtracers.
! BUT, we should double-check: should we not maintain TH lags for *all* open boundaries, for *all* constituents?
if(allocated(threttim)) then
allocate(max_threttim(NUMCONST))
max_threttim = maxval(threttim,dim=2)
if(jasal > 0) then
if(max_threttim(ISALT) > 0d0) then
ierr = nf90_def_dim(irstfile, 'salbndpt', nbnds, id_bndsaldim)
endif
endif
if(jatem > 0) then
if(max_threttim(ITEMP) > 0d0) then
ierr = nf90_def_dim(irstfile, 'tembndpt', nbndtm, id_bndtemdim)
endif
endif
if(jased > 0) then
if(max_threttim(ISED1) > 0d0) then
ierr = nf90_def_dim(irstfile, 'sedbndpt', nbndsd, id_bndseddim)
endif
endif
if(numtracers > 0) then
if(.not. allocated(id_bndtradim)) then
allocate(id_bndtradim(numtracers))
endif
do i=1,numtracers
iconst = itrac2const(i)
if(max_threttim(iconst) > 0d0) then
write(numtrastr,numformat) i
ierr = nf90_def_dim(irstfile, 'trbndpt'//trim(numtrastr), nbndtr(i), id_bndtradim(i))
endif
enddo
endif
endif
! Definition and attributes of size of latest timestep
ierr = nf90_def_var(irstfile, 'timestep', nf90_double, id_timedim, id_timestep)
ierr = nf90_put_att(irstfile, id_timestep, 'units' , 'seconds')
ierr = nf90_put_att(irstfile, id_timestep, 'standard_name', 'timestep')
! Definition and attributes of flow data on centres: water level at latest timestep
ierr = nf90_def_var(irstfile, 's1', nf90_double, (/ id_flowelemdim, id_timedim /) , id_s1)
ierr = nf90_put_att(irstfile, id_s1, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_s1, 'standard_name', 'sea_surface_height') ! sorry for inland water people
ierr = nf90_put_att(irstfile, id_s1, 'long_name' , 'waterlevel') ! sorry long name is shorter than standard name
ierr = nf90_put_att(irstfile, id_s1, 'units' , 'm')
! Definition and attributes of flow data on centres: water level timestep before the latest timestep
ierr = nf90_def_var(irstfile, 's0', nf90_double, (/ id_flowelemdim, id_timedim /) , id_s0)
ierr = nf90_put_att(irstfile, id_s0, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_s0, 'standard_name', 'sea_surface_height') ! sorry for inland water people
ierr = nf90_put_att(irstfile, id_s0, 'long_name' , 'waterlevel old') ! sorry long name is shorter than standard name
ierr = nf90_put_att(irstfile, id_s0, 'units' , 'm')
! Definition and attributes of flow data on centres: shear stress
ierr = nf90_def_var(irstfile, 'taus' , nf90_double, (/ id_flowelemdim, id_timedim /) , id_taus)
ierr = nf90_put_att(irstfile, id_taus, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_taus, 'standard_name', 'taucurrent')
ierr = nf90_put_att(irstfile, id_taus, 'long_name' , 'taucurrent in cell center')
ierr = nf90_put_att(irstfile, id_taus, 'units' , 'N/m2')
! Definition and attributes of flow data on centres: chezy roughness
ierr = nf90_def_var(irstfile, 'czs' , nf90_double, (/ id_flowelemdim, id_timedim /) , id_czs)
ierr = nf90_put_att(irstfile, id_czs, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_czs, 'long_name' , 'Chezy roughness in cell center')
ierr = nf90_put_att(irstfile, id_czs, 'units' , 'm0.5s-1')
! Definition of 3D data
if (kmx > 0) then
! Definition and attributes of flow data on edges: velocity magnitude at latest timestep
ierr = nf90_def_var(irstfile, 'unorm' , nf90_double, (/ id_laydim, id_flowlinkdim, id_timedim /) , id_unorm)
ierr = nf90_put_att(irstfile, id_unorm,'standard_name', 'sea_water_speed')
ierr = nf90_put_att(irstfile, id_unorm,'long_name', 'Normal component of sea_water_speed')
ierr = nf90_put_att(irstfile, id_unorm,'units' , 'm s-1')
ierr = nf90_put_att(irstfile, id_unorm,'coordinates' , 'FlowLink_xu FlowLink_yu')
! Definition and attributes of flow data on edges: velocity magnitude at previous timestep
ierr = nf90_def_var(irstfile, 'u0' , nf90_double, (/ id_laydim, id_flowlinkdim, id_timedim /) , id_u0)
ierr = nf90_put_att(irstfile, id_u0 ,'standard_name', 'sea_water_speed')
ierr = nf90_put_att(irstfile, id_u0 ,'long_name', 'Normal component of sea_water_speed at previous time t0')
ierr = nf90_put_att(irstfile, id_u0 ,'units' , 'm s-1')
ierr = nf90_put_att(irstfile, id_u0 ,'coordinates' , 'FlowLink_xu FlowLink_yu')
! Definition and attributes of flow data on edges: discharge
ierr = nf90_def_var(irstfile, 'q1' , nf90_double, (/ id_laydim, id_flowlinkdim, id_timedim /) , id_q1)
ierr = nf90_put_att(irstfile, id_q1 ,'standard_name', 'discharge')
ierr = nf90_put_att(irstfile, id_q1 ,'long_name', 'Discharge through cell edge at current time')
ierr = nf90_put_att(irstfile, id_q1 ,'units' , 'm3 s-1')
ierr = nf90_put_att(irstfile, id_q1 ,'coordinates' , 'FlowLink_xu FlowLink_yu')
! Definition and attributes of flow data on centres: x-component of the velocity
ierr = nf90_def_var(irstfile, 'ucx', nf90_double, (/ id_laydim, id_flowelemdim, id_timedim /) , id_ucx)
ierr = nf90_put_att(irstfile, id_ucx, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_ucx, 'standard_name', 'eastward_sea_water_velocity')
ierr = nf90_put_att(irstfile, id_ucx, 'long_name' , 'eastward velocity on cell center')
ierr = nf90_put_att(irstfile, id_ucx, 'units' , 'm s-1')
! Definition and attributes of flow data on centres: y-component of the velocity
ierr = nf90_def_var(irstfile, 'ucy', nf90_double, (/ id_laydim, id_flowelemdim, id_timedim /) , id_ucy)
ierr = nf90_put_att(irstfile, id_ucy, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_ucy, 'standard_name', 'northward_sea_water_velocity')
ierr = nf90_put_att(irstfile, id_ucy, 'long_name' , 'northward velocity on cell center')
ierr = nf90_put_att(irstfile, id_ucy, 'units' , 'm s-1')
! Definition and attributes of flow data on centres: z-component of the velocity
ierr = nf90_def_var(irstfile, 'ucz', nf90_double, (/ id_laydim, id_flowelemdim, id_timedim /) , id_ucz)
ierr = nf90_put_att(irstfile, id_ucz, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_ucz, 'standard_name', 'upward_sea_water_velocity')
ierr = nf90_put_att(irstfile, id_ucz, 'long_name' , 'upward velocity on cell center')
ierr = nf90_put_att(irstfile, id_ucz, 'units' , 'm s-1')
! Definition and attributes of flow data on centres: z-component of the velocity on vertical interface
ierr = nf90_def_var(irstfile, 'ww1', nf90_double, (/ id_wdim, id_flowelemdim, id_timedim /) , id_ww1)
ierr = nf90_put_att(irstfile, id_ww1, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_ww1, 'standard_name', 'upward_sea_water_velocity') ! same standard name allowed?
ierr = nf90_put_att(irstfile, id_ww1, 'long_name' , 'upward velocity on vertical interface') ! (upward normal or upward)?
ierr = nf90_put_att(irstfile, id_ww1, 'units' , 'm s-1')
else
! Definition and attributes of flow data on centres: x-component of the velocity
ierr = nf90_def_var(irstfile, 'ucx', nf90_double, (/ id_flowelemdim, id_timedim /) , id_ucx)
ierr = nf90_put_att(irstfile, id_ucx, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_ucx, 'standard_name', 'eastward_sea_water_velocity')
ierr = nf90_put_att(irstfile, id_ucx, 'long_name' , 'eastward velocity on cell center')
ierr = nf90_put_att(irstfile, id_ucx, 'units' , 'm s-1')
! Definition and attributes of flow data on centres: y-component of the velocity
ierr = nf90_def_var(irstfile, 'ucy', nf90_double, (/ id_flowelemdim, id_timedim /) , id_ucy)
ierr = nf90_put_att(irstfile, id_ucy, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_ucy, 'standard_name', 'northward_sea_water_velocity')
ierr = nf90_put_att(irstfile, id_ucy, 'long_name' , 'northward velocity on cell center')
ierr = nf90_put_att(irstfile, id_ucy, 'units' , 'm s-1')
! Definition and attributes of flow data on edges: velocity magnitude at latest timestep
ierr = nf90_def_var(irstfile, 'unorm' , nf90_double, (/ id_flowlinkdim, id_timedim /) , id_unorm)
ierr = nf90_put_att(irstfile, id_unorm,'standard_name', 'sea_water_speed')
ierr = nf90_put_att(irstfile, id_unorm,'long_name', 'Normal component of sea_water_speed')
ierr = nf90_put_att(irstfile, id_unorm,'units' , 'm s-1')
ierr = nf90_put_att(irstfile, id_unorm,'coordinates' , 'FlowLink_xu FlowLink_yu')
! Definition and attributes of flow data on edges: velocity magnitude at previous timestep
ierr = nf90_def_var(irstfile, 'u0' , nf90_double, (/ id_flowlinkdim, id_timedim /) , id_u0)
ierr = nf90_put_att(irstfile, id_u0 ,'standard_name', 'sea_water_speed')
ierr = nf90_put_att(irstfile, id_u0 ,'long_name', 'Normal component of sea_water_speed at previous time t0')
ierr = nf90_put_att(irstfile, id_u0 ,'units' , 'm s-1')
ierr = nf90_put_att(irstfile, id_u0 ,'coordinates' , 'FlowLink_xu FlowLink_yu')
! Definition and attributes of flow data on edges: velocity magnitude at previous timestep
ierr = nf90_def_var(irstfile, 'q1' , nf90_double, (/ id_flowlinkdim, id_timedim /) , id_q1)
ierr = nf90_put_att(irstfile, id_q1 ,'standard_name', 'discharge')
ierr = nf90_put_att(irstfile, id_q1 ,'long_name', 'Discharge through cell edge at current time')
ierr = nf90_put_att(irstfile, id_q1 ,'units' , 'm3 s-1')
ierr = nf90_put_att(irstfile, id_q1 ,'coordinates' , 'FlowLink_xu FlowLink_yu')
end if
! Definition and attributes of flow data on centres: salinity
if (jasal > 0) then
if (kmx > 0) then
ierr = nf90_def_var(irstfile, 'sa1', nf90_double, (/ id_laydim, id_flowelemdim , id_timedim /), id_sa1)
else
ierr = nf90_def_var(irstfile, 'sa1', nf90_double, (/ id_flowelemdim , id_timedim /), id_sa1)
endif
ierr = nf90_put_att(irstfile, id_sa1, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_sa1, 'standard_name', 'sea_water_salinity')
ierr = nf90_put_att(irstfile, id_sa1, 'long_name' , 'Salinity')
ierr = nf90_put_att(irstfile, id_sa1, 'units' , 'ppt')
endif
! Tracer fields
if(ITRA1 > 0) then
if(.not.allocated(id_tr1)) then
allocate(id_tr1(ITRAN-ITRA1+1))
endif
do i=ITRA1,ITRAN
j = i-ITRA1+1
if(kmx > 0) then
ierr = nf90_def_var(irstfile, const_names(i), nf90_double, (/ id_laydim, id_flowelemdim , id_timedim /), id_tr1(j))
else
ierr = nf90_def_var(irstfile, const_names(i), nf90_double, (/ id_flowelemdim , id_timedim /), id_tr1(j))
endif
ierr = nf90_put_att(irstfile, id_tr1(j), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_tr1(j), 'standard_name', const_names(i))
ierr = nf90_put_att(irstfile, id_tr1(j), 'long_name' , const_names(i))
ierr = nf90_put_att(irstfile, id_tr1(j), 'units' , 'ppt')
enddo
endif
if (jawave .eq. 4) then
ierr = nf90_def_var(irstfile, 'E', nf90_double, (/ id_flowelemdim, id_timedim /) , id_E)
ierr = nf90_put_att(irstfile, id_E, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_E, 'standard_name', 'sea_surface_bulk_wave_energy') ! not CF
ierr = nf90_put_att(irstfile, id_E, 'long_name' , 'wave energy per square meter')
ierr = nf90_put_att(irstfile, id_E, 'units' , 'J m-2')
ierr = nf90_def_var(irstfile, 'R', nf90_double, (/ id_flowelemdim, id_timedim /) , id_R)
ierr = nf90_put_att(irstfile, id_R, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_R, 'standard_name', 'sea_surface_bulk_roller_energy') ! not CF
ierr = nf90_put_att(irstfile, id_R, 'long_name' , 'roller energy per square meter')
ierr = nf90_put_att(irstfile, id_R, 'units' , 'J m-2')
ierr = nf90_def_var(irstfile, 'DR', nf90_double, (/ id_flowelemdim, id_timedim /) , id_DR)
ierr = nf90_put_att(irstfile, id_DR, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_DR, 'standard_name', 'sea_surface_bulk_roller_dissipation') ! not CF
ierr = nf90_put_att(irstfile, id_DR, 'long_name' , 'roller energy dissipation per square meter')
ierr = nf90_put_att(irstfile, id_DR, 'units' , 'W m-2')
ierr = nf90_def_var(irstfile, 'D', nf90_double, (/ id_flowelemdim, id_timedim /) , id_D)
ierr = nf90_put_att(irstfile, id_D, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_D, 'standard_name', 'sea_surface_wave_breaking_dissipation') ! not CF
ierr = nf90_put_att(irstfile, id_D, 'long_name' , 'wave breaking energy dissipation per square meter')
ierr = nf90_put_att(irstfile, id_D, 'units' , 'W m-2')
ierr = nf90_def_var(irstfile, 'H', nf90_double, (/ id_flowelemdim, id_timedim /) , id_H)
ierr = nf90_put_att(irstfile, id_H, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_H, 'standard_name', 'sea_surface_wave_significant_height')
ierr = nf90_put_att(irstfile, id_H, 'long_name' , 'significant wave height')
ierr = nf90_put_att(irstfile, id_H, 'units' , 'm')
ierr = nf90_def_var(irstfile, 'urms', nf90_double, (/ id_flowlinkdim, id_timedim /) , id_urms)
ierr = nf90_put_att(irstfile, id_urms,'standard_name', 'sea_surface_wave_orbital_velocity')
ierr = nf90_put_att(irstfile, id_urms,'units' , 'm s-1')
ierr = nf90_put_att(irstfile, id_urms,'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_def_var(irstfile, 'ust' , nf90_double, (/ id_flowlinkdim, id_timedim /) , id_ust)
ierr = nf90_put_att(irstfile, id_ust,'standard_name', 'sea_surface_Stokes_drift_east')
ierr = nf90_put_att(irstfile, id_ust,'units' , 'm s-1')
ierr = nf90_put_att(irstfile, id_ust,'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_def_var(irstfile, 'vst' , nf90_double, (/ id_flowlinkdim, id_timedim /) , id_vst)
ierr = nf90_put_att(irstfile, id_vst,'standard_name', 'sea_surface_Stokes_drift_north')
ierr = nf90_put_att(irstfile, id_vst,'units' , 'm s-1')
ierr = nf90_put_att(irstfile, id_vst,'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_def_var(irstfile, 'Fx' , nf90_double, (/ id_flowlinkdim, id_timedim /) , id_Fx)
ierr = nf90_put_att(irstfile, id_Fx,'standard_name', 'sea_surface_wave_force_east')
ierr = nf90_put_att(irstfile, id_Fx,'units' , 'm s-1')
ierr = nf90_put_att(irstfile, id_Fx,'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_def_var(irstfile, 'Fy' , nf90_double, (/ id_flowlinkdim, id_timedim /) , id_Fy)
ierr = nf90_put_att(irstfile, id_Fy,'standard_name', 'sea_surface_wave_force_north')
ierr = nf90_put_att(irstfile, id_Fy,'units' , 'm s-1')
ierr = nf90_put_att(irstfile, id_Fy,'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_def_var(irstfile, 'thetamean', nf90_double, (/ id_flowelemdim, id_timedim /) , id_thetamean)
ierr = nf90_put_att(irstfile, id_thetamean, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_thetamean, 'standard_name', 'sea_surface_wave_from_direction') ! not CF
ierr = nf90_put_att(irstfile, id_thetamean, 'long_name' , 'mean wave angle')
ierr = nf90_put_att(irstfile, id_thetamean, 'units' , 'rad')
ierr = nf90_def_var(irstfile, 'cwav', nf90_double, (/ id_flowelemdim, id_timedim /) , id_cwav)
ierr = nf90_put_att(irstfile, id_cwav, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_cwav, 'standard_name', 'sea_surface_wave_phase_velocity') ! not CF
ierr = nf90_put_att(irstfile, id_cwav, 'long_name' , 'mean wave angle')
ierr = nf90_put_att(irstfile, id_cwav, 'units' , 'm s-1')
ierr = nf90_def_var(irstfile, 'cgwav', nf90_double, (/ id_flowelemdim, id_timedim /) , id_cgwav)
ierr = nf90_put_att(irstfile, id_cgwav, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_cgwav, 'standard_name', 'sea_surface_wave_group_velocity') ! not CF
ierr = nf90_put_att(irstfile, id_cgwav, 'long_name' , 'mean wave angle')
ierr = nf90_put_att(irstfile, id_cgwav, 'units' , 'm s-1')
ierr = nf90_def_var(irstfile, 'sigmwav', nf90_double, (/ id_flowelemdim, id_timedim /) , id_sigmwav)
ierr = nf90_put_att(irstfile, id_sigmwav, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_sigmwav, 'standard_name', 'sea_surface_wave_mean_frequency') ! not CF
ierr = nf90_put_att(irstfile, id_sigmwav, 'long_name' , 'mean wave frequency')
ierr = nf90_put_att(irstfile, id_sigmwav, 'units' , 'rad s-1')
end if
! Definition and attributes of flow data on centres: sediment concentation and erodable layer thickness
if (jased > 0) then
! Sediment concentration
ierr = nf90_def_dim(irstfile, 'nFrac', mxgr, id_maxfracdim)
if (jaceneqtr == 1) then
ierr = nf90_inq_dimid(irstfile, 'nFlowElem', id_erolaydim) ! Note: points to an existing dimension (either nNetNode, or nFlowElem)
else
ierr = nf90_inq_dimid(irstfile, 'nNetNode' , id_erolaydim) ! Note: points to an existing dimension (either nNetNode, or nFlowElem)
end if
ierr = nf90_def_var(irstfile, 'sed' , nf90_double, (/ id_maxfracdim , id_flowelemdim, id_timedim /) , id_sed)
ierr = nf90_put_att(irstfile, id_sed , 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_sed , 'standard_name', 'sediment_concentration')
ierr = nf90_put_att(irstfile, id_sed , 'long_name' , 'Sediment concentration at cell centres')
ierr = nf90_put_att(irstfile, id_sed , 'units' , 'kg/m3')
! Erodable thickness
ierr = nf90_def_var(irstfile, 'ero' , nf90_double, (/ id_maxfracdim , id_erolaydim, id_timedim /) , id_ero)
if (jaceneqtr == 1) then
ierr = nf90_put_att(irstfile, id_ero, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(irstfile, id_ero, 'long_name', 'erodable layer thickness per size fraction in cell centres')
else
ierr = nf90_put_att(irstfile, id_ero, 'coordinates' , 'NetNode_x NetNode_y')
ierr = nf90_put_att(irstfile, id_ero, 'long_name', 'erodable layer thickness per size fraction at cell corners')
endif
ierr = nf90_put_att(irstfile, id_ero, 'standard_name' , 'Erodable layer thickness') ! Not CF
ierr = nf90_put_att(irstfile, id_ero, 'units' , 'm')
endif
! Thatcher-Harleman boundary data
if(allocated(threttim)) then
if(jasal > 0) then
if(max_threttim(ISALT) > 0d0) then
ierr = nf90_def_var(irstfile, 'tsalbnd', nf90_double, (/ id_bndsaldim, id_timedim /), id_tsalbnd)
ierr = nf90_put_att(irstfile, id_tsalbnd, 'long_name', 'TH time interval')
ierr = nf90_put_att(irstfile, id_tsalbnd, 'units', 's')
ierr = nf90_def_var(irstfile, 'zsalbnd', nf90_double, (/ id_bndsaldim, id_timedim /), id_zsalbnd)
ierr = nf90_put_att(irstfile, id_zsalbnd, 'long_name', 'TH salinity')
ierr = nf90_put_att(irstfile, id_zsalbnd, 'units', 'ppt')
endif
endif
if(jatem > 0) then
if(max_threttim(ITEMP) > 0d0) then
ierr = nf90_def_var(irstfile, 'ttembnd', nf90_double, (/ id_bndtemdim, id_timedim /), id_ttembnd)
ierr = nf90_put_att(irstfile, id_ttembnd, 'long_name', 'TH time interval')
ierr = nf90_put_att(irstfile, id_ttembnd, 'units', 's')
ierr = nf90_def_var(irstfile, 'ztembnd', nf90_double, (/ id_bndtemdim, id_timedim /), id_ztembnd)
ierr = nf90_put_att(irstfile, id_ztembnd, 'long_name', 'TH temperature')
ierr = nf90_put_att(irstfile, id_ztembnd, 'units', 'degrees celsius')
endif
endif
if(jased > 0) then
if(max_threttim(ISED1) > 0d0) then
ierr = nf90_def_var(irstfile, 'tsedbnd', nf90_double, (/ id_bndseddim, id_timedim /), id_tsedbnd)
ierr = nf90_put_att(irstfile, id_tsedbnd, 'long_name', 'TH time interval')
ierr = nf90_put_att(irstfile, id_tsedbnd, 'units', 's')
ierr = nf90_def_var(irstfile, 'zsedbnd', nf90_double, (/ id_bndseddim, id_timedim /), id_zsedbnd)
ierr = nf90_put_att(irstfile, id_zsedbnd, 'long_name', 'TH sediment')
ierr = nf90_put_att(irstfile, id_zsedbnd, 'units', 'ppt')
endif
endif
if(numtracers > 0) then
if(.not. allocated(id_ttrabnd)) then
allocate(id_ttrabnd(numtracers))
endif
if(.not. allocated(id_ztrabnd)) then
allocate(id_ztrabnd(numtracers))
endif
do i=1,numtracers
iconst = itrac2const(i)
if(max_threttim(iconst) > 0d0) then
write(numtrastr,numformat) i
ierr = nf90_def_var(irstfile, 'ttrabnd'//numtrastr, nf90_double, (/ id_bndtradim(i), id_timedim /), id_ttrabnd(i))
ierr = nf90_put_att(irstfile, id_ttrabnd(i), 'long_name', 'TH time interval '//numtrastr)
ierr = nf90_put_att(irstfile, id_ttrabnd(i), 'units', 's')
ierr = nf90_def_var(irstfile, 'ztrabnd'//numtrastr, nf90_double, (/ id_bndtradim(i), id_timedim /), id_ztrabnd(i))
ierr = nf90_put_att(irstfile, id_ztrabnd(i), 'long_name', 'TH tracer '//numtrastr)
ierr = nf90_put_att(irstfile, id_ztrabnd(i), 'units', 'ppt')
endif
enddo
endif
endif
! Gridmapping
ierr = unc_add_gridmapping_att(irstfile, (/ id_s1, id_taus, id_ucx, id_ucy, id_unorm, id_sa1, id_sed /), jsferic) ! add id_ucz?
ierr = nf90_enddef(irstfile)
! Inquire var-id's
! NOTE: alle inq_varids below are not needed, since they have just been def_var'd above in this subroutine. Cleanup later together with rst/map cleanup. [AvD]
if ( kmx>0 ) then
ierr = nf90_inq_dimid(irstfile, 'laydim', id_laydim)
ierr = nf90_inq_dimid(irstfile, 'wdim', id_wdim)
end if
ierr = nf90_inq_varid(irstfile, 'timestep', id_timestep)
ierr = nf90_inq_varid(irstfile, 's1', id_s1)
ierr = nf90_inq_varid(irstfile, 's0', id_s0)
ierr = nf90_inq_varid(irstfile, 'unorm' , id_unorm )
ierr = nf90_inq_varid(irstfile, 'u0' , id_u0 )
ierr = nf90_inq_varid(irstfile, 'q1' , id_q1 )
ierr = nf90_inq_varid(irstfile, 'ucx' , id_ucx )
ierr = nf90_inq_varid(irstfile, 'ucy' , id_ucy )
ierr = nf90_inq_varid(irstfile, 'taus' , id_taus)
ierr = nf90_inq_varid(irstfile, 'czs' , id_czs)
if ( kmx>0 ) then
ierr = nf90_inq_varid(irstfile, 'ucz', id_ucz)
ierr = nf90_inq_varid(irstfile, 'ww1', id_ww1)
end if
if (jasal > 0) then
ierr = nf90_inq_varid(irstfile, 'sa1', id_sa1)
endif
! JRE
if (jawave .eq. 4) then
ierr = nf90_inq_varid(irstfile, 'E' , id_E)
ierr = nf90_inq_varid(irstfile, 'R' , id_R)
ierr = nf90_inq_varid(irstfile, 'H' , id_H)
ierr = nf90_inq_varid(irstfile, 'D' , id_D)
ierr = nf90_inq_varid(irstfile, 'DR' , id_DR)
ierr = nf90_inq_varid(irstfile, 'urms' , id_urms)
ierr = nf90_inq_varid(irstfile, 'ust' , id_ust)
ierr = nf90_inq_varid(irstfile, 'vst' , id_vst)
ierr = nf90_inq_varid(irstfile, 'Fx' , id_Fx)
ierr = nf90_inq_varid(irstfile, 'Fy' , id_Fy)
ierr = nf90_inq_varid(irstfile, 'thetamean', id_thetamean)
ierr = nf90_inq_varid(irstfile, 'cwav' , id_cwav)
ierr = nf90_inq_varid(irstfile, 'cgwav' , id_cgwav)
ierr = nf90_inq_varid(irstfile, 'sigmwav' , id_sigmwav)
endif
!
if (jatem > 0) then
ierr = nf90_inq_varid(irstfile, 'tem1', id_tem1)
endif
if (jased > 0) then
ierr = nf90_inq_dimid(irstfile, 'nFrac', id_maxfracdim)
if (jaceneqtr == 1) then
ierr = nf90_inq_dimid(irstfile, 'nFlowElem', id_erolaydim) ! Note: points to an existing dimension (either nNetNode, or nFlowElem)
else
ierr = nf90_inq_dimid(irstfile, 'nNetNode', id_erolaydim) ! Note: points to an existing dimension (either nNetNode, or nFlowElem)
end if
ierr = nf90_inq_varid(irstfile, 'sed', id_sed)
ierr = nf90_inq_varid(irstfile, 'ero', id_ero)
endif
! -- Start data writing (flow data) ------------------------
itim = 1
! Write the data: time
ierr = nf90_put_var(irstfile, id_time , tim, (/ itim /))
ierr = nf90_put_var(irstfile, id_timestep, dts, (/ itim /))
! Write the data: water level (new and old)
ierr = nf90_put_var(irstfile, id_s1, s1, (/ 1, itim /), (/ ndxi, 1 /))
ierr = nf90_put_var(irstfile, id_s0, s0, (/ 1, itim /), (/ ndxi, 1 /))
! Write the data: tau current
if (jawave /= 3) then ! If jawave == 3, then taus is obtained from subroutine tauwave (taus = taucur + tauwave).
call gettaus(1)
elseif (jamapchezy > 0) then
call gettaus(2)
endif
if(jamaptaucurrent > 0) then
ierr = nf90_put_var(irstfile, id_taus, taus, (/ 1, itim /), (/ ndxi, 1 /))
endif
if(jamapchezy > 0) then
ierr = nf90_put_var(irstfile, id_czs, czs, (/ 1, itim /), (/ ndxi, 1 /))
endif
if (kmx > 0) then
! 3D
call reconstructucz(0)
call unc_append_3dflowgeom_put(irstfile, 1, itim)
!do kk=1,Ndxi
! call getkbotktop(kk,kb,kt)
! ierr = nf90_put_var(irstfile, id_ucx , ucx(kb:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+1, 1, 1 /))
! ierr = nf90_put_var(irstfile, id_ucy , ucy(kb:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+1, 1, 1 /))
! ierr = nf90_put_var(irstfile, id_ucz , ucz(kb:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+1, 1, 1 /))
! ierr = nf90_put_var(irstfile, id_ww1 , ww1(kb-1:kt),start=(/ 1, kk, itim /), count=(/ kt-kb+2, 1, 1 /))
!end do
!do LL=1,lnx
! call getLbotLtopmax(LL,Lb,Lt)
! ierr = nf90_put_var(irstfile, id_unorm, u1(Lb:Lt), start=(/ 1, LL, itim /), count=(/ Lt-Lb+1, 1, 1 /))
! ierr = nf90_put_var(irstfile, id_u0 , u0(Lb:Lt), start=(/ 1, LL, itim /), count=(/ Lt-Lb+1, 1, 1 /))
! ierr = nf90_put_var(irstfile, id_q1 , q1(Lb:Lt), start=(/ 1, LL, itim /), count=(/ Lt-Lb+1, 1, 1 /))
!end do
do kk=1,ndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
work1(k-kb+1,kk) = ucx(k)
enddo
enddo
ierr = nf90_put_var(irstfile, id_ucx, work1(1:kmx,1:ndxi), start=(/ 1, 1, itim /), count=(/ kmx, ndxi, 1 /))
do kk=1,ndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
work1(k-kb+1,kk) = ucy(k)
enddo
enddo
ierr = nf90_put_var(irstfile, id_ucy, work1(1:kmx,1:ndxi), start=(/ 1, 1, itim /), count=(/ kmx, ndxi, 1 /))
do kk=1,ndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
work1(k-kb+1,kk) = ucz(k)
enddo
enddo
ierr = nf90_put_var(irstfile, id_ucz, work1(1:kmx,1:ndxi), start=(/ 1, 1, itim /), count=(/ kmx, ndxi, 1 /))
do kk=1,ndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
work1(k-kb+1,kk) = ww1(k)
enddo
enddo
ierr = nf90_put_var(irstfile, id_ww1, work1(1:kmx,1:ndxi), start=(/ 1, 1, itim /), count=(/ kmx, ndxi, 1 /))
do LL=1,lnx
call getLbotLtopmax(LL,Lb,Lt)
do L = Lb,Lt
work1(L-Lb+1,LL) = u1(L)
enddo
enddo
ierr = nf90_put_var(irstfile, id_unorm, work1(1:kmx,1:lnx), start=(/ 1, 1, itim /), count=(/ kmx, lnx, 1 /))
do LL=1,lnx
call getLbotLtopmax(LL,Lb,Lt)
do L = Lb,Lt
work1(L-Lb+1,LL) = u0(L)
enddo
enddo
ierr = nf90_put_var(irstfile, id_u0 , work1(1:kmx,1:lnx), start=(/ 1, 1, itim /), count=(/ kmx, lnx, 1 /))
do LL=1,lnx
call getLbotLtopmax(LL,Lb,Lt)
do L = Lb,Lt
work1(L-Lb+1,LL) = q1(L)
enddo
enddo
ierr = nf90_put_var(irstfile, id_q1 , work1(1:kmx,1:lnx), start=(/ 1, 1, itim /), count=(/ kmx, lnx, 1 /))
else
ierr = nf90_put_var(irstfile, id_ucx , ucx, (/ 1, itim /), (/ ndxi, 1 /))
ierr = nf90_put_var(irstfile, id_ucy , ucy, (/ 1, itim /), (/ ndxi, 1 /))
ierr = nf90_put_var(irstfile, id_unorm, u1 , (/ 1, itim /), (/ lnx , 1 /))
ierr = nf90_put_var(irstfile, id_u0 , u0 , (/ 1, itim /), (/ lnx , 1 /))
ierr = nf90_put_var(irstfile, id_q1 , q1 , (/ 1, itim /), (/ lnx , 1 /))
end if
if (jasal > 0) then ! Write the data: salinity
if (kmx > 0) then
!do kk=1,Ndxi
! call getkbotktop(kk,kb,kt)
! ierr = nf90_put_var(irstfile, id_sa1, sa1(kb:kt), (/ 1, kk, itim /), (/ kt-kb+1, 1, 1 /))
!end do
do kk = 1,ndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
work1(k-kb+1,kk) = sa1(k)
enddo
end do
ierr = nf90_put_var(irstfile, id_sa1, work1(1:kmx,1:ndxi), (/ 1, 1, itim /), (/ kmx, ndxi, 1 /))
else
ierr = nf90_put_var(irstfile, id_sa1, sa1, (/ 1, itim /), (/ ndxi, 1 /))
end if
endif
if (jatem > 0) then ! Write the data: temperature
if ( kmx>0 ) then
!do kk=1,Ndxi
! call getkbotktop(kk,kb,kt)
! ierr = nf90_put_var(irstfile, id_tem1, tem1(kb:kt), (/ 1, kk, itim /), (/ kt-kb+1, 1, 1 /))
!end do
do kk = 1,ndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
work1(k-kb+1,kk) = tem1(k)
enddo
end do
ierr = nf90_put_var(irstfile, id_tem1, work1(1:kmx,1:ndxi), (/ 1, 1, itim /), (/ kmx, ndxi, 1 /))
else
ierr = nf90_put_var(irstfile, id_tem1, tem1, (/ 1, itim /), (/ ndxi, 1 /))
end if
endif
if (jamapconst > 0 .and. ITRA1 > 0) then
allocate(dum(ndxi))
do j=ITRA1,ITRAN
if (kmx > 0) then
! 3D
do kk=1,ndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
work1(k-kb+1,kk) = constituents(j,k)
enddo
enddo
ierr = nf90_put_var(irstfile, id_tr1(j-ITRA1+1), work1(1:kmx,1:ndxi), (/ 1, 1, itim /), (/ kmx, ndxi, 1 /))
! if ( ierr.ne.0 ) exit ! probably newly added tracer in the GUI
else
do kk=1,ndxi
dum(kk) = constituents(j,kk)
enddo
ierr = nf90_put_var(irstfile, id_tr1(j-ITRA1+1), dum, (/ 1, itim /), (/ ndxi, 1 /) )
endif
enddo
if (allocated(dum)) deallocate(dum)
end if
! JRE
if (jawave .eq. 4) then
ierr = nf90_put_var(irstfile, id_E, E, (/ 1, itim /), (/ ndxi, 1 /))
ierr = nf90_put_var(irstfile, id_R, R, (/ 1, itim /), (/ ndxi, 1 /))
ierr = nf90_put_var(irstfile, id_H, H, (/ 1, itim /), (/ ndxi, 1 /))
end if
! Write the data: sediment
if (jased > 0 .and. .not. stm_included) then ! Write the data: sediment
ierr = nf90_put_var(irstfile, id_sed, sed, (/ 1, 1, itim /), (/ mxgr, ndxi, 1 /))
ierr = nf90_put_var(irstfile, id_ero, grainlay, (/ 1, 1, itim /), (/ mxgr, size(grainlay,2) , 1 /))
! TODO: AvD: size(grainlay,2) is always correct (mxn), but we have a problem if jaceneqtr==2 and mxn/=numk,
! because then the dimension for ero is set to nNetNode, and coordinate attribute refers to NetNode_x
! (both length numk), whereas ero itself is shorter than numk.
endif
! Write the data: TH boundaries
if(allocated(threttim)) then
if(jasal > 0) then
if(max_threttim(ISALT) > 0d0) then
ierr = nf90_put_var(irstfile, id_tsalbnd, thtbnds, (/1, itim/), (/nbnds, 1/))
ierr = nf90_put_var(irstfile, id_zsalbnd, thzbnds, (/1, itim/), (/nbnds*kmxd, 1/))
endif
endif
if(jatem > 0) then
if(max_threttim(ITEMP) > 0d0) then
ierr = nf90_put_var(irstfile, id_ttembnd, thtbndtm, (/1, itim/), (/nbndtm, 1/))
ierr = nf90_put_var(irstfile, id_ztembnd, thzbndtm, (/1, itim/), (/nbndtm*kmxd, 1/))
endif
endif
if(jased > 0) then
if(max_threttim(ISED1) > 0d0) then
ierr = nf90_put_var(irstfile, id_tsedbnd, thtbndsd, (/1, itim/), (/nbndsd, 1/))
ierr = nf90_put_var(irstfile, id_zsedbnd, thzbndsd, (/1, itim/), (/nbndsd*kmxd, 1/))
endif
endif
if(numtracers > 0) then
do i=1,numtracers
iconst = itrac2const(i)
if(max_threttim(iconst) > 0d0) then
ierr = nf90_put_var(irstfile, id_ttrabnd(i), bndtr(i)%tht, (/1, itim/), (/nbndtr(i), 1/))
ierr = nf90_put_var(irstfile, id_ztrabnd(i), bndtr(i)%thz, (/1, itim/), (/nbndtr(i)*kmxd, 1/))
endif
enddo
endif
endif
end subroutine unc_write_rst_filepointer
!> Writes a single snapshot of the unstructured flow net + flow data to a netCDF file.
!! If file exists, it will be overwritten. Therefore, only use this routine
!! for separate snapshots, the automated map file should be filled by calling
!! unc_write_map_filepointer directly instead!
subroutine unc_write_map(filename, iconventions)
implicit none
character(len=*), intent(in) :: filename
integer, optional, intent(in) :: iconventions !< Unstructured NetCDF conventions (either UNC_CONV_CFOLD or UNC_CONV_UGRID)
type(t_unc_mapids) :: mapids
integer :: ierr, iconv
if (.not. present(iconventions)) then
iconv = UNC_CONV_CFOLD
else
iconv = iconventions
end if
ierr = unc_create(filename, 0, mapids%ncid)
if (ierr /= nf90_noerr) then
call mess(LEVEL_ERROR, 'Could not create map file '''//trim(filename)//'''.')
call check_error(ierr)
return
end if
if (iconv == UNC_CONV_UGRID) then
call unc_write_map_filepointer_ugrid(mapids, 0d0)
else
call unc_write_map_filepointer(mapids%ncid, 0d0, 1)
end if
ierr = unc_close(mapids%ncid)
end subroutine unc_write_map
!> Writes map/flow data to an already opened netCDF dataset. NEW version according to UGRID conventions + much cleanup.
!! The netnode and -links have been written already.
subroutine unc_write_map_filepointer_ugrid(mapids, tim, jabndnd) ! wrimap
use m_flow
use m_flowtimes
use m_flowgeom
use m_heatfluxes
use m_sferic
use network_data
use m_sediment
use m_wind
use m_flowparameters, only: jatrt
use m_xbeach_data
use m_transport, only: NUMCONST, ITRA1, ITRAN, constituents, const_names, id_const
implicit none
type(t_unc_mapids), intent(inout) :: mapids !< Set of file and variable ids for this map-type file.
real(kind=hp), intent(in) :: tim
integer, optional, intent(in) :: jabndnd !< Whether to include boundary nodes (1) or not (0). Default: no.
integer :: jabndnd_
integer :: idims(2)
logical, dimension(2), save :: firststep = .true.
integer, save :: ierr, ndim
double precision, allocatable :: ust_rot(:), vst_rot(:)
character(len=255) :: tmpstr
double precision, dimension(:), allocatable :: dum
integer, dimension(:), allocatable :: idum
! Secondary Flow
! id_rsi, id_rsiexact, id_dudx, id_dudy, id_dvdx, id_dvdy, id_dsdx, id_dsdy
integer :: iid, i, j, numContPts, numNodes, itim, k, kb, kt, kk, n, LL, Lt, Lb
integer :: ndxndxi ! Either ndx or ndxi, depending on whether boundary nodes also need to be written.
double precision, dimension(:), allocatable :: windx, windy
if (ndxi <= 0) then
call mess(LEVEL_WARN, 'No flow cells in model, will not write flow geometry.')
return
end if
if (present(jabndnd)) then
jabndnd_ = jabndnd
else
jabndnd_ = 0
endif
! Include boundary cells in output (ndx) or not (ndxi)
if (jabndnd_ == 1) then
ndxndxi = ndx
else
ndxndxi = ndxi
end if
! Use nr of dimensions in netCDF file a quick check whether vardefs were written
! before in previous calls.
ndim = 0
ierr = nf90_inquire(mapids%ncid, nDimensions=ndim)
! Only write net and flow geometry data the first time, or for a separate map file.
if (ndim == 0) then
ierr = ug_addglobalatts(mapids%ncid)
call unc_write_flowgeom_filepointer_ugrid(mapids, jabndnd_)
! TODO: AVD: 3D
! if ( kmx > 0 ) then
! call unc_append_3dflowgeom_def(imapfile) ! Append definition of time-independent 3d flow geometry data
! ierr = nf90_inq_dimid(imapfile, 'laydim', id_laydim(iid))
! ierr = nf90_inq_dimid(imapfile, 'wdim', id_wdim(iid))
! end if
! Current time t1
ierr = nf90_def_dim(mapids%ncid, 'time', nf90_unlimited, mapids%id_timedim)
call check_error(ierr, 'def time dim')
tmpstr = 'seconds since '//refdat(1:4)//'-'//refdat(5:6)//'-'//refdat(7:8)//' 00:00:00'
ierr = unc_def_var_nonspatial(mapids%ncid, mapids%id_time, nf90_double, (/ mapids%id_timedim /), 'time', 'time', '', trim(tmpstr))
! Size of latest timestep
ierr = unc_def_var_nonspatial(mapids%ncid, mapids%id_timestep, nf90_double, (/ mapids%id_timedim /), 'timestep', '', 'Latest computational timestep size', 's')
if (jamapnumlimdt > 0) then
ierr = unc_def_var_map(mapids , mapids%id_numlimdt , nf90_int, UNC_LOC_S, 'Numlimdt' , '', 'Nr of times cell was Courant limiting', '')
endif
! Water levels
if (jamaps1 > 0) then
ierr = unc_def_var_map(mapids, mapids%id_s1, nf90_double, UNC_LOC_S, 's1', 'sea_surface_height', 'water level', 'm')
ierr = unc_def_var_map(mapids, mapids%id_hs, nf90_double, UNC_LOC_S, 'waterdepth', 'sea_floor_depth_below_sea_surface', 'water depth at pressure points', 'm')
end if
if (jamaps0 > 0) then
ierr = unc_def_var_map(mapids, mapids%id_s0, nf90_double, UNC_LOC_S, 's0', 'sea_surface_height', 'water level on previous timestep', 'm')
end if
! Velocities
if (kmx == 0) then
if(jamapu1 > 0) then
ierr = unc_def_var_map(mapids, mapids%id_u1, nf90_double, UNC_LOC_U, 'u1', '', 'normal velocity at velocity point', 'm s-1')
endif
if(jamapu0 > 0) then
ierr = unc_def_var_map(mapids, mapids%id_u0, nf90_double, UNC_LOC_U, 'u0', '', 'normal velocity at velocity point at previous timestep', 'm s-1')
endif
if(jamapucvec > 0) then
ierr = unc_def_var_map(mapids, mapids%id_ucx, nf90_double, UNC_LOC_S, 'ucx', 'eastward_sea_water_velocity', 'eastward velocity on pressure point', 'm s-1')
ierr = unc_def_var_map(mapids, mapids%id_ucy, nf90_double, UNC_LOC_S, 'ucy', 'northward_sea_water_velocity', 'northward velocity on pressure point', 'm s-1')
endif
if(jamapq1 > 0) then
ierr = unc_def_var_map(mapids, mapids%id_q1, nf90_double, UNC_LOC_U, 'q1', 'discharge', 'Discharge through cell edge at current time', 'm3 s-1')
endif
endif
! Bed shear stress
if (jamaptaucurrent > 0) then
ierr = unc_def_var_map(mapids , mapids%id_taus , nf90_double, UNC_LOC_S, 'taus' , '', 'Total bed shear stress', 'N/m2')
endif
! Chezy data on flow-nodes
if (jamapchezy > 0) then
ierr = unc_def_var_map(mapids , mapids%id_czs , nf90_double, UNC_LOC_S, 'czs' , '', 'Chezy roughness', 'm0.5s-1')
! WO: m0.5s-1 does not follow standard ? (which accepts only integral powers?)
endif
! Constituents
if (jamapsal > 0 .and. jasal > 0) then
if ( kmx > 0 ) then ! 3D ! TODO: AvD: 3D def var
! ierr = nf90_def_var(imapfile, 'sa1' , nf90_double, (/ id_laydim(iid), id_flowelemdim (iid), id_timedim (iid)/) , id_sa1(iid))
else
ierr = unc_def_var_map(mapids, mapids%id_sa1, nf90_double, UNC_LOC_S, 'sa1', 'sea_water_salinity', 'Salinity in flow cell', 'ppt')
end if
end if
if (jamaptem > 0 .and. jatem > 0) then
if ( kmx > 0 ) then ! 3D ! TODO: AvD: 3D def var
! ierr = nf90_def_var(imapfile, 'tem1' , nf90_double, (/ id_laydim(iid), id_flowelemdim(iid) , id_timedim(iid) /) , id_tem1(iid))
else
ierr = unc_def_var_map(mapids, mapids%id_tem1, nf90_double, UNC_LOC_S, 'tem1', 'water_temperature', 'Temperature in flow cell', 'degC')
end if
endif
! Tracers
if (jamapconst > 0 .and. ITRA1 > 0) then
do j=ITRA1,ITRAN
if ( kmx > 0 ) then ! 3D ! TODO: AvD: 3D def var
! ierr = nf90_def_var(imapfile, trim(const_names(j)), nf90_double, (/ id_laydim(iid), id_flowelemdim (iid), id_timedim (iid)/) , id_const(iid,j))
else
ierr = unc_def_var_map(mapids, mapids%id_const(:,j), nf90_double, UNC_LOC_S, trim(const_names(j)), '', trim(const_names(j)) // ' in flow cell', '')
end if
end do
endif
! Discharges
! TODO: AVD...
! TIDAL TURBINES: Insert equivalent of addturbine_cnst and addturbine_time here
! Heat fluxes
if (jamapheatflux > 0 .and. jatem > 1) then ! here less verbose
if (jamapwind > 0) then
ierr = unc_def_var_map(mapids, mapids%id_wind , nf90_double, UNC_LOC_S, 'windspeed', 'wind_speed' , 'Wind velocity magnitude' , 'm s-1')
endif
if (japatm > 0) then ! TODO: AvD: make indep of jamapheat!
ierr = unc_def_var_map(mapids, mapids%id_patm , nf90_double, UNC_LOC_S, 'Patm' , 'surface_air_pressure' , 'Atmospheric pressure near surface', 'Pa')
endif
ierr = unc_def_var_map(mapids , mapids%id_tair , nf90_double, UNC_LOC_S, 'Tair' , 'surface_temperature' , 'Air temperature near surface' , 'degC')
ierr = unc_def_var_map(mapids , mapids%id_tair , nf90_double, UNC_LOC_S, 'Rhum' , 'surface_specific_humidity', 'Reality humidity near surface' , '')
ierr = unc_def_var_map(mapids , mapids%id_tair , nf90_double, UNC_LOC_S, 'Clou' , 'cloud_area_fraction' , 'Cloudiness' , '1')
if (jatem == 5) then
ierr = unc_def_var_map(mapids, mapids%id_qsun , nf90_double, UNC_LOC_S, 'Qsun' , 'surface_net_downward_shortwave_flux' , 'Solar influx' , 'W/m2')
ierr = unc_def_var_map(mapids, mapids%id_Qeva , nf90_double, UNC_LOC_S, 'Qeva' , 'surface_downward_latent_heat_flux' , 'Evaporative heat flux' , 'W/m2')
ierr = unc_def_var_map(mapids, mapids%id_Qcon , nf90_double, UNC_LOC_S, 'Qcon' , 'surface_downward_sensible_heat_flux' , 'Sensible heat flux' , 'W/m2')
ierr = unc_def_var_map(mapids, mapids%id_Qlong , nf90_double, UNC_LOC_S, 'Qlong' , 'surface_net_downward_longwave_flux' , 'Long wave back radiation' , 'W/m2')
ierr = unc_def_var_map(mapids, mapids%id_Qfreva, nf90_double, UNC_LOC_S, 'Qfreva', 'downward_latent_heat_flux_in_sea_water_due_to_convection', 'Free convection evaporative heat flux', 'W/m2')
ierr = unc_def_var_map(mapids, mapids%id_Qfrcon, nf90_double, UNC_LOC_S, 'Qfrcon', 'surface_downward_sensible_heat_flux_due_to_convection' , 'Free convection sensible heat flux' , 'W/m2')
endif
ierr = unc_def_var_map(mapids , mapids%id_Qtot , nf90_double, UNC_LOC_S, 'Qtot' , 'surface_downward_heat_flux_in_sea_water' , 'Total heat flux' , 'W/m2')
endif
! Sediment transport (via morphology module)
if (jamapsed > 0 .and. stm_included) then
ierr = nf90_def_dim(mapids%ncid, 'nSedTot', stmpar%lsedtot, mapids%id_sedtotdim)
ierr = nf90_def_dim(mapids%ncid, 'nSedSus', stmpar%lsedsus, mapids%id_sedsusdim)
if (stmpar%morpar%moroutput%sbcuv) then
ierr = unc_def_var_map(mapids , mapids%id_sbcx , nf90_double, UNC_LOC_S, 'sbcx' , '', 'bed load transport due to currents, x-component' , 'kg m-1 s-1', dimids = (/ -2, mapids%id_sedtotdim, -1 /))
ierr = unc_def_var_map(mapids , mapids%id_sbcy , nf90_double, UNC_LOC_S, 'sbcy' , '', 'bed load transport due to currents, y-component' , 'kg m-1 s-1', dimids = (/ -2, mapids%id_sedtotdim, -1 /))
endif
if (stmpar%morpar%moroutput%sbwuv) then
ierr = unc_def_var_map(mapids , mapids%id_sbwx , nf90_double, UNC_LOC_S, 'sbwx' , '', 'bed load transport due to waves, x-component' , 'kg m-1 s-1', dimids = (/ -2, mapids%id_sedtotdim, -1 /))
ierr = unc_def_var_map(mapids , mapids%id_sbwy , nf90_double, UNC_LOC_S, 'sbwy' , '', 'bed load transport due to waves, y-component' , 'kg m-1 s-1', dimids = (/ -2, mapids%id_sedtotdim, -1 /))
endif
if (stmpar%morpar%moroutput%sswuv) then
ierr = unc_def_var_map(mapids , mapids%id_sswx , nf90_double, UNC_LOC_S, 'sswx' , '', 'suspended load transport due to waves, x-component', 'kg m-1 s-1', dimids = (/ -2, mapids%id_sedtotdim, -1 /))
ierr = unc_def_var_map(mapids , mapids%id_sswy , nf90_double, UNC_LOC_S, 'sswy' , '', 'suspended load transport due to waves, y-component', 'kg m-1 s-1', dimids = (/ -2, mapids%id_sedtotdim, -1 /))
endif
if (stmpar%morpar%moroutput%sourcesink) then
ierr = unc_def_var_map(mapids , mapids%id_sourse , nf90_double, UNC_LOC_S, 'sourse' , '', 'source term suspended sediment fractions' , 'kg m-3 s-1', dimids = (/ -2, mapids%id_sedsusdim, -1 /))
ierr = unc_def_var_map(mapids , mapids%id_sinkse , nf90_double, UNC_LOC_S, 'sinkse' , '', 'sink term suspended sediment fractions' , 'kg m-3 s-1', dimids = (/ -2, mapids%id_sedsusdim, -1 /))
endif
endif
! Sediment transport (via own built-in sed)
if (jamapsed > 0 .and. jased > 0) then
ierr = nf90_def_dim(mapids%ncid, 'nFrac', mxgr, mapids%id_maxfracdim)
ierr = unc_def_var_map(mapids, mapids%id_sed , nf90_double, UNC_LOC_S, 'sed', 'sediment_concentration', 'sediment concentration' , 'kg m-3', dimids = (/ mapids%id_maxfracdim, -2, -1 /))
if (jaceneqtr == 1) then ! Bed level in cell center
ierr = unc_def_var_map(mapids, mapids%id_ero, nf90_double, UNC_LOC_S, 'ero', '' , 'erodable layer thickness per size fraction in cell centres' , 'm' , dimids = (/ mapids%id_maxfracdim, -2, -1 /))
ierr = unc_def_var_map(mapids, mapids%id_bl, nf90_double, UNC_LOC_S, 'Cellcenter_bedlevel_BL', '' , 'Cell bedlevel BL at cell centers' , 'm')
else ! Bed level at cell corner
ierr = unc_def_var_map(mapids, mapids%id_ero, nf90_double, UNC_LOC_CN,'ero', '' , 'erodable layer thickness per size fraction at cell corners' , 'm' , dimids = (/ mapids%id_maxfracdim, -2, -1 /))
ierr = unc_def_var_map(mapids, mapids%id_zk , nf90_double, UNC_LOC_CN,'Netnode_bedlevel_Zk', '' , 'Netnode bedlevel Zk at cell corners' , 'm')
end if
end if
! JRE waves
if (jawave .eq. 4) then
ierr = unc_def_var_map(mapids, mapids%id_E , nf90_double, UNC_LOC_S, 'E' , 'sea_surface_bulk_wave_energy' , 'wave energy per square meter' , 'J m-2') ! not CF
ierr = unc_def_var_map(mapids, mapids%id_R , nf90_double, UNC_LOC_S, 'R' , 'sea_surface_bulk_roller_energy' , 'roller energy per square meter' , 'J m-2') ! not CF
ierr = unc_def_var_map(mapids, mapids%id_DR , nf90_double, UNC_LOC_S, 'DR' , 'sea_surface_bulk_roller_dissipation' , 'roller energy dissipation per square meter' , 'W m-2') ! not CF
ierr = unc_def_var_map(mapids, mapids%id_D , nf90_double, UNC_LOC_S, 'D' , 'sea_surface_wave_breaking_dissipation', 'wave breaking energy dissipation per square meter', 'W m-2') ! not CF
ierr = unc_def_var_map(mapids, mapids%id_H , nf90_double, UNC_LOC_S, 'H' , 'sea_surface_wave_significant_height' , 'significant wave height' , 'm') ! not CF
ierr = unc_def_var_map(mapids, mapids%id_urms , nf90_double, UNC_LOC_U, 'urms' , 'sea_surface_wave_orbital_velocity' , '' , 'm s-1') ! not CF
ierr = unc_def_var_map(mapids, mapids%id_ust , nf90_double, UNC_LOC_U, 'ust' , 'sea_surface_Stokes_drift_east' , '' , 'm s-1') ! not CF
ierr = unc_def_var_map(mapids, mapids%id_vst , nf90_double, UNC_LOC_U, 'vst' , 'sea_surface_Stokes_drift_north' , '' , 'm s-1') ! not CF
ierr = unc_def_var_map(mapids, mapids%id_Fx , nf90_double, UNC_LOC_U, 'Fx' , 'sea_surface_wave_force_east' , '' , 'N m-2') ! not CF
ierr = unc_def_var_map(mapids, mapids%id_Fy , nf90_double, UNC_LOC_U, 'Fy' , 'sea_surface_wave_force_north' , '' , 'N m-2') ! not CF
ierr = unc_def_var_map(mapids, mapids%id_thetamean, nf90_double, UNC_LOC_S, 'thetamean', 'sea_surface_wave_significant_height' , 'sea_surface_wave_from_direction' , 'deg') ! not CF
ierr = unc_def_var_map(mapids, mapids%id_cwav , nf90_double, UNC_LOC_S, 'cwav' , 'sea_surface_wave_significant_height' , 'sea_surface_wave_phase_celerity' , 'm s-1') ! not CF
ierr = unc_def_var_map(mapids, mapids%id_cgwav , nf90_double, UNC_LOC_S, 'cgwav' , 'sea_surface_wave_significant_height' , 'sea_surface_wave_group_celerity' , 'm s-1') ! not CF
ierr = unc_def_var_map(mapids, mapids%id_sigmwav , nf90_double, UNC_LOC_S, 'sigmwav' , 'sea_surface_wave_significant_height' , 'sea_surface_wave_mean_frequency' , 'rad s-1') ! not CF
end if
! TODO: AvD: trachy output on net links
!if (jamaptrachy > 0 .and. jatrt == 1) then
! ! Roughness data on net-links
! ierr = nf90_def_var(imapfile, 'cftrt' , nf90_double, (/ id_netlinkdim(iid), id_timedim(iid) /) , id_cftrt(iid))
! if (ifrctypuni == 0) then
! ierr = nf90_put_att(imapfile, id_cftrt(iid),'long_name' , 'Chezy roughness from trachytopes')
! ierr = nf90_put_att(imapfile, id_cftrt(iid),'units' , 'm0.5s-1') ! WO: does not follow standard ? (which accepts only integral powers?)
! else if (ifrctypuni == 1) then
! ierr = nf90_put_att(imapfile, id_cftrt(iid),'long_name' , 'Manning roughness from trachytopes')
! ierr = nf90_put_att(imapfile, id_cftrt(iid),'units' , 'sm-0.333') ! WO: does not follow standard ? (which accepts only integral powers?)
! else if ((ifrctypuni == 2) .or. (ifrctypuni == 3)) then
! ierr = nf90_put_att(imapfile, id_cftrt(iid),'long_name' , 'White-Colebrook roughness from trachytopes')
! ierr = nf90_put_att(imapfile, id_cftrt(iid),'units' , 'm')
! else
! ierr = nf90_put_att(imapfile, id_cftrt(iid),'long_name' , 'Roughness from trachytopes')
! ierr = nf90_put_att(imapfile, id_cftrt(iid),'units' , ' ')
! end if
!end if
! Secondary Flow ! TODO: AvD: add secondary flow
!if (jasecflow == 1) then
! ierr = nf90_def_var(imapfile, 'rsi' , nf90_double, (/ id_flowelemdim, id_timedim /) , id_rsi)
! ierr = nf90_put_att(imapfile, id_rsi, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
! ierr = nf90_put_att(imapfile, id_rsi, 'standard_name', '')
! ierr = nf90_put_att(imapfile, id_rsi, 'long_name' , 'inverse streamline curvature in cell center')
! ierr = nf90_put_att(imapfile, id_rsi, 'units' , '1/m')
! ierr = nf90_def_var(imapfile, 'rsiexact' , nf90_double, (/ id_flowelemdim, id_timedim /) , id_rsiexact)
! ierr = nf90_put_att(imapfile, id_rsiexact, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
! ierr = nf90_put_att(imapfile, id_rsiexact, 'standard_name', '')
! ierr = nf90_put_att(imapfile, id_rsiexact, 'long_name' , 'inverse streamline curvature in cell center')
! ierr = nf90_put_att(imapfile, id_rsiexact, 'units' , '1/m')
! ierr = nf90_def_var(imapfile, 'dsdx' , nf90_double, (/ id_flowelemdim, id_timedim /) , id_dsdx)
! ierr = nf90_put_att(imapfile, id_dsdx, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
! ierr = nf90_put_att(imapfile, id_dsdx, 'standard_name', '')
! ierr = nf90_put_att(imapfile, id_dsdx, 'long_name' , 'water level gradient in x direction')
! ierr = nf90_put_att(imapfile, id_dsdx, 'units' , '1/s')
! ierr = nf90_def_var(imapfile, 'dsdy' , nf90_double, (/ id_flowelemdim, id_timedim /) , id_dsdy)
! ierr = nf90_put_att(imapfile, id_dsdy, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
! ierr = nf90_put_att(imapfile, id_dsdy, 'standard_name', '')
! ierr = nf90_put_att(imapfile, id_dsdy, 'long_name' , 'water level gradient in y direction')
! ierr = nf90_put_att(imapfile, id_dsdy, 'units' , '1/s')
! ierr = nf90_def_var(imapfile, 'dudx' , nf90_double, (/ id_flowelemdim, id_timedim /) , id_dudx)
! ierr = nf90_put_att(imapfile, id_dudx, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
! ierr = nf90_put_att(imapfile, id_dudx, 'standard_name', '')
! ierr = nf90_put_att(imapfile, id_dudx, 'long_name' , 'x-velocity gradient in x direction')
! ierr = nf90_put_att(imapfile, id_dudx, 'units' , '1/s')
! ierr = nf90_def_var(imapfile, 'dudy' , nf90_double, (/ id_flowelemdim, id_timedim /) , id_dudy)
! ierr = nf90_put_att(imapfile, id_dudy, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
! ierr = nf90_put_att(imapfile, id_dudy, 'standard_name', '')
! ierr = nf90_put_att(imapfile, id_dudy, 'long_name' , 'x-velocity gradient in y direction')
! ierr = nf90_put_att(imapfile, id_dudy, 'units' , '1/s')
! ierr = nf90_def_var(imapfile, 'dvdx' , nf90_double, (/ id_flowelemdim, id_timedim /) , id_dvdx)
! ierr = nf90_put_att(imapfile, id_dvdx, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
! ierr = nf90_put_att(imapfile, id_dvdx, 'standard_name', '')
! ierr = nf90_put_att(imapfile, id_dvdx, 'long_name' , 'y-velocity gradient in x direction')
! ierr = nf90_put_att(imapfile, id_dvdx, 'units' , '1/s')
! ierr = nf90_def_var(imapfile, 'dvdy' , nf90_double, (/ id_flowelemdim, id_timedim /) , id_dvdy)
! ierr = nf90_put_att(imapfile, id_dvdy, 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
! ierr = nf90_put_att(imapfile, id_dvdy, 'standard_name', '')
! ierr = nf90_put_att(imapfile, id_dvdy, 'long_name' , 'y-velocity gradient in y direction')
! ierr = nf90_put_att(imapfile, id_dvdy, 'units' , '1/s')
!end if
ierr = nf90_enddef(mapids%ncid)
endif
! End of writing time-independent flow geometry data.
! -- Start data writing (flow data) ------------------------
mapids%idx_curtime = mapids%idx_curtime+1 ! Increment time dimension index
itim = mapids%idx_curtime
! Time
ierr = nf90_put_var(mapids%ncid, mapids%id_time , tim, (/ itim /))
ierr = nf90_put_var(mapids%ncid, mapids%id_timestep, dts, (/ itim /))
! ierr = unc_put_var_map(mapids, mapids%id_numlimdt, UNC_LOC_S, numlimdt) ! TODO: AvD: integer version of this routine
! Water level
if (jamaps1 == 1) then
ierr = nf90_inq_varid(mapids%ncid, 'mesh2d'//'_s1', mapids%id_s1(2))
ierr = unc_put_var_map(mapids, mapids%id_s1, UNC_LOC_S, s1)
ierr = nf90_inq_varid(mapids%ncid, 'mesh2d'//'_waterdepth', mapids%id_hs(2))
ierr = unc_put_var_map(mapids, mapids%id_hs, UNC_LOC_S, hs)
end if
if (jamaps0 == 1) then
ierr = unc_put_var_map(mapids, mapids%id_s0, UNC_LOC_S, s0)
end if
! Velocities
if ( kmx>0 ) then
! 3D ! TODO: AVD
!call reconstructucz(0)
!call unc_append_3dflowgeom_put(imapfile, jaseparate_, itim)
!do kk=1,ndxndxi
! call getkbotktop(kk,kb,kt)
! ierr = nf90_put_var(imapfile, id_ucx(iid) , ucx (kb:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+1, 1, 1 /))
! ierr = nf90_put_var(imapfile, id_ucy(iid) , ucy (kb:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+1, 1, 1 /))
! ierr = nf90_put_var(imapfile, id_ucz(iid) , ucz (kb:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+1, 1, 1 /))
! ierr = nf90_put_var(imapfile, id_ww1(iid) , ww1 (kb-1:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+2, 1, 1 /))
! ! ierr = nf90_put_var(imapfile, id_turk(iid) , turkin1(kb-1:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+2, 1, 1 /))
! ! ierr = nf90_put_var(imapfile, id_teps(iid) , tureps1(kb-1:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+2, 1, 1 /))
! ! ierr = nf90_put_var(imapfile, id_vicwws(iid), vicwws1(kb-1:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+2, 1, 1 /))
!end do
!do LL=1,lnx
! call getLbotLtopmax(LL,Lb,Lt)
! ierr = nf90_put_var(imapfile, id_unorm(iid) , u1(Lb:Lt), start=(/ 1, LL, itim /), count=(/ Lt-Lb+1, 1, 1 /))
! ierr = nf90_put_var(imapfile, id_u0(iid) , u0(Lb:Lt), start=(/ 1, LL, itim /), count=(/ Lt-Lb+1, 1, 1 /))
!end do
end if
! if ( kmx == 0 ) then ! TODO: AvD: check whether this remains indeed unnecessary now (needs to be handled by unc_put_var_map?)
if (jamapu1 == 1) then
ierr = unc_put_var_map(mapids, mapids%id_u1, UNC_LOC_U, u1, 0d0)
end if
if (jamapu0 == 1) then
ierr = unc_put_var_map(mapids, mapids%id_u0, UNC_LOC_U, u0, 0d0)
end if
! end if ! kmx
if (jamapucvec == 1) then
! if ( kmx == 0 ) then ! TODO: AvD: here indeed we *only* want to ucx to be written for 1d/2d only, just as s1 (as opposed to sa1 for example)
ierr = unc_put_var_map(mapids, mapids%id_ucx, UNC_LOC_S, ucx)
ierr = unc_put_var_map(mapids, mapids%id_ucy, UNC_LOC_S, ucy)
! end if
end if
if (jamapq1 == 1) then
ierr = unc_put_var_map(mapids, mapids%id_q1, UNC_LOC_U, q1, 0d0)
end if
! TIDAL TURBINES: Insert equivalent of wrturbine_cnst and wrturbine_time here
! Tau current and Chezy
if (jamaptaucurrent > 0 .or. jamapchezy > 0) then
if (jawave .ne. 3) then ! Else, get taus from subroutine tauwave (taus = taucur + tauwave). Bas; Mind for jawind!
call gettaus(1) ! Update taus and czs
else if (jamapchezy > 0) then
call gettaus(2) ! Only update czs
end if
end if
if (jamaptaucurrent > 0) then
ierr = unc_put_var_map(mapids, mapids%id_taus, UNC_LOC_S, taus)
end if
if (jamapchezy > 0) then
ierr = unc_put_var_map(mapids, mapids%id_czs , UNC_LOC_S, czs)
end if
! Salinity
if (jasal > 0 .and. jamapsal > 0) then
if ( kmx>0 ) then
! 3D ! TODO : AvD: TODO
!do kk=1,ndxndxi
! call getkbotktop(kk,kb,kt)
! ierr = nf90_put_var(imapfile, id_sa1(iid), sa1(kb:kt), (/ 1, kk, itim /), (/ kt-kb+1, 1, 1 /))
!end do
else
ierr = unc_put_var_map(mapids, mapids%id_sa1, UNC_LOC_S, sa1)
end if
end if
! Temperature
if (jatem > 0 .and. jamaptem > 0) then
if ( kmx>0 ) then ! 3D ! TODO: AvD
!do kk=1,ndxndxi
! call getkbotktop(kk,kb,kt)
! ierr = nf90_put_var(imapfile, id_tem1(iid), tem1(kb:kt), (/ 1, kk, itim /), (/ kt-kb+1, 1, 1 /))
!end do
else
ierr = unc_put_var_map(mapids, mapids%id_tem1, UNC_LOC_S, tem1)
end if
endif
! Constituents
if (jamapconst > 0 .and. ITRA1 > 0) then
allocate(dum(NdxNdxi))
do j=ITRA1,ITRAN
if ( kmx>0 ) then
!! 3D ! TODO: AvD: TODO
! do kk=1,ndxndxi
! call getkbotktop(kk,kb,kt)
! do k = kb,kt
! work1(k-kb+1,kk) = constituents(j,k)
! enddo
! end do
! ierr = nf90_put_var(imapfile, id_const(iid,j), work1(1:kmx,1:ndxndxi), (/ 1, 1, itim /), (/ kmx, ndxndxi, 1 /))
! ! if ( ierr.ne.0 ) exit ! probably newly added tracer in the GUI
else
do kk=1,NdxNdxi
dum(kk) = constituents(j,kk)
end do
ierr = unc_put_var_map(mapids, mapids%id_const(:,j), UNC_LOC_S, dum)
end if
end do
if ( allocated(dum) ) deallocate(dum)
end if
!
! Sediment transport (via morphology module)
if (stm_included) then
! TODO: AvD: support kmax in put routine
!if (stmpar%morpar%moroutput%sbcuv) then
! ierr = unc_put_var_map(mapids, mapids%id_sbcx , UNC_LOC_S, sedtra%sbcx) ! , (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedtot, 1 /))
! ierr = unc_put_var_map(mapids, mapids%id_sbcy , UNC_LOC_S, sedtra%sbcy) ! , (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedtot, 1 /))
!end if
!
!if (stmpar%morpar%moroutput%sbwuv) then
! ierr = unc_put_var_map(mapids, mapids%id_sbwx , UNC_LOC_S, sedtra%sbwx) ! , (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedtot, 1 /))
! ierr = unc_put_var_map(mapids, mapids%id_sbwy , UNC_LOC_S, sedtra%sbwy) ! , (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedtot, 1 /))
!end if
!
!if (stmpar%morpar%moroutput%sswuv) then
! ierr = unc_put_var_map(mapids, mapids%id_sswx , UNC_LOC_S, sedtra%sswx) ! , (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedtot, 1 /))
! ierr = unc_put_var_map(mapids, mapids%id_sswy , UNC_LOC_S, sedtra%sswy) ! , (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedtot, 1 /))
!end if
!
!if (stmpar%morpar%moroutput%sourcesink) then
! ierr = unc_put_var_map(mapids, mapids%id_sourse, UNC_LOC_S, sedtra%sourse) ! , (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedsus, 1 /))
! ierr = unc_put_var_map(mapids, mapids%id_sinkse, UNC_LOC_S, sedtra%sinkse) ! , (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedsus, 1 /))
!end if
!
end if ! stm
! Sediment transport (via own built-in sed)
if (jased > 0 .and. .not.stm_included) then
! TODO: AvD: support kmax in put routine
!ierr = unc_put_var_map(mapids, mapids%id_sed, UNC_LOC_S, sed) ! , (/ 1, 1, itim /), (/ mxgr, ndxndxi, 1 /))
!if (jaceneqtr .eq. 1) then
! ierr = unc_put_var_map(mapids, mapids%id_ero, UNC_LOC_S, grainlay) ! , (/ 1, 1, itim /), (/ mxgr, size(grainlay,2) , 1 /))
! ierr = unc_put_var_map(mapids, mapids%id_bl , UNC_LOC_S, bl)
!else
! ierr = unc_put_var_map(mapids, mapids%id_ero, UNC_LOC_CN, grainlay) ! , (/ 1, 1, itim /), (/ mxgr, size(grainlay,2) , 1 /))
! ierr = unc_put_var_map(mapids, mapids%id_bl , UNC_LOC_CN, zk)
!end if
! TODO: AvD: size(grainlay,2) is always correct (mxn), but we have a problem if jaceneqtr==2 and mxn/=numk,
! because then the dimension for ero is set to nNetNode, and coordinate attribute refers to NetNode_x
! (both length numk), whereas ero itself is shorter than numk.
end if
! Heat flux models
if (jamapheatflux > 0 .and. jatem > 1) then ! here less verbose
!if (jamapwind > 0) then
! ierr = unc_def_var_map(mapids, mapids%id_wind , nf90_double, UNC_LOC_S, 'windspeed', 'wind_speed' , 'Wind velocity magnitude' , 'm s-1')
!endif
if (japatm > 0) then
ierr = unc_put_var_map(mapids, mapids%id_patm , UNC_LOC_S, patm)
endif
ierr = unc_put_var_map(mapids , mapids%id_tair , UNC_LOC_S, Tair)
ierr = unc_put_var_map(mapids , mapids%id_rhum , UNC_LOC_S, Rhum)
ierr = unc_put_var_map(mapids , mapids%id_clou , UNC_LOC_S, Clou)
if (jatem == 5) then
ierr = unc_put_var_map(mapids, mapids%id_qsun , UNC_LOC_S, Qsunmap)
ierr = unc_put_var_map(mapids, mapids%id_qeva , UNC_LOC_S, Qevamap)
ierr = unc_put_var_map(mapids, mapids%id_qcon , UNC_LOC_S, Qconmap)
ierr = unc_put_var_map(mapids, mapids%id_qlong , UNC_LOC_S, Qlongmap)
ierr = unc_put_var_map(mapids, mapids%id_qfreva, UNC_LOC_S, Qfrevamap)
ierr = unc_put_var_map(mapids, mapids%id_qfrcon, UNC_LOC_S, Qfrconmap)
end if
ierr = unc_put_var_map(mapids , mapids%id_qtot , UNC_LOC_S, Qtotmap)
end if
! JRE - XBeach
if (jawave .eq. 4) then
ierr = unc_put_var_map(mapids, mapids%id_E , UNC_LOC_S, E)
ierr = unc_put_var_map(mapids, mapids%id_R , UNC_LOC_S, R)
ierr = unc_put_var_map(mapids, mapids%id_H , UNC_LOC_S, H)
ierr = unc_put_var_map(mapids, mapids%id_D , UNC_LOC_S, D)
ierr = unc_put_var_map(mapids, mapids%id_Fx , UNC_LOC_U, Fx, 0d0)
ierr = unc_put_var_map(mapids, mapids%id_Fy , UNC_LOC_U, Fy, 0d0)
! Orient ust, vst in correct (E, N) direction...
if (.not. allocated(ust_rot)) allocate(ust_rot(lnx), vst_rot(lnx))
ust_rot = ust*csu - vst*snu
vst_rot = ust*snu + vst*csu
! then write:
ierr = unc_put_var_map(mapids, mapids%id_ust , UNC_LOC_U, ust_rot, 0d0)
ierr = unc_put_var_map(mapids, mapids%id_vst , UNC_LOC_U, vst_rot, 0d0)
deallocate(ust_rot, vst_rot)
ierr = unc_put_var_map(mapids, mapids%id_urms , UNC_LOC_U, urms, 0d0)
ierr = unc_put_var_map(mapids, mapids%id_sigmwav , UNC_LOC_S, sigmwav)
ierr = unc_put_var_map(mapids, mapids%id_cwav , UNC_LOC_S, cwav)
ierr = unc_put_var_map(mapids, mapids%id_cgwav , UNC_LOC_S, cgwav)
ierr = unc_put_var_map(mapids, mapids%id_thetamean, UNC_LOC_S, 270d0 - thetamean*pi/180d0)
endif
! TODO: AvD:
!! Roughness from trachytopes
!if (jatrt == 1) then
! ierr = nf90_put_var(imapfile, id_cftrt(iid), cftrt(:,2), (/ 1, itim /), (/ numl, 1 /))
!end if
end subroutine unc_write_map_filepointer_ugrid
!> Writes map/flow data to an already opened netCDF dataset.
!! The netnode and -links have been written already.
subroutine unc_write_map_filepointer(imapfile, tim, jaseparate) ! wrimap
use m_flow
use m_flowtimes
use m_flowgeom
use m_sobekdfm
use m_heatfluxes
use m_sferic
use network_data
use m_sediment
use m_wind
use m_flowparameters, only: jatrt
use m_xbeach_data
use m_transport, only: NUMCONST, ITRA1, ITRAN, constituents, const_names, id_const
implicit none
integer, intent(in) :: imapfile
real(kind=hp), intent(in) :: tim
integer, optional, intent(in) :: jaseparate !< Whether this save is manual/by user (not part of the standard map write series)
integer :: jaseparate_, idims(2)
logical, dimension(2), save :: firststep = .true.
integer, save :: ierr, ndim
integer, dimension(2), save :: &
!id_netcelldim, id_netcellmaxnodedim, id_netcellcontourptsdim, &
id_laydim, id_wdim, &
id_flowelemdim, &
id_maxfracdim, &
id_erolaydim, &
id_flowlinkdim, &
id_netlinkdim, &
id_1d2ddim, &
id_timedim, &
id_sedtotdim, id_sedsusdim, id_rho, id_viu, id_diu, id_q1, id_spircrv, id_spirint, &
id_s1, id_taus, id_ucx, id_ucy, id_ucz, id_ucxa, id_ucya, id_unorm, id_ww1, id_sa1, id_tem1, id_sed, id_ero, id_s0, id_u0, id_cftrt, id_czs, &
id_qsun, id_qeva, id_qcon, id_qlong, id_qfreva, id_qfrcon, id_qtot, &
id_patm, id_tair, id_rhum, id_clou, id_E, id_R, id_H, id_D, id_DR, id_urms, id_thetamean, &
id_cwav, id_cgwav, id_sigmwav, id_ust, id_Fx, id_Fy, id_vst, id_windx, id_windy, id_windxu, id_windyu, id_numlimdt, id_hs, id_bl, id_zk, &
id_time, id_timestep, &
id_sbcx, id_sbcy, id_sbwx, id_sbwy, id_sswx, id_sswy, id_sourse, id_sinkse, &
id_1d2d_edges, id_1d2d_zeta1d, id_1d2d_crest_level, id_1d2d_b_2di, id_1d2d_b_2dv, id_1d2d_d_2dv, id_1d2d_q_zeta, id_1d2d_q_lat, &
id_1d2d_cfl, id_1d2d_flow_cond, id_1d2d_sb
double precision, allocatable :: ust_rot(:), vst_rot(:)
double precision, dimension(:), allocatable :: dum
integer, dimension(:), allocatable :: idum
integer :: iid, i, j, numContPts, numNodes, itim, k, kb, kt, kk, n, LL, Lt, Lb, L
integer :: ndxndxi ! Either ndx or ndxi, depending on whether boundary nodes also need to be written.
double precision, dimension(:), allocatable :: windx, windy, windang
double precision :: vicc, dicc
! If jaseparate_==1 or this map file was just opened for the first time:
! only write net+vardefs first time, and write subsequent flow snapshots in later calls.
! jaseparate_==2: write com file
if (present(jaseparate)) then
jaseparate_ = jaseparate
else
jaseparate_ = 0
end if
if (jaseparate_ == 0 .or. jaseparate_ == 1) then
! mapfile, store/use ids number 1
iid = 1
ndxndxi = ndxi
elseif (jaseparate_ == 2) then
! comfile, store/use ids number 2
iid = 2
ndxndxi = ndx ! Com file, include boundary nodes
else
! error
iid = 0
endif
! Use nr of dimensions in netCDF file a quick check whether vardefs were written
! before in previous calls.
ndim = 0
ierr = nf90_inquire(imapfile, nDimensions=ndim)
! Only write net and flow geometry data the first time, or for a separate map file.
if (ndim == 0) then
call unc_write_net_filepointer(imapfile) ! Write standard net data as well
if (jaseparate_ == 2) then
call unc_write_flowgeom_filepointer(imapfile, jabndnd = 1) ! Write time-independent flow geometry data, with boundary nodes
ierr = nf90_inq_dimid(imapfile, 'nFlowElemWithBnd', id_flowelemdim(iid))
else
call unc_write_flowgeom_filepointer(imapfile) ! Write time-independent flow geometry data
ierr = nf90_inq_dimid(imapfile, 'nFlowElem', id_flowelemdim(iid))
end if
ierr = nf90_inq_dimid(imapfile, 'nFlowLink', id_flowlinkdim(iid))
ierr = nf90_inq_dimid(imapfile, 'nNetLink' , id_netlinkdim(iid))
if (nbnd1d2d > 0) then
ierr = nf90_def_dim(imapfile, 'nBnd1d2d', nbnd1d2d, id_1d2ddim(iid))
end if
! Time
ierr = nf90_def_dim(imapfile, 'time', nf90_unlimited, id_timedim(iid))
call check_error(ierr, 'def time dim')
ierr = nf90_def_var(imapfile, 'time', nf90_double, id_timedim(iid), id_time(iid))
ierr = nf90_put_att(imapfile, id_time(iid), 'units' , 'seconds since '//refdat(1:4)//'-'//refdat(5:6)//'-'//refdat(7:8)//' 00:00:00')
ierr = nf90_put_att(imapfile, id_time(iid), 'standard_name', 'time')
! 3D
if ( kmx > 0 ) then
call unc_append_3dflowgeom_def(imapfile) ! Append definition of time-independent 3d flow geometry data
ierr = nf90_inq_dimid(imapfile, 'laydim', id_laydim(iid))
ierr = nf90_inq_dimid(imapfile, 'wdim', id_wdim(iid))
end if
! Size of latest timestep
ierr = nf90_def_var(imapfile, 'timestep', nf90_double, id_timedim(iid), id_timestep(iid))
ierr = nf90_put_att(imapfile, id_timestep(iid), 'units' , 'seconds')
ierr = nf90_put_att(imapfile, id_timestep(iid), 'standard_name', 'timestep')
if(jamaps1 > 0) then
! Flow data on centres: water level at latest timestep
ierr = nf90_def_var(imapfile, 's1', nf90_double, (/ id_flowelemdim(iid), id_timedim (iid)/) , id_s1(iid))
ierr = nf90_put_att(imapfile, id_s1(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_s1(iid), 'standard_name', 'sea_surface_height') ! sorry for inland water people
ierr = nf90_put_att(imapfile, id_s1(iid), 'long_name' , 'waterlevel') ! sorry long name is shorter than standard name
ierr = nf90_put_att(imapfile, id_s1(iid), 'units' , 'm')
ierr = unc_add_gridmapping_att(imapfile, (/ id_s1(iid) /), jsferic)
endif
if (jaseparate_ == 0 .or. jaseparate_ == 1) then ! to mapfile
! Flow data on centres: water level timestep before the latest timestep
if(jamaps0 > 0) then
ierr = nf90_def_var(imapfile, 's0', nf90_double, (/ id_flowelemdim(iid), id_timedim (iid)/) , id_s0(iid))
ierr = nf90_put_att(imapfile, id_s0(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_s0(iid), 'standard_name', 'sea_surface_height') ! sorry for inland water people
ierr = nf90_put_att(imapfile, id_s0(iid), 'long_name' , 'waterlevel old') ! sorry long name is shorter than standard name
ierr = nf90_put_att(imapfile, id_s0(iid), 'units' , 'm')
ierr = unc_add_gridmapping_att(imapfile, (/ id_s0(iid) /), jsferic)
endif
idims(1) = id_flowelemdim(iid)
idims(2) = id_timedim(iid)
if(jamaps1 > 0) then
call definencvar(imapfile,id_hs(iid) ,nf90_double,idims,2, 'waterdepth' , 'waterdepth', 'm', 'FlowElem_xcc FlowElem_ycc')
endif
if (jamapheatflux > 0) then ! here less verbose
call definencvar(imapfile,id_tair(iid) ,nf90_double,idims,2, 'Tair' , 'Air Temperature', 'degC', 'FlowElem_xcc FlowElem_ycc')
call definencvar(imapfile,id_rhum(iid) ,nf90_double,idims,2, 'Rhum' , 'Relative humidity', ' ','FlowElem_xcc FlowElem_ycc')
call definencvar(imapfile,id_clou(iid) ,nf90_double,idims,2, 'Clou' , 'Cloudiness', ' ', 'FlowElem_xcc FlowElem_ycc')
if (jatem == 5) then
call definencvar(imapfile,id_qsun(iid) ,nf90_double,idims,2, 'Qsun' , 'Solar influx', '(W/m2)', 'FlowElem_xcc FlowElem_ycc')
call definencvar(imapfile,id_Qeva(iid) ,nf90_double,idims,2, 'Qeva' , 'Evaporative heat flux', '(W/m2)', 'FlowElem_xcc FlowElem_ycc')
call definencvar(imapfile,id_Qcon(iid) ,nf90_double,idims,2, 'Qcon' , 'Sensible heat flux', '(W/m2)', 'FlowElem_xcc FlowElem_ycc')
call definencvar(imapfile,id_Qlong(iid) ,nf90_double,idims,2, 'Qlong' , 'Long wave back radiation', '(W/m2)', 'FlowElem_xcc FlowElem_ycc')
call definencvar(imapfile,id_Qfreva(iid) ,nf90_double,idims,2, 'Qfreva', 'Free convection evaporative heat flux', '(W/m2)', 'FlowElem_xcc FlowElem_ycc')
call definencvar(imapfile,id_Qfrcon(iid) ,nf90_double,idims,2, 'Qfrcon', 'Free convection sensible heat flux', '(W/m2)', 'FlowElem_xcc FlowElem_ycc')
endif
call definencvar(imapfile,id_Qtot(iid) ,nf90_double,idims,2, 'Qtot' , 'Total heat flux', '(W/m2)', 'FlowElem_xcc FlowElem_ycc')
endif
if (jamapnumlimdt > 0) then
call definencvar(imapfile,id_numlimdt(iid) ,nf90_INT,idims,2, 'Numlimdt' , 'Nr of times cell was Courant limiting', '( )', 'FlowElem_xcc FlowElem_ycc')
endif
if(jamaptaucurrent > 0) then
! Flow data on centres
ierr = nf90_def_var(imapfile, 'taus' , nf90_double, (/ id_flowelemdim(iid), id_timedim (iid)/) , id_taus(iid))
ierr = nf90_put_att(imapfile, id_taus(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_taus(iid), 'standard_name', 'taucurrent')
ierr = nf90_put_att(imapfile, id_taus(iid), 'long_name' , 'taucurrent in cell center')
ierr = nf90_put_att(imapfile, id_taus(iid), 'units' , 'N/m2')
endif
if (kmx > 0) then
! 3D
if(jamapu1 > 0) then
ierr = nf90_def_var(imapfile, 'unorm', nf90_double, (/ id_laydim(iid), id_flowlinkdim(iid), id_timedim (iid)/) , id_unorm(iid))
endif
if(jamapu0 > 0) then
ierr = nf90_def_var(imapfile, 'u0' , nf90_double, (/ id_laydim(iid), id_flowlinkdim(iid), id_timedim (iid)/) , id_u0(iid) )
endif
if(jamapq1 > 0) then
ierr = nf90_def_var(imapfile, 'q1' , nf90_double, (/ id_laydim(iid), id_flowlinkdim(iid), id_timedim (iid)/) , id_q1(iid) )
endif
if(jamapviu > 0) then
ierr = nf90_def_var(imapfile, 'viu' , nf90_double, (/ id_laydim(iid), id_flowlinkdim(iid), id_timedim (iid)/) , id_viu(iid) )
endif
if(jamapdiu > 0) then
ierr = nf90_def_var(imapfile, 'diu' , nf90_double, (/ id_laydim(iid), id_flowlinkdim(iid), id_timedim (iid)/) , id_diu(iid) )
endif
if(jamapucvec > 0) then
ierr = nf90_def_var(imapfile, 'ucx' , nf90_double, (/ id_laydim(iid), id_flowelemdim(iid), id_timedim (iid)/) , id_ucx(iid) )
ierr = nf90_def_var(imapfile, 'ucy' , nf90_double, (/ id_laydim(iid), id_flowelemdim(iid), id_timedim (iid)/) , id_ucy(iid) )
ierr = nf90_def_var(imapfile, 'ucz' , nf90_double, (/ id_laydim(iid), id_flowelemdim(iid), id_timedim (iid)/) , id_ucz(iid) )
! Depth-averaged cell-center velocities in 3D:
ierr = nf90_def_var(imapfile, 'ucxa' , nf90_double, (/ id_flowelemdim(iid), id_timedim (iid)/) , id_ucxa(iid) )
ierr = nf90_def_var(imapfile, 'ucya' , nf90_double, (/ id_flowelemdim(iid), id_timedim (iid)/) , id_ucya(iid) )
endif
if(jamapww1 > 0) then
ierr = nf90_def_var(imapfile, 'ww1' , nf90_double, (/ id_wdim(iid), id_flowelemdim(iid), id_timedim (iid)/) , id_ww1(iid))
endif
if(jamaprho > 0) then
ierr = nf90_def_var(imapfile, 'rho' , nf90_double, (/ id_wdim(iid), id_flowelemdim(iid), id_timedim (iid)/) , id_rho(iid))
endif
!
if(jamapucvec > 0) then
ierr = nf90_put_att(imapfile, id_ucz(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_ucz(iid), 'standard_name', 'upward_sea_water_velocity')
ierr = nf90_put_att(imapfile, id_ucz(iid), 'long_name' , 'upward velocity on cell center')
ierr = nf90_put_att(imapfile, id_ucz(iid), 'units' , 'm s-1')
ierr = nf90_put_att(imapfile, id_ucxa(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_ucxa(iid), 'standard_name', 'eastward_sea_water_velocity')
ierr = nf90_put_att(imapfile, id_ucxa(iid), 'long_name' , 'Depth-averaged eastward velocity on cell center')
ierr = nf90_put_att(imapfile, id_ucxa(iid), 'units' , 'm s-1')
ierr = nf90_put_att(imapfile, id_ucya(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_ucya(iid), 'standard_name', 'northward_sea_water_velocity')
ierr = nf90_put_att(imapfile, id_ucya(iid), 'long_name' , 'Depth-averaged northward velocity on cell center')
ierr = nf90_put_att(imapfile, id_ucya(iid), 'units' , 'm s-1')
endif
if(jamapww1 > 0) then
ierr = nf90_put_att(imapfile, id_ww1(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_ww1(iid), 'standard_name', 'upward_sea_water_velocity') ! same standard name allowed?
ierr = nf90_put_att(imapfile, id_ww1(iid), 'long_name' , 'upward velocity on vertical interface') ! (upward normal or upward)?
ierr = nf90_put_att(imapfile, id_ww1(iid), 'units' , 'm s-1')
!?elevation
endif
if(jamaprho > 0) then
ierr = nf90_put_att(imapfile, id_rho(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_rho(iid), 'standard_name', 'flow_density')
ierr = nf90_put_att(imapfile, id_rho(iid), 'long_name' , 'Flow mass density')
ierr = nf90_put_att(imapfile, id_rho(iid), 'units' , 'kg/m3')
endif
endif
endif ! jaseparate_ /= 2
if (kmx == 0) then
if(jamapu1 > 0) then
ierr = nf90_def_var(imapfile, 'unorm' , nf90_double, (/ id_flowlinkdim(iid), id_timedim (iid)/) , id_unorm(iid))
endif
if(jamapu0 > 0) then
ierr = nf90_def_var(imapfile, 'u0' , nf90_double, (/ id_flowlinkdim(iid), id_timedim (iid)/) , id_u0(iid) )
endif
if(jamapq1 > 0) then ! Nabi
ierr = nf90_def_var(imapfile, 'q1' , nf90_double, (/ id_flowlinkdim(iid), id_timedim (iid)/) , id_q1(iid) )
endif
if(jamapviu > 0) then
ierr = nf90_def_var(imapfile, 'viu' , nf90_double, (/ id_flowlinkdim(iid), id_timedim (iid)/) , id_viu(iid) )
endif
if(jamapdiu > 0) then
ierr = nf90_def_var(imapfile, 'diu' , nf90_double, (/ id_flowlinkdim(iid), id_timedim (iid)/) , id_diu(iid) )
endif
if(jamapucvec > 0) then
ierr = nf90_def_var(imapfile, 'ucx' , nf90_double, (/ id_flowelemdim(iid), id_timedim (iid)/) , id_ucx(iid) )
ierr = nf90_def_var(imapfile, 'ucy' , nf90_double, (/ id_flowelemdim(iid), id_timedim (iid)/) , id_ucy(iid) )
endif
endif
if(jamapu1 > 0) then
ierr = nf90_put_att(imapfile, id_unorm(iid),'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_put_att(imapfile, id_unorm(iid),'standard_name', 'sea_water_speed')
ierr = nf90_put_att(imapfile, id_unorm(iid),'units' , 'm s-1')
endif
if(jamapu0 > 0) then
ierr = nf90_put_att(imapfile, id_u0(iid) ,'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_put_att(imapfile, id_u0(iid) ,'standard_name', 'sea_water_speed_old')
ierr = nf90_put_att(imapfile, id_u0(iid) ,'units' , 'm s-1')
endif
if(jamapq1 > 0) then ! Nabi
ierr = nf90_put_att(imapfile, id_q1(iid) ,'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_put_att(imapfile, id_q1(iid) ,'standard_name', 'flow_flux')
ierr = nf90_put_att(imapfile, id_q1(iid) ,'long_name' , 'Flow flux')
ierr = nf90_put_att(imapfile, id_q1(iid) ,'units' , 'm3/s')
endif
if(jamapviu > 0) then
ierr = nf90_put_att(imapfile, id_viu(iid) ,'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_put_att(imapfile, id_viu(iid) ,'standard_name', 'Horizontal viscosity')
ierr = nf90_put_att(imapfile, id_viu(iid) ,'units' , 'm2/s')
endif
if(jamapdiu > 0) then
ierr = nf90_put_att(imapfile, id_diu(iid) ,'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_put_att(imapfile, id_diu(iid) ,'standard_name', 'Horizontal diffusivity')
ierr = nf90_put_att(imapfile, id_diu(iid) ,'units' , 'm2/s')
endif
if(jamapucvec > 0) then
ierr = nf90_put_att(imapfile, id_ucx(iid) ,'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_ucx(iid) ,'standard_name', 'eastward_sea_water_velocity')
if (jaeulervel==0 .or. jaseparate_==2) then
ierr = nf90_put_att(imapfile, id_ucx(iid) ,'long_name' , 'eastward velocity on cell center')
else
ierr = nf90_put_att(imapfile, id_ucx(iid) ,'long_name' , 'eastward Eulerian velocity on cell center')
endif
ierr = nf90_put_att(imapfile, id_ucx(iid) ,'units' , 'm s-1')
ierr = nf90_put_att(imapfile, id_ucy(iid) ,'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_ucy(iid) ,'standard_name', 'northward_sea_water_velocity')
if (jaeulervel==0 .or. jaseparate_==2) then
ierr = nf90_put_att(imapfile, id_ucy(iid) ,'long_name' , 'northward velocity on cell center')
else
ierr = nf90_put_att(imapfile, id_ucy(iid) ,'long_name' , 'northward Eulerian velocity on cell center')
endif
ierr = nf90_put_att(imapfile, id_ucy(iid) ,'units' , 'm s-1')
endif
if (jaseparate_ /= 2) then
if (jamapsal > 0 .and. jasal > 0) then
if ( kmx > 0 ) then ! 3D
ierr = nf90_def_var(imapfile, 'sa1' , nf90_double, (/ id_laydim(iid), id_flowelemdim (iid), id_timedim (iid)/) , id_sa1(iid))
else
ierr = nf90_def_var(imapfile, 'sa1' , nf90_double, (/ id_flowelemdim (iid), id_timedim (iid)/) , id_sa1(iid))
end if
ierr = nf90_put_att(imapfile, id_sa1(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_sa1(iid), 'standard_name', 'sea_water_salinity')
ierr = nf90_put_att(imapfile, id_sa1(iid), 'long_name' , 'Salinity')
ierr = nf90_put_att(imapfile, id_sa1(iid), 'units' , 'ppt')
endif
if (jamaptem > 0 .and. jatem > 0) then
if ( kmx > 0 ) then ! 3D
ierr = nf90_def_var(imapfile, 'tem1' , nf90_double, (/ id_laydim(iid), id_flowelemdim(iid) , id_timedim(iid) /) , id_tem1(iid))
else
ierr = nf90_def_var(imapfile, 'tem1' , nf90_double, (/ id_flowelemdim(iid) , id_timedim(iid) /) , id_tem1(iid))
end if
ierr = nf90_put_att(imapfile, id_tem1(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_tem1(iid), 'standard_name', 'water_temperature')
ierr = nf90_put_att(imapfile, id_tem1(iid), 'long_name' , 'Temperature')
ierr = nf90_put_att(imapfile, id_tem1(iid), 'units' , 'degC')
endif
! tracers
if (jamapconst > 0 .and. ITRA1 > 0) then
do j=ITRA1,ITRAN
if ( kmx > 0 ) then ! 3D
ierr = nf90_def_var(imapfile, trim(const_names(j)), nf90_double, (/ id_laydim(iid), id_flowelemdim (iid), id_timedim (iid)/) , id_const(iid,j))
else
ierr = nf90_def_var(imapfile, trim(const_names(j)), nf90_double, (/ id_flowelemdim (iid), id_timedim (iid)/) , id_const(iid,j))
end if
ierr = nf90_put_att(imapfile, id_const(iid,j), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_const(iid,j), 'standard_name', trim(const_names(j)))
ierr = nf90_put_att(imapfile, id_const(iid,j), 'long_name' , trim(const_names(j)))
ierr = nf90_put_att(imapfile, id_const(iid,j), 'units' , 'ppt')
end do
endif
if ( jasecf > 0 .and. jamapspir > 0) then
ierr = nf90_def_var(imapfile, 'spircrv' , nf90_double, (/ id_flowelemdim (iid), id_timedim (iid) /) , id_spircrv(iid))
ierr = nf90_put_att(imapfile, id_spircrv(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_spircrv(iid), 'standard_name', 'streamline_curvature')
ierr = nf90_put_att(imapfile, id_spircrv(iid), 'long_name' , 'Streamline curvature')
ierr = nf90_put_att(imapfile, id_spircrv(iid), 'units' , '1/m')
ierr = nf90_def_var(imapfile, 'spirint' , nf90_double, (/ id_flowelemdim (iid), id_timedim (iid) /) , id_spirint(iid))
ierr = nf90_put_att(imapfile, id_spirint(iid) ,'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_spirint(iid) ,'standard_name', 'sec_flow_int')
ierr = nf90_put_att(imapfile, id_spirint(iid) ,'long_name' , 'Spiral flow intensity')
ierr = nf90_put_att(imapfile, id_spirint(iid) ,'units' , 'm/s')
end if
if (jamapsed > 0 .and. stm_included) then
ierr = nf90_def_dim(imapfile, 'nSedTot', stmpar%lsedtot, id_sedtotdim(iid))
ierr = nf90_def_dim(imapfile, 'nSedSus', stmpar%lsedsus, id_sedsusdim(iid))
if (stmpar%morpar%moroutput%sbcuv) then
ierr = nf90_def_var(imapfile, 'sbcx' , nf90_double, (/ id_flowelemdim(iid) , id_sedtotdim(iid) , id_timedim(iid) /) , id_sbcx(iid))
ierr = nf90_put_att(imapfile, id_sbcx(iid) , 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_sbcx(iid) , 'long_name' , 'bed load transport due to currents, x-component')
ierr = nf90_put_att(imapfile, id_sbcx(iid) , 'units' , 'kg m-1 s-1')
ierr = nf90_def_var(imapfile, 'sbcy' , nf90_double, (/ id_flowelemdim (iid), id_sedtotdim(iid), id_timedim (iid)/) , id_sbcy(iid))
ierr = nf90_put_att(imapfile, id_sbcy (iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_sbcy (iid), 'long_name' , 'bed load transport due to currents, y-component')
ierr = nf90_put_att(imapfile, id_sbcy (iid), 'units' , 'kg m-1 s-1')
endif
if (stmpar%morpar%moroutput%sbwuv) then
ierr = nf90_def_var(imapfile, 'sbwx' , nf90_double, (/ id_flowelemdim(iid) , id_sedtotdim(iid) , id_timedim(iid) /) , id_sbwx(iid))
ierr = nf90_put_att(imapfile, id_sbwx(iid) , 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_sbwx(iid) , 'long_name' , 'bed load transport due to waves, x-component')
ierr = nf90_put_att(imapfile, id_sbwx(iid) , 'units' , 'kg m-1 s-1')
ierr = nf90_def_var(imapfile, 'sbwy' , nf90_double, (/ id_flowelemdim(iid) , id_sedtotdim(iid) , id_timedim(iid) /) , id_sbwy(iid))
ierr = nf90_put_att(imapfile, id_sbwy(iid) , 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_sbwy(iid) , 'long_name' , 'bed load transport due to waves, y-component')
ierr = nf90_put_att(imapfile, id_sbwy(iid) , 'units' , 'kg m-1 s-1')
endif
if (stmpar%morpar%moroutput%sswuv) then
ierr = nf90_def_var(imapfile, 'sswx' , nf90_double, (/ id_flowelemdim(iid) , id_sedtotdim(iid) , id_timedim(iid) /) , id_sswx(iid))
ierr = nf90_put_att(imapfile, id_sswx(iid) , 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_sswx(iid) , 'long_name' , 'suspended load transport due to waves, x-component')
ierr = nf90_put_att(imapfile, id_sswx(iid) , 'units' , 'kg m-1 s-1')
ierr = nf90_def_var(imapfile, 'sswy' , nf90_double, (/ id_flowelemdim(iid) , id_sedtotdim(iid) , id_timedim(iid) /) , id_sswy(iid))
ierr = nf90_put_att(imapfile, id_sswy(iid) , 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_sswy(iid) , 'long_name' , 'suspended load transport due to waves, y-component')
ierr = nf90_put_att(imapfile, id_sswy(iid) , 'units' , 'kg m-1 s-1')
endif
if (stmpar%morpar%moroutput%sourcesink) then
ierr = nf90_def_var(imapfile, 'sourse' , nf90_double, (/ id_flowelemdim(iid) , id_sedsusdim(iid) , id_timedim(iid) /) , id_sourse(iid))
ierr = nf90_put_att(imapfile, id_sourse(iid) , 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_sourse(iid) , 'long_name' , 'source term suspended sediment fractions')
ierr = nf90_put_att(imapfile, id_sourse(iid) , 'units' , 'kg m-3 s-1')
ierr = nf90_def_var(imapfile, 'sinkse' , nf90_double, (/ id_flowelemdim(iid) , id_sedsusdim(iid) , id_timedim(iid) /) , id_sinkse(iid))
ierr = nf90_put_att(imapfile, id_sinkse(iid) , 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_sinkse(iid) , 'long_name' , 'sink term suspended sediment fractions')
ierr = nf90_put_att(imapfile, id_sinkse(iid) , 'units' , 's-1')
endif
endif
!Secondary Flow
!if ( jasecf > 0 ) then
!ierr = nf90_inq_varid(imapfile, 'rsi' , id_rsi(iid))
!ierr = nf90_inq_varid(imapfile, 'rsiexact' , id_rsiexact)
!ierr = nf90_inq_varid(imapfile, 'dudx' , id_dudx(iid))
!ierr = nf90_inq_varid(imapfile, 'dudy' , id_dudy(iid))
!ierr = nf90_inq_varid(imapfile, 'dvdx' , id_dvdx(iid))
!ierr = nf90_inq_varid(imapfile, 'dvdy' , id_dvdy(iid))
!end if
if (jamapsed > 0 .and. jased > 0) then
ierr = nf90_def_dim(imapfile, 'nFrac', mxgr, id_maxfracdim(iid))
if (jaceneqtr == 1) then
ierr = nf90_inq_dimid(imapfile, 'nFlowElem', id_erolaydim(iid)) ! Note: points to an existing dimension (either nNetNode, or nFlowElem)
if (ierr /= nf90_noerr) then
ierr = nf90_inq_dimid(imapfile, 'nFlowElemWithBnd', id_erolaydim(iid))
end if
else
ierr = nf90_inq_dimid(imapfile, 'nNetNode' , id_erolaydim(iid)) ! Note: points to an existing dimension (either nNetNode, or nFlowElem)
endif
ierr = nf90_def_var(imapfile, 'sed' , nf90_double, (/ id_maxfracdim (iid), id_flowelemdim(iid), id_timedim (iid)/) , id_sed(iid))
ierr = nf90_put_att(imapfile, id_sed(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_sed(iid), 'standard_name', 'sediment_concentration')
ierr = nf90_put_att(imapfile, id_sed(iid), 'long_name' , 'Sediment concentration')
ierr = nf90_put_att(imapfile, id_sed(iid), 'units' , 'kg/m3')
ierr = nf90_def_var(imapfile, 'ero' , nf90_double, (/ id_maxfracdim (iid), id_erolaydim(iid), id_timedim (iid)/) , id_ero(iid))
if (jaceneqtr == 1) then
ierr = nf90_put_att(imapfile, id_ero(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_ero(iid), 'long_name', 'erodable layer thickness per size fraction in cell centres')
else
ierr = nf90_put_att(imapfile, id_ero(iid), 'coordinates' , 'NetNode_x NetNode_y')
ierr = nf90_put_att(imapfile, id_ero(iid), 'long_name', 'erodable layer thickness per size fraction at cell corners')
endif
ierr = nf90_put_att(imapfile, id_ero(iid), 'standard_name' , 'Erodable layer thickness') ! Not CF
ierr = nf90_put_att(imapfile, id_ero(iid), 'units' , 'm')
if (jaceneqtr .ne. 1) then
idims(1) = id_erolaydim(iid)
call definencvar(imapfile,id_zk(iid) ,nf90_double,idims,2, 'Netnode_bedlevel_Zk' , 'Netnode bedlevel Zk', 'm', 'NetNode_x NetNode_y')
endif
idims(1) = id_flowelemdim(iid)
call definencvar(imapfile,id_bl(iid) ,nf90_double,idims,2, 'Cellcenter_bedlevel_BL' , 'Cellcenter bedlevel BL', 'm', 'FlowElem_xcc FlowElem_ycc')
endif
! JRE waves
if (jawave .eq. 4) then
ierr = nf90_def_var(imapfile, 'E', nf90_double, (/ id_flowelemdim(iid), id_timedim(iid) /) , id_E(iid))
ierr = nf90_put_att(imapfile, id_E(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_E(iid), 'standard_name', 'sea_surface_bulk_wave_energy') ! not CF
ierr = nf90_put_att(imapfile, id_E(iid), 'long_name' , 'wave energy per square meter')
ierr = nf90_put_att(imapfile, id_E(iid), 'units' , 'J m-2')
ierr = nf90_def_var(imapfile, 'R', nf90_double, (/ id_flowelemdim(iid), id_timedim(iid) /) , id_R(iid))
ierr = nf90_put_att(imapfile, id_R(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_R(iid), 'standard_name', 'sea_surface_bulk_roller_energy') ! not CF
ierr = nf90_put_att(imapfile, id_R(iid), 'long_name' , 'roller energy per square meter')
ierr = nf90_put_att(imapfile, id_R(iid), 'units' , 'J m-2')
ierr = nf90_def_var(imapfile, 'DR', nf90_double, (/ id_flowelemdim(iid), id_timedim(iid) /) , id_DR(iid))
ierr = nf90_put_att(imapfile, id_DR(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_DR(iid), 'standard_name', 'sea_surface_bulk_roller_dissipation') ! not CF
ierr = nf90_put_att(imapfile, id_DR(iid), 'long_name' , 'roller energy dissipation per square meter')
ierr = nf90_put_att(imapfile, id_DR(iid), 'units' , 'W m-2')
ierr = nf90_def_var(imapfile, 'D', nf90_double, (/ id_flowelemdim(iid), id_timedim(iid) /) , id_D(iid))
ierr = nf90_put_att(imapfile, id_D(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_D(iid), 'standard_name', 'sea_surface_wave_breaking_dissipation') ! not CF
ierr = nf90_put_att(imapfile, id_D(iid), 'long_name' , 'wave breaking energy dissipation per square meter')
ierr = nf90_put_att(imapfile, id_D(iid), 'units' , 'W m-2')
ierr = nf90_def_var(imapfile, 'H', nf90_double, (/ id_flowelemdim(iid), id_timedim(iid) /) , id_H(iid))
ierr = nf90_put_att(imapfile, id_H(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_H(iid), 'standard_name', 'sea_surface_wave_significant_height')
ierr = nf90_put_att(imapfile, id_H(iid), 'long_name' , 'significant wave height')
ierr = nf90_put_att(imapfile, id_H(iid), 'units' , 'm')
ierr = nf90_def_var(imapfile, 'urms', nf90_double, (/ id_flowlinkdim(iid), id_timedim(iid)/) , id_urms(iid))
ierr = nf90_put_att(imapfile, id_urms(iid),'standard_name', 'sea_surface_wave_orbital_velocity')
ierr = nf90_put_att(imapfile, id_urms(iid),'units' , 'm s-1')
ierr = nf90_put_att(imapfile, id_urms(iid),'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_def_var(imapfile, 'ust' , nf90_double, (/ id_flowlinkdim(iid), id_timedim(iid) /) , id_ust(iid))
ierr = nf90_put_att(imapfile, id_ust(iid),'standard_name', 'sea_surface_Stokes_drift_east')
ierr = nf90_put_att(imapfile, id_ust(iid),'units' , 'm s-1')
ierr = nf90_put_att(imapfile, id_ust(iid),'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_def_var(imapfile, 'vst' , nf90_double, (/ id_flowlinkdim(iid), id_timedim(iid)/) , id_vst(iid))
ierr = nf90_put_att(imapfile, id_vst(iid),'standard_name', 'sea_surface_Stokes_drift_north')
ierr = nf90_put_att(imapfile, id_vst(iid),'units' , 'm s-1')
ierr = nf90_put_att(imapfile, id_vst(iid),'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_def_var(imapfile, 'Fx' , nf90_double, (/ id_flowlinkdim(iid), id_timedim(iid) /) , id_Fx(iid))
ierr = nf90_put_att(imapfile, id_Fx(iid),'standard_name', 'sea_surface_wave_force_east')
ierr = nf90_put_att(imapfile, id_Fx(iid),'units' , 'N m-2')
ierr = nf90_put_att(imapfile, id_Fx(iid),'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_def_var(imapfile, 'Fy' , nf90_double, (/ id_flowlinkdim(iid), id_timedim(iid) /) , id_Fy(iid))
ierr = nf90_put_att(imapfile, id_Fy(iid),'standard_name', 'sea_surface_wave_force_north')
ierr = nf90_put_att(imapfile, id_Fy(iid),'units' , 'N m-2')
ierr = nf90_put_att(imapfile, id_Fy(iid),'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_def_var(imapfile, 'thetamean', nf90_double, (/ id_flowelemdim(iid), id_timedim(iid)/) , id_thetamean(iid))
ierr = nf90_put_att(imapfile, id_thetamean(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_thetamean(iid), 'standard_name', 'sea_surface_wave_from_direction') ! not CF
ierr = nf90_put_att(imapfile, id_thetamean(iid), 'long_name' , 'mean wave angle')
ierr = nf90_put_att(imapfile, id_thetamean(iid), 'units' , 'deg')
ierr = nf90_def_var(imapfile, 'cwav', nf90_double, (/ id_flowelemdim(iid), id_timedim(iid) /) , id_cwav(iid))
ierr = nf90_put_att(imapfile, id_cwav(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_cwav(iid), 'standard_name', 'sea_surface_wave_phase_celerity') ! not CF
ierr = nf90_put_att(imapfile, id_cwav(iid), 'long_name' , 'phase celerity')
ierr = nf90_put_att(imapfile, id_cwav(iid), 'units' , 'm s-1')
ierr = nf90_def_var(imapfile, 'cgwav', nf90_double, (/ id_flowelemdim(iid), id_timedim(iid) /) , id_cgwav(iid))
ierr = nf90_put_att(imapfile, id_cgwav(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_cgwav(iid), 'standard_name', 'sea_surface_wave_group_celerity') ! not CF
ierr = nf90_put_att(imapfile, id_cgwav(iid), 'long_name' , 'group celerity')
ierr = nf90_put_att(imapfile, id_cgwav(iid), 'units' , 'm s-1')
ierr = nf90_def_var(imapfile, 'sigmwav', nf90_double, (/ id_flowelemdim(iid), id_timedim(iid) /) , id_sigmwav(iid))
ierr = nf90_put_att(imapfile, id_sigmwav(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_sigmwav(iid), 'standard_name', 'sea_surface_wave_mean_frequency') ! not CF
ierr = nf90_put_att(imapfile, id_sigmwav(iid), 'long_name' , 'mean wave frequency')
ierr = nf90_put_att(imapfile, id_sigmwav(iid), 'units' , 'rad s-1')
endif
if ( NUMCONST.eq.0 ) then
ierr = unc_add_gridmapping_att(imapfile, (/ id_s1(iid), id_taus(iid), id_ucx(iid), id_ucy(iid), id_unorm(iid), id_sa1(iid), id_sed(iid) /), jsferic) ! add id_ucz(iid)?
else
if (allocated(idum)) deallocate(idum)
allocate(idum(7+NUMCONST))
idum(1:7) = (/ id_s1(iid), id_taus(iid), id_ucx(iid), id_ucy(iid), id_unorm(iid), id_sa1(iid), id_sed(iid) /)
do j=1,NUMCONST
idum(7+j) = id_const(iid,j)
end do
ierr = unc_add_gridmapping_att(imapfile, idum, jsferic)
endif
if (kmx > 0) then
ierr = unc_add_gridmapping_att(imapfile, (/ id_ucz(iid), id_ucxa(iid), id_ucya(iid), id_ww1(iid), id_rho(iid) /), jsferic)
end if
if (jamaptrachy > 0 .and. jatrt == 1) then
! Roughness data on net-links
ierr = nf90_def_var(imapfile, 'cftrt' , nf90_double, (/ id_netlinkdim(iid), id_timedim(iid) /) , id_cftrt(iid))
if (ifrctypuni == 0) then
ierr = nf90_put_att(imapfile, id_cftrt(iid),'long_name' , 'Chezy roughness from trachytopes')
ierr = nf90_put_att(imapfile, id_cftrt(iid),'units' , 'm0.5s-1') ! WO: does not follow standard ? (which accepts only integral powers?)
elseif (ifrctypuni == 1) then
ierr = nf90_put_att(imapfile, id_cftrt(iid),'long_name' , 'Manning roughness from trachytopes')
ierr = nf90_put_att(imapfile, id_cftrt(iid),'units' , 'sm-0.333') ! WO: does not follow standard ? (which accepts only integral powers?)
elseif ((ifrctypuni == 2) .or. (ifrctypuni == 3)) then
ierr = nf90_put_att(imapfile, id_cftrt(iid),'long_name' , 'White-Colebrook roughness from trachytopes')
ierr = nf90_put_att(imapfile, id_cftrt(iid),'units' , 'm')
else
ierr = nf90_put_att(imapfile, id_cftrt(iid),'long_name' , 'Roughness from trachytopes')
ierr = nf90_put_att(imapfile, id_cftrt(iid),'units' , ' ')
endif
endif
if (jamapchezy > 0) then
! Chezy data on flow-nodes
ierr = nf90_def_var(imapfile, 'czs' , nf90_double, (/ id_flowelemdim(iid), id_timedim(iid) /) , id_czs(iid))
ierr = nf90_put_att(imapfile, id_czs(iid),'long_name' , 'Chezy roughness')
ierr = nf90_put_att(imapfile, id_czs(iid),'coordinates' , 'FlowElem_xcc FlowElem_ycc')
ierr = nf90_put_att(imapfile, id_czs(iid),'units' , 'm0.5s-1') ! WO: does not follow standard ? (which accepts only integral powers?)
endif
! 1D2D boundaries
if (nbnd1d2d > 0) then
ierr = nf90_def_var(imapfile, '1d2d_flowlinknrs' , nf90_int, (/ id_1d2ddim(iid) /) , id_1d2d_edges(iid))
ierr = nf90_put_att(imapfile, id_czs(iid),'long_name' , 'Flow link numbers of the open 1D2D boundary links.')
ierr = nf90_def_var(imapfile, '1d2d_zeta' , nf90_double, (/ id_1d2ddim(iid), id_timedim(iid) /) , id_1d2d_zeta1d(iid))
ierr = nf90_put_att(imapfile, id_1d2d_zeta1d(iid),'standard_name', 'sea_surface_height_above_geoid')
ierr = nf90_put_att(imapfile, id_1d2d_zeta1d(iid),'long_name' , '1D water level next to each 1d2d boundary link.')
ierr = nf90_put_att(imapfile, id_1d2d_zeta1d(iid),'units' , 'm')
ierr = nf90_def_var(imapfile, '1d2d_crest_level' , nf90_double, (/ id_1d2ddim(iid), id_timedim(iid) /) , id_1d2d_crest_level(iid))
ierr = nf90_put_att(imapfile, id_1d2d_crest_level(iid),'standard_name', 'sea_surface_height_above_geoid')
ierr = nf90_put_att(imapfile, id_1d2d_crest_level(iid),'long_name' , '1D water level next to each 1d2d boundary link.')
ierr = nf90_put_att(imapfile, id_1d2d_crest_level(iid),'units' , 'm')
ierr = nf90_def_var(imapfile, '1d2d_b_2di' , nf90_double, (/ id_1d2ddim(iid), id_timedim(iid) /) , id_1d2d_b_2di(iid))
ierr = nf90_put_att(imapfile, id_1d2d_b_2di(iid),'standard_name', 'b_2di')
ierr = nf90_put_att(imapfile, id_1d2d_b_2di(iid),'long_name' , 'coefficient for 1d2d interface b_2di')
ierr = nf90_put_att(imapfile, id_1d2d_b_2di(iid),'units' , '-')
ierr = nf90_def_var(imapfile, '1d2d_b_2dv' , nf90_double, (/ id_1d2ddim(iid), id_timedim(iid) /) , id_1d2d_b_2dv(iid))
ierr = nf90_put_att(imapfile, id_1d2d_b_2dv(iid),'standard_name', 'b_2dv')
ierr = nf90_put_att(imapfile, id_1d2d_b_2dv(iid),'long_name' , 'coefficient for 1d2d interface b_2di')
ierr = nf90_put_att(imapfile, id_1d2d_b_2dv(iid),'units' , '-')
ierr = nf90_def_var(imapfile, '1d2d_d_2dv' , nf90_double, (/ id_1d2ddim(iid), id_timedim(iid) /) , id_1d2d_d_2dv(iid))
ierr = nf90_put_att(imapfile, id_1d2d_d_2dv(iid),'standard_name', 'd_2dv')
ierr = nf90_put_att(imapfile, id_1d2d_d_2dv(iid),'long_name' , 'coefficient for 1d2d interface d_2dv')
ierr = nf90_put_att(imapfile, id_1d2d_d_2dv(iid),'units' , '-')
ierr = nf90_def_var(imapfile, '1d2d_qzeta' , nf90_double, (/ id_1d2ddim(iid), id_timedim(iid) /) , id_1d2d_q_zeta(iid))
ierr = nf90_put_att(imapfile, id_1d2d_q_zeta(iid),'standard_name', 'q_zeta_1d2d')
ierr = nf90_put_att(imapfile, id_1d2d_q_zeta(iid),'long_name' , 'q_zeta_1d2d')
ierr = nf90_put_att(imapfile, id_1d2d_q_zeta(iid),'units' , 'm2/s')
ierr = nf90_def_var(imapfile, '1d2d_q_lat' , nf90_double, (/ id_1d2ddim(iid), id_timedim(iid) /) , id_1d2d_q_lat(iid))
ierr = nf90_put_att(imapfile, id_1d2d_q_lat(iid),'standard_name', 'q_lat')
ierr = nf90_put_att(imapfile, id_1d2d_q_lat(iid),'long_name' , 'q_lat')
ierr = nf90_put_att(imapfile, id_1d2d_q_lat(iid),'units' , 'm3/s')
ierr = nf90_def_var(imapfile, '1d2d_cfl' , nf90_double, (/ id_1d2ddim(iid), id_timedim(iid) /) , id_1d2d_cfl(iid))
ierr = nf90_put_att(imapfile, id_1d2d_cfl(iid),'standard_name', 'cfl')
ierr = nf90_put_att(imapfile, id_1d2d_cfl(iid),'long_name' , 'wave flow courant')
ierr = nf90_put_att(imapfile, id_1d2d_cfl(iid),'units' , '-')
ierr = nf90_def_var(imapfile, '1d2d_sb' , nf90_double, (/ id_1d2ddim(iid), id_timedim(iid) /) , id_1d2d_sb(iid))
ierr = nf90_put_att(imapfile, id_1d2d_sb(iid),'standard_name', '1d2d_sb')
ierr = nf90_put_att(imapfile, id_1d2d_sb(iid),'long_name' , 'water levels in boundary points')
ierr = nf90_put_att(imapfile, id_1d2d_sb(iid),'units' , 'm')
ierr = nf90_def_var(imapfile, '1d2d_flow_cond' , nf90_int, (/ id_1d2ddim(iid), id_timedim(iid) /) , id_1d2d_flow_cond(iid))
ierr = nf90_put_att(imapfile, id_1d2d_flow_cond(iid),'standard_name', 'flow_condition')
ierr = nf90_put_att(imapfile, id_1d2d_flow_cond(iid),'long_name' , 'Flow Condition 0: closed, 1: free 1d to 2d, 2: free 2d to 1d, 3: submerged')
ierr = nf90_put_att(imapfile, id_1d2d_flow_cond(iid),'units' , '-')
end if
endif
if (jamapwind > 0 .and. japatm > 0) then
call definencvar(imapfile,id_patm(iid) ,nf90_double,idims,2, 'Patm' , 'Atmospheric Pressure', 'N/m2', 'FlowElem_xcc FlowElem_ycc')
endif
if (jamapwind > 0 .and. jawind /= 0) then
ierr = nf90_def_var(imapfile, 'windx', nf90_double, (/ id_flowelemdim(iid), id_timedim (iid)/) , id_windx(iid))
ierr = nf90_def_var(imapfile, 'windy', nf90_double, (/ id_flowelemdim(iid), id_timedim (iid)/) , id_windy(iid))
ierr = nf90_put_att(imapfile, id_windx(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
!ierr = nf90_put_att(imapfile, id_windx(iid), 'standard_name', 'eastward_air_velocity')
ierr = nf90_put_att(imapfile, id_windx(iid), 'long_name' , 'eastward air velocity on cell center')
ierr = nf90_put_att(imapfile, id_windx(iid), 'units' , 'm s-1')
ierr = nf90_put_att(imapfile, id_windy(iid), 'coordinates' , 'FlowElem_xcc FlowElem_ycc')
!ierr = nf90_put_att(imapfile, id_windy(iid), 'standard_name', 'northward_air_velocity')
ierr = nf90_put_att(imapfile, id_windy(iid), 'long_name' , 'northward air velocity on cell center')
ierr = nf90_put_att(imapfile, id_windy(iid), 'units' , 'm s-1')
! Also wind on flow links
ierr = nf90_def_var(imapfile, 'windxu', nf90_double, (/ id_flowlinkdim(iid), id_timedim (iid)/) , id_windxu(iid))
ierr = nf90_def_var(imapfile, 'windyu', nf90_double, (/ id_flowlinkdim(iid), id_timedim (iid)/) , id_windyu(iid))
ierr = nf90_put_att(imapfile, id_windxu(iid), 'coordinates' , 'FlowLink_xu FlowLink_yu')
ierr = nf90_put_att(imapfile, id_windxu(iid), 'long_name' , 'eastward air velocity on flow links')
ierr = nf90_put_att(imapfile, id_windxu(iid), 'standard_name', 'eastward_wind')
ierr = nf90_put_att(imapfile, id_windxu(iid), 'units' , 'm s-1')
ierr = nf90_put_att(imapfile, id_windyu(iid), 'coordinates' , 'FlowElem_xu FlowElem_yu')
ierr = nf90_put_att(imapfile, id_windyu(iid), 'long_name' , 'northward air velocity on flow links')
ierr = nf90_put_att(imapfile, id_windyu(iid), 'standard_name', 'northward_wind')
ierr = nf90_put_att(imapfile, id_windyu(iid), 'units' , 'm s-1')
endif
!
ierr = unc_add_gridmapping_att(imapfile, (/ id_windx(iid), id_windy(iid), id_windxu(iid), id_windyu(iid), nf90_global /), jsferic)
ierr = nf90_enddef(imapfile)
! 1D2D boundaries
if (nbnd1d2d > 0 .and. jaseparate_ /= 2) then
if (allocated(idum)) deallocate(idum)
allocate(idum(nbnd1d2d))
do i=1,nbnd1d2d
idum(i) = kbnd1d2d(3, i) ! Flow link nrs
end do
ierr = nf90_put_var(imapfile, id_1d2d_edges(iid), idum)
deallocate(idum)
end if
firststep(iid) = .false.
endif
! End of writing time-independent flow geometry data.
! -- Inquire id's belonging to map file ------------------------
if (firststep(iid) .and. ndim>0) then ! TODO: AvD: UNST-530
!
!
! this step is necessary because if a snapshot_map.nc file is written
! in between two map file outputs the saved id's may have changed
!
firststep(iid) = .false.
!
ierr = nf90_inq_dimid(imapfile, 'nFlowElem', id_flowelemdim(iid))
if (ierr /= nf90_noerr) then
ierr = nf90_inq_dimid(imapfile, 'nFlowElemWithBnd', id_flowelemdim(iid))
endif
ierr = nf90_inq_dimid(imapfile, 'nFlowLink', id_flowlinkdim(iid))
!
! Time
ierr = nf90_inq_dimid(imapfile, 'time', id_timedim(iid))
ierr = nf90_inq_varid(imapfile, 'time', id_time(iid))
!
if ( kmx>0 ) then
ierr = nf90_inq_dimid(imapfile, 'laydim', id_laydim(iid))
ierr = nf90_inq_dimid(imapfile, 'wdim', id_wdim(iid))
endif
!
! Size of latest timestep
! Why ask for id_*, thay are in a save statement no?
ierr = nf90_inq_varid(imapfile, 'timestep', id_timestep(iid))
ierr = nf90_inq_varid(imapfile, 's1', id_s1(iid))
! Flow data on centres: water level timestep before the latest timestep
ierr = nf90_inq_varid(imapfile, 's0', id_s0(iid))
ierr = nf90_inq_varid(imapfile, 'taus' , id_taus(iid))
!
if ( kmx>0 ) then ! 3D
ierr = nf90_inq_varid(imapfile, 'ucx', id_ucx(iid))
ierr = nf90_inq_varid(imapfile, 'ucy', id_ucy(iid))
ierr = nf90_inq_varid(imapfile, 'ucz', id_ucz(iid))
ierr = nf90_inq_varid(imapfile, 'ucxa', id_ucxa(iid))
ierr = nf90_inq_varid(imapfile, 'ucya', id_ucya(iid))
ierr = nf90_inq_varid(imapfile, 'ww1', id_ww1(iid))
ierr = nf90_inq_varid(imapfile, 'rho', id_rho(iid))
else
ierr = nf90_inq_varid(imapfile, 'ucx', id_ucx(iid))
ierr = nf90_inq_varid(imapfile, 'ucy', id_ucy(iid))
ierr = nf90_inq_varid(imapfile, 'rho', id_rho(iid))
ierr = nf90_inq_varid(imapfile, 'spircrv', id_spircrv(iid))
ierr = nf90_inq_varid(imapfile, 'spirint', id_spirint(iid))
endif
!
if (jasal > 0) then
ierr = nf90_inq_varid(imapfile, 'sa1', id_sa1(iid))
endif
if (jatem > 0) then
ierr = nf90_inq_varid(imapfile, 'tem1', id_tem1(iid))
endif
if (ITRA1 > 0) then
do j=ITRA1,ITRAN
ierr = nf90_inq_varid(imapfile, trim(const_names(j)), id_const(iid,j))
end do
endif
!if ( jasecf > 0 ) then
! ierr = nf90_inq_varid(imapfile, 'rsi', id_rsi(iid))
! ierr = nf90_inq_varid(imapfile, 'dudx', id_dudx(iid))
! ierr = nf90_inq_varid(imapfile, 'dudy', id_dudy(iid))
! ierr = nf90_inq_varid(imapfile, 'dvdx', id_dvdx(iid))
! ierr = nf90_inq_varid(imapfile, 'dvdy', id_dvdy(iid))
!endif
!
if (stm_included) then
ierr = nf90_inq_varid(imapfile, 'nSedTot', id_sedtotdim(iid))
ierr = nf90_inq_varid(imapfile, 'nSedSus', id_sedsusdim(iid))
if (stmpar%morpar%moroutput%sbcuv) then
ierr = nf90_inq_varid(imapfile, 'sbcx', id_sbcx(iid))
ierr = nf90_inq_varid(imapfile, 'sbcy', id_sbcy(iid))
endif
if (stmpar%morpar%moroutput%sbwuv) then
ierr = nf90_inq_varid(imapfile, 'sbwx', id_sbwx(iid))
ierr = nf90_inq_varid(imapfile, 'sbwy', id_sbwy(iid))
endif
if (stmpar%morpar%moroutput%sswuv) then
ierr = nf90_inq_varid(imapfile, 'sswx', id_sswx(iid))
ierr = nf90_inq_varid(imapfile, 'sswy', id_sswy(iid))
endif
if (stmpar%morpar%moroutput%sourcesink) then
ierr = nf90_inq_varid(imapfile, 'sourse', id_sourse(iid))
ierr = nf90_inq_varid(imapfile, 'sinkse', id_sinkse(iid))
endif
endif
!
if (jased > 0) then
ierr = nf90_inq_dimid(imapfile, 'nFrac', id_maxfracdim(iid))
if (jaceneqtr == 1) then
ierr = nf90_inq_dimid(imapfile, 'nFlowElem', id_erolaydim(iid)) ! Note: points to an existing dimension (either nNetNode, or nFlowElem)
if (ierr /= nf90_noerr) then
ierr = nf90_inq_dimid(imapfile, 'nFlowElemWithBnd', id_erolaydim(iid))
end if
else
ierr = nf90_inq_dimid(imapfile, 'nNetNode', id_erolaydim(iid)) ! Note: points to an existing dimension (either nNetNode, or nFlowElem)
end if
!
ierr = nf90_inq_varid(imapfile, 'sed', id_sed(iid))
!
ierr = nf90_inq_varid(imapfile, 'ero', id_ero(iid))
endif
! JRE - XBeach
if (jawave .eq. 4) then
ierr = nf90_inq_varid(imapfile, 'E' , id_E(iid))
ierr = nf90_inq_varid(imapfile, 'R' , id_R(iid))
ierr = nf90_inq_varid(imapfile, 'H' , id_H(iid))
ierr = nf90_inq_varid(imapfile, 'D' , id_D(iid))
ierr = nf90_inq_varid(imapfile, 'DR' , id_DR(iid))
ierr = nf90_inq_varid(imapfile, 'urms' , id_urms(iid))
ierr = nf90_inq_varid(imapfile, 'ust' , id_ust(iid))
ierr = nf90_inq_varid(imapfile, 'vst' , id_vst(iid))
ierr = nf90_inq_varid(imapfile, 'Fx' , id_Fx(iid))
ierr = nf90_inq_varid(imapfile, 'Fy' , id_Fy(iid))
ierr = nf90_inq_varid(imapfile, 'thetamean', id_thetamean(iid))
ierr = nf90_inq_varid(imapfile, 'cwav' , id_cwav(iid))
ierr = nf90_inq_varid(imapfile, 'cgwav' , id_cgwav(iid))
ierr = nf90_inq_varid(imapfile, 'sigmwav' , id_sigmwav(iid))
endif
! 1D2D boundaries
if (nbnd1d2d > 0) then
ierr = nf90_inq_varid(imapfile, '1d2d_flowlinknrs' , id_1d2d_edges(iid))
ierr = nf90_inq_varid(imapfile, '1d2d_zeta' , id_1d2d_zeta1d(iid))
ierr = nf90_inq_varid(imapfile, '1d2d_crest_level' , id_1d2d_crest_level(iid))
ierr = nf90_inq_varid(imapfile, '1d2d_b_2di' , id_1d2d_b_2di(iid))
ierr = nf90_inq_varid(imapfile, '1d2d_b_2dv' , id_1d2d_b_2dv(iid))
ierr = nf90_inq_varid(imapfile, '1d2d_d_2dv' , id_1d2d_d_2dv(iid))
ierr = nf90_inq_varid(imapfile, '1d2d_q_zeta' , id_1d2d_q_zeta(iid))
ierr = nf90_inq_varid(imapfile, '1d2d_q_lat' , id_1d2d_q_lat(iid))
ierr = nf90_inq_varid(imapfile, '1d2d_cfl' , id_1d2d_cfl(iid))
ierr = nf90_inq_varid(imapfile, '1d2d_sb' , id_1d2d_sb(iid))
ierr = nf90_inq_varid(imapfile, '1d2d_flow_cond' , id_1d2d_flow_cond(iid))
end if
!
! Flow data on edges
ierr = nf90_inq_varid(imapfile, 'unorm' , id_unorm(iid))
!
! Flow data on edges
ierr = nf90_inq_varid(imapfile, 'u0' , id_u0(iid))
ierr = nf90_inq_varid(imapfile, 'q1' , id_q1(iid))
ierr = nf90_inq_varid(imapfile, 'viu' , id_viu(iid))
ierr = nf90_inq_varid(imapfile, 'diu' , id_diu(iid))
!
if (jawind/=0) then
ierr = nf90_inq_varid(imapfile, 'windx', id_windx(iid))
ierr = nf90_inq_varid(imapfile, 'windy', id_windy(iid))
endif
endif
! -- Start data writing (flow data) ------------------------
if (jaseparate_ == 1) then
itim = 1
firststep(iid) = .true.
elseif (jaseparate_ == 2) then
itim = 1
else
it_map = it_map+1
itim = it_map ! Increment time dimension index
end if
! Time
ierr = nf90_put_var(imapfile, id_time (iid), tim, (/ itim /))
ierr = nf90_put_var(imapfile, id_timestep(iid), dts, (/ itim /))
!
! Copy ucx/ucy to workx/worky
! They will optionally be transformed into Eulerian velocities
if (kmx > 0) then
do kk = 1,ndx
call getkbotktop(kk,kb,kt)
do k = kb,kt
workx(k) = ucx(k)
worky(k) = ucy(k)
enddo
enddo
else
do kk = 1,ndx
workx(kk) = ucx(kk)
worky(kk) = ucy(kk)
enddo
endif
!
! Transform workx/worky into Eulerian velocities,
! only when the user asks for it and only if we are not writing to com-file
!
if (jaeulervel==1 .and. jaseparate_/=2) then
call setucxucyeuler()
endif
! Water level
ierr = nf90_put_var(imapfile, id_s1(iid), s1, (/ 1, itim /), (/ ndxndxi, 1 /))
if (jaseparate_ /= 2) then
ierr = nf90_put_var(imapfile, id_s0(iid), s0, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_hs(iid), hs, (/ 1, itim /), (/ ndxndxi, 1 /))
! Tau current
if (jawave .ne. 3) then ! Else, get taus from subroutine tauwave (taus = taucur + tauwave). Bas; Mind for jawind!
call gettaus(1) ! Update taus and czs
elseif (jamapchezy > 0) then
call gettaus(2) ! Only update czs
endif
if (jamaptaucurrent > 0) then
ierr = nf90_put_var(imapfile, id_taus(iid), taus, (/ 1, itim /), (/ ndxndxi, 1 /))
endif
if (jamapchezy > 0) then
ierr = nf90_put_var(imapfile, id_czs(iid), czs, (/ 1, itim /), (/ ndxndxi, 1 /))
endif
! Velocities
if ( kmx>0 ) then
! 3D
call reconstructucz(0)
call unc_append_3dflowgeom_put(imapfile, jaseparate_, itim)
!do kk=1,ndxndxi
! call getkbotktop(kk,kb,kt)
! ierr = nf90_put_var(imapfile, id_ucx(iid) , workx (kb:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+1, 1, 1 /))
! ierr = nf90_put_var(imapfile, id_ucy(iid) , worky (kb:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+1, 1, 1 /))
! ierr = nf90_put_var(imapfile, id_ucz(iid) , ucz (kb:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+1, 1, 1 /))
! ierr = nf90_put_var(imapfile, id_ww1(iid) , ww1 (kb-1:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+2, 1, 1 /))
! ! ierr = nf90_put_var(imapfile, id_turk(iid) , turkin1(kb-1:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+2, 1, 1 /))
! ! ierr = nf90_put_var(imapfile, id_teps(iid) , tureps1(kb-1:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+2, 1, 1 /))
! ! ierr = nf90_put_var(imapfile, id_vicwws(iid), vicwws1(kb-1:kt), start=(/ 1, kk, itim /), count=(/ kt-kb+2, 1, 1 /))
!end do
!do LL=1,lnx
! call getLbotLtopmax(LL,Lb,Lt)
! ierr = nf90_put_var(imapfile, id_unorm(iid) , u1(Lb:Lt), start=(/ 1, LL, itim /), count=(/ Lt-Lb+1, 1, 1 /))
! ierr = nf90_put_var(imapfile, id_u0(iid) , u0(Lb:Lt), start=(/ 1, LL, itim /), count=(/ Lt-Lb+1, 1, 1 /))
!end do
do kk=1,ndxndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
work1(k-kb+1,kk) = workx(k)
enddo
enddo
ierr = nf90_put_var(imapfile, id_ucx(iid), work1(1:kmx,1:ndxndxi), start=(/ 1, 1, itim /), count=(/ kmx, ndxndxi, 1 /))
do kk=1,ndxndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
work1(k-kb+1,kk) = worky(k)
enddo
enddo
ierr = nf90_put_var(imapfile, id_ucy(iid), work1(1:kmx,1:ndxndxi), start=(/ 1, 1, itim /), count=(/ kmx, ndxndxi, 1 /))
do kk=1,ndxndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
work1(k-kb+1,kk) = ucz(k)
enddo
enddo
ierr = nf90_put_var(imapfile, id_ucz(iid), work1(1:kmx,1:ndxndxi), start=(/ 1, 1, itim /), count=(/ kmx, ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_ucxa(iid), ucxq(1:ndxndxi), start=(/ 1, itim /), count=(/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_ucya(iid), ucyq(1:ndxndxi), start=(/ 1, itim /), count=(/ ndxndxi, 1 /))
do kk=1,ndxndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
work1(k-kb+1,kk) = ww1(k)
enddo
enddo
ierr = nf90_put_var(imapfile, id_ww1(iid), work1(1:kmx,1:ndxndxi), start=(/ 1, 1, itim /), count=(/ kmx, ndxndxi, 1 /))
do LL=1,lnx
call getLbotLtopmax(LL,Lb,Lt)
do L = Lb,Lt
work1(L-Lb+1,LL) = u1(L)
enddo
enddo
ierr = nf90_put_var(imapfile, id_unorm(iid), work1(1:kmx,1:lnx), start=(/ 1, 1, itim /), count=(/ kmx, lnx, 1 /))
do LL=1,lnx
call getLbotLtopmax(LL,Lb,Lt)
do L = Lb,Lt
work1(L-Lb+1,LL) = u0(L)
enddo
enddo
ierr = nf90_put_var(imapfile, id_u0(iid) , work1(1:kmx,1:lnx), start=(/ 1, 1, itim /), count=(/ kmx, lnx, 1 /))
do LL=1,lnx ! Nabi
call getLbotLtopmax(LL,Lb,Lt)
do L = Lb,Lt
work1(L-Lb+1,LL) = q1(L)
enddo
enddo
ierr = nf90_put_var(imapfile, id_q1(iid) , work1(1:kmx,1:lnx), start=(/ 1, 1, itim /), count=(/ kmx, lnx, 1 /))
do LL=1,lnx
call getLbotLtopmax(LL,Lb,Lt)
if (javiusp == 1) then ! user specified part
vicc = viusp(LL)
else
vicc = vicouv
endif
do L = Lb,Lt
work1(L-Lb+1,LL) = viu(L) + vicc
enddo
enddo
ierr = nf90_put_var(imapfile, id_viu(iid) , work1(1:kmx,1:lnx), start=(/ 1, 1, itim /), count=(/ kmx, lnx, 1 /))
do LL=1,lnx
call getLbotLtopmax(LL,Lb,Lt)
if (jadiusp == 1) then
dicc = diusp(L)
else
dicc = dicouv
endif
do L = Lb,Lt
work1(L-Lb+1,LL) = viu(L) * 0.7 + dicc
enddo
enddo
ierr = nf90_put_var(imapfile, id_diu(iid) , work1(1:kmx,1:lnx), start=(/ 1, 1, itim /), count=(/ kmx, lnx, 1 /))
do kk=1,ndxndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
work1(k-kb+1,kk) = rho(k)
enddo
enddo
ierr = nf90_put_var(imapfile, id_rho(iid), work1(1:kmx,1:ndxndxi), start=(/ 1, 1, itim /), count=(/ kmx, ndxndxi, 1 /))
end if
if ( kmx == 0 ) then
ierr = nf90_put_var(imapfile, id_unorm(iid), u1 , (/ 1, itim /), (/ lnx , 1 /))
ierr = nf90_put_var(imapfile, id_u0 (iid), u0 , (/ 1, itim /), (/ lnx , 1 /))
if( jasecf > 0 ) then
ierr = nf90_put_var(imapfile, id_spircrv(iid), spircrv, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_spirint(iid), spirint, (/ 1, itim /), (/ ndxndxi, 1 /))
endif
ierr = nf90_put_var(imapfile, id_q1 (iid) , q1 , (/ 1, itim /), (/ lnx , 1 /))
do LL=1,lnx
if (javiusp == 1) then ! user specified part
vicc = viusp(LL)
else
vicc = vicouv
endif
work1(1,LL) = viu(LL) + vicc
enddo
ierr = nf90_put_var(imapfile, id_viu (iid), work1(1:1,1:lnx) , (/ 1, itim /), (/ lnx , 1 /))
do LL=1,lnx
if (jadiusp == 1) then
dicc = diusp(LL)
else
dicc = dicouv
endif
work1(1,LL) = viu(LL) * 0.7 + dicc
enddo
ierr = nf90_put_var(imapfile, id_diu (iid), work1(1:1,1:lnx) , (/ 1, itim /), (/ lnx , 1 /))
end if
end if
if ( kmx == 0 ) then
ierr = nf90_put_var(imapfile, id_ucx (iid), workx, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_ucy (iid), worky, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_rho (iid), rho , (/ 1, itim /), (/ ndxndxi, 1 /))
end if
if (jaseparate_ /= 2) then
! Salinity
if (jasal > 0) then
if ( kmx>0 ) then
! 3D
!do kk=1,ndxndxi
! call getkbotktop(kk,kb,kt)
! ierr = nf90_put_var(imapfile, id_sa1(iid), sa1(kb:kt), (/ 1, kk, itim /), (/ kt-kb+1, 1, 1 /))
!end do
do kk=1,ndxndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
work1(k-kb+1,kk) = sa1(k)
enddo
end do
ierr = nf90_put_var(imapfile, id_sa1(iid), work1(1:kmx,1:ndxndxi), (/ 1, 1, itim /), (/ kmx, ndxndxi, 1 /))
else
ierr = nf90_put_var(imapfile, id_sa1(iid), sa1, (/ 1, itim /), (/ ndxndxi, 1 /))
end if
endif
if (jatem > 0) then
if ( kmx>0 ) then ! 3D
!do kk=1,ndxndxi
! call getkbotktop(kk,kb,kt)
! ierr = nf90_put_var(imapfile, id_tem1(iid), tem1(kb:kt), (/ 1, kk, itim /), (/ kt-kb+1, 1, 1 /))
!end do
do kk=1,ndxndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
work1(k-kb+1,kk) = tem1(k)
enddo
end do
ierr = nf90_put_var(imapfile, id_tem1(iid), work1(1:kmx,1:ndxndxi), (/ 1, 1, itim /), (/ kmx, ndxndxi, 1 /))
else
ierr = nf90_put_var(imapfile, id_tem1(iid), tem1, (/ 1, itim /), (/ ndxndxi, 1 /))
end if
endif
!if ( jasecf > 0 ) then
! ierr = nf90_put_var(imapfile, id_rsi(iid), spircrv, (/ 1, itim /), (/ ndxndxi, 1 /))
!endif
! tracers
if (jamapconst > 0 .and. ITRA1 > 0) then ! Note: numtracers is only counting tracer boundaries.
allocate(dum(NdxNdxi))
do j=ITRA1,ITRAN
if ( kmx>0 ) then
! 3D
do kk=1,ndxndxi
call getkbotktop(kk,kb,kt)
do k = kb,kt
! TODO: UNST-976, incorrect for Z-layers:
work1(k-kb+1,kk) = constituents(j,k)
enddo
end do
ierr = nf90_put_var(imapfile, id_const(iid,j), work1(1:kmx,1:ndxndxi), (/ 1, 1, itim /), (/ kmx, ndxndxi, 1 /))
! if ( ierr.ne.0 ) exit ! probably newly added tracer in the GUI
else
do kk=1,NdxNdxi
dum(kk) = constituents(j,kk)
end do
ierr = nf90_put_var(imapfile, id_const(iid,j), dum, (/ 1, itim /), (/ NdxNdxi, 1 /) )
end if
end do
if ( allocated(dum) ) deallocate(dum)
end if
if (stm_included) then
if (stmpar%morpar%moroutput%sbcuv) then
ierr = nf90_put_var(imapfile, id_sbcx(iid) , sedtra%sbcx, (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedtot, 1 /))
ierr = nf90_put_var(imapfile, id_sbcy(iid) , sedtra%sbcy, (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedtot, 1 /))
endif
if (stmpar%morpar%moroutput%sbwuv) then
ierr = nf90_put_var(imapfile, id_sbwx(iid) , sedtra%sbwx, (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedtot, 1 /))
ierr = nf90_put_var(imapfile, id_sbwy(iid) , sedtra%sbwy, (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedtot, 1 /))
endif
if (stmpar%morpar%moroutput%sswuv) then
ierr = nf90_put_var(imapfile, id_sswx(iid) , sedtra%sswx, (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedtot, 1 /))
ierr = nf90_put_var(imapfile, id_sswy(iid) , sedtra%sswy, (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedtot, 1 /))
endif
if (stmpar%morpar%moroutput%sourcesink) then
ierr = nf90_put_var(imapfile, id_sourse(iid) , sedtra%sourse, (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedsus, 1 /))
ierr = nf90_put_var(imapfile, id_sinkse(iid) , sedtra%sinkse, (/ 1, 1, itim /), (/ ndxndxi, stmpar%lsedsus, 1 /))
endif
endif ! stm
! Sediment
if (jased > 0 .and. .not.stm_included) then
ierr = nf90_put_var(imapfile, id_sed(iid), sed, (/ 1, 1, itim /), (/ mxgr, ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_ero(iid), grainlay, (/ 1, 1, itim /), (/ mxgr, size(grainlay,2) , 1 /))
ierr = nf90_put_var(imapfile, id_bl(iid), bl, (/ 1, itim /), (/ ndxndxi , 1 /))
if (jaceneqtr .ne. 1) then
ierr = nf90_put_var(imapfile, id_zk(iid), zk, (/ 1, itim /), (/ numk , 1 /))
endif
! TODO: AvD: size(grainlay,2) is always correct (mxn), but we have a problem if jaceneqtr==2 and mxn/=numk,
! because then the dimension for ero is set to nNetNode, and coordinate attribute refers to NetNode_x
! (both length numk), whereas ero itself is shorter than numk.
endif
! 1D2D boundaries
if (nbnd1d2d > 0) then
ierr = nf90_put_var(imapfile, id_1d2d_zeta1d(iid), zbnd1d2d1, (/ 1, itim /), (/ nbnd1d2d, 1 /))
ierr = nf90_put_var(imapfile, id_1d2d_crest_level(iid), zcrest1d2d, (/ 1, itim /), (/ nbnd1d2d, 1 /))
ierr = nf90_put_var(imapfile, id_1d2d_b_2di(iid), b_2di, (/ 1, itim /), (/ nbnd1d2d, 1 /))
ierr = nf90_put_var(imapfile, id_1d2d_b_2dv(iid), b_2dv, (/ 1, itim /), (/ nbnd1d2d, 1 /))
ierr = nf90_put_var(imapfile, id_1d2d_d_2dv(iid), d_2dv, (/ 1, itim /), (/ nbnd1d2d, 1 /))
ierr = nf90_put_var(imapfile, id_1d2d_q_zeta(iid), qzeta_1d2d, (/ 1, itim /), (/ nbnd1d2d, 1 /))
ierr = nf90_put_var(imapfile, id_1d2d_q_lat(iid), qlat_1d2d, (/ 1, itim /), (/ nbnd1d2d, 1 /))
ierr = nf90_put_var(imapfile, id_1d2d_cfl(iid), cfl, (/ 1, itim /), (/ nbnd1d2d, 1 /))
ierr = nf90_put_var(imapfile, id_1d2d_sb(iid), sb_1d2d, (/ 1, itim /), (/ nbnd1d2d, 1 /))
ierr = nf90_put_var(imapfile, id_1d2d_flow_cond(iid), FlowCond, (/ 1, itim /), (/ nbnd1d2d, 1 /))
end if
endif
if (jawind > 0 .and. jamapwind > 0) then
allocate (windx(ndxndxi), stat=ierr)
allocate (windy(ndxndxi), stat=ierr)
!windx/y is not set for flownodes without links
!windx = -999.0d0
!windy = -999.0d0
windx = 0.0d0
windy = 0.0d0
do n = 1,ndxndxi
!
! Currently, wx/y is defined on the links
! TO DO: EC-module should not be asked for wind components on the links but on the cells
!
if (nd(n)%lnx > 0) then
do i = 1,nd(n)%lnx
windx(n) = windx(n) + wx(iabs(nd(n)%ln(i)))
windy(n) = windy(n) + wy(iabs(nd(n)%ln(i)))
end do
windx(n) = windx(n) / nd(n)%lnx
windy(n) = windy(n) / nd(n)%lnx
else
j=1
endif
end do
ierr = nf90_put_var(imapfile, id_windx (iid), windx, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_windy (iid), windy, (/ 1, itim /), (/ ndxndxi, 1 /))
deallocate (windx, stat=ierr)
deallocate (windy, stat=ierr)
ierr = nf90_put_var(imapfile, id_windxu (iid), wx, (/ 1, itim /), (/ lnx, 1 /))
ierr = nf90_put_var(imapfile, id_windyu (iid), wy, (/ 1, itim /), (/ lnx, 1 /))
endif
if (jamapwind > 0 .and. japatm > 0) then
ierr = nf90_put_var(imapfile, id_patm(iid) , Patm, (/ 1, itim /), (/ ndxndxi, 1 /))
endif
if (jatem > 1) then ! Heat modelling only
ierr = nf90_put_var(imapfile, id_tair(iid) , Tair, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_rhum(iid) , Rhum, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_clou(iid) , Clou, (/ 1, itim /), (/ ndxndxi, 1 /))
endif
if (jamapheatflux > 0) then
if (jatem == 5) then
ierr = nf90_put_var(imapfile, id_qsun(iid) , Qsunmap , (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_qeva(iid) , Qevamap , (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_qcon(iid) , Qconmap , (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_qlong(iid) , Qlongmap , (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_qfreva(iid), Qfrevamap, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_qfrcon(iid), Qfrconmap, (/ 1, itim /), (/ ndxndxi, 1 /))
endif
ierr = nf90_put_var(imapfile, id_qtot(iid) , Qtotmap , (/ 1, itim /), (/ ndxndxi, 1 /))
endif
ierr = nf90_put_var(imapfile, id_numlimdt(iid) , numlimdt , (/ 1, itim /), (/ ndxndxi, 1 /))
! Roughness from trachytopes
if (jatrt == 1) then
ierr = nf90_put_var(imapfile, id_cftrt(iid), cftrt(:,2), (/ 1, itim /), (/ numl, 1 /))
end if
! JRE - XBeach
if (jawave .eq. 4) then
ierr = nf90_put_var(imapfile, id_E(iid), E, (/ 1, itim /), (/ ndxndxi, 1 /)) ! direction integrated
ierr = nf90_put_var(imapfile, id_R(iid), R, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_H(iid), H, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_D(iid), D, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_DR(iid), DR, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_Fx(iid), Fx, (/ 1, itim /), (/ lnx, 1 /))
ierr = nf90_put_var(imapfile, id_Fy(iid), Fy, (/ 1, itim /), (/ lnx, 1 /))
! Orient ust, vst in correct (E, N) direction...
if (.not. allocated(ust_rot)) allocate(ust_rot(lnx), vst_rot(lnx))
ust_rot = ust*csu - vst*snu
vst_rot = ust*snu + vst*csu
! then write:
ierr = nf90_put_var(imapfile, id_ust(iid), ust_rot, (/ 1, itim /), (/ lnx, 1 /))
ierr = nf90_put_var(imapfile, id_vst(iid), vst_rot, (/ 1, itim /), (/ lnx, 1 /))
deallocate(ust_rot, vst_rot)
ierr = nf90_put_var(imapfile, id_urms(iid), urms, (/ 1, itim /), (/ lnx, 1 /))
ierr = nf90_put_var(imapfile, id_sigmwav(iid), sigmwav, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_cwav(iid), cwav, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_cgwav(iid), cgwav, (/ 1, itim /), (/ ndxndxi, 1 /))
ierr = nf90_put_var(imapfile, id_thetamean(iid), 270d0 - thetamean*pi/180d0, (/ 1, itim /), (/ ndxndxi, 1 /))
endif
! deallocate
if ( NUMCONST.gt.0 ) then
if ( allocated(idum) ) deallocate(idum)
end if
end subroutine unc_write_map_filepointer
!> Writes the unstructured net to a netCDF file.
!! If file exists, it will be overwritten.
subroutine unc_write_net(filename, janetcell, janetbnd)
character(len=*), intent(in) :: filename
integer, optional, intent(in) :: janetcell !< write additional network cell information (1) or not (0). Default: 1.
integer, optional, intent(in) :: janetbnd !< write additional network boundary information (1) or not (0). Default: 1.
integer :: inetfile, ierr, janetcell_loc, janetbnd_loc
janetcell_loc = 0
janetbnd_loc = 0
if ( present(janetcell) ) then
janetcell_loc = janetcell
end if
if ( present(janetbnd) ) then
janetbnd_loc = janetbnd
end if
ierr = unc_create(filename, 0, inetfile)
if (ierr /= nf90_noerr) then
call mess(LEVEL_ERROR, 'Could not create net file '''//trim(filename)//'''.')
call check_error(ierr)
return
end if
call unc_write_net_filepointer(inetfile, janetcell=janetcell_loc, janetbnd=janetbnd_loc)
ierr = unc_close(inetfile)
end subroutine unc_write_net
!> Writes the unstructured net to an already opened netCDF dataset.
subroutine unc_write_net_filepointer(inetfile, janetcell, janetbnd)
use network_data
use m_flowgeom, only: xz, yz
use m_alloc
use m_sferic
use m_missing
integer, intent(in) :: inetfile
integer, optional, intent(in) :: janetcell !< write additional network cell information (1) or not (0). Default: 1.
integer, optional, intent(in) :: janetbnd !< write additional network boundary information (1) or not (0). Default: 1.
integer :: janetcell_
integer :: janetbnd_
integer, allocatable :: kn3(:), ibndlink(:)
integer :: ierr
integer :: id_netnodedim, id_netlinkdim, id_netlinkptsdim, & !< Dimensions
id_bndlinkdim, &
id_netelemdim, id_netelemmaxnodedim, &
id_netelemlinkdim, id_netelemlinkptsdim, id_netlinkcontourptsdim, &
id_netnodex, id_netnodey, id_netnodez, & !< Node variables
id_netnodelon, id_netnodelat, & !< Mandatory lon/lat coords for net nodes
id_netlink, id_netlinktype, & !< Link variables
id_netlinkxu, id_netlinkyu, &
id_netlinkcontourx, id_netlinkcontoury, &
id_bndlink, id_bndlinktype, & !< Boundary variables
id_netelemnode, id_netelemlink !< Netelem variables
integer :: id_mesh2d
integer :: jaInDefine = 0
integer :: k, L, nv, numbnd, maxbnd, ja, k1, k2, kt, n1
double precision :: xzn,yzn,x3, y3, x4, y4,DIS,XP,YP,rl, xn, yn, t0, t1
double precision, allocatable :: xtt(:,:), ytt(:,:), xut(:), yut(:)
integer, dimension(:), allocatable :: kn1write
integer, dimension(:), allocatable :: kn2write
call readyy('Writing net data',0d0)
! Defaults for extended information:
janetcell_ = 1
janetbnd_ = 1
if ( present(janetcell) ) then
janetcell_ = janetcell
end if
if ( present(janetbnd) ) then
janetbnd_ = janetbnd
end if
! hk: this should not be done here anymore
! if (janetcell_ /= 0) then
! if (size(lnn) < numl .or. netstat == NETSTAT_CELLS_DIRTY ) then
! call setnodadm(0)
! call findcells(0)
! end if
! endif
if (janetbnd_ /= 0) then
numbnd = 0
maxbnd = ceiling(sqrt(real(numl))) ! First estimate of numbnd
allocate(ibndlink(maxbnd))
do L=1,numl
if (lnn(L) < 2 .and. kn(3, L) /= 1) then
numbnd = numbnd+1
if (numbnd > maxbnd) then
maxbnd = MAX(NUMBND, NINT(1.2*maxbnd))
call realloc(ibndlink, maxbnd)
end if
ibndlink(numbnd) = L
end if
enddo
end if
! Put dataset in define mode (possibly again) to add dimensions and variables.
ierr = nf90_redef(inetfile)
if (ierr == nf90_eindefine) jaInDefine = 1 ! Was still in define mode.
if (ierr /= nf90_noerr .and. ierr /= nf90_eindefine) then
call mess(LEVEL_ERROR, 'Could not put header in net file.')
call check_error(ierr)
return
end if
if ( janetcell_ /= 0 ) then
! Determine max nr. of vertices in NetElems (netcells)
nv = 0
do k=1,nump
nv = max(nv, netcell(k)%n)
end do
end if
! Dimensions
ierr = nf90_def_dim(inetfile, 'nNetNode', numk, id_netnodedim)
ierr = nf90_def_dim(inetfile, 'nNetLink', numl, id_netlinkdim)
ierr = nf90_def_dim(inetfile, 'nNetLinkPts', 2, id_netlinkptsdim)
if ( janetbnd_ /= 0 .and. numbnd > 0) then
ierr = nf90_def_dim(inetfile, 'nBndLink', numbnd, id_bndlinkdim)
end if
if (janetcell_ /= 0 .and. nump > 0) then
ierr = nf90_def_dim(inetfile, 'nNetElem', nump, id_netelemdim)
ierr = nf90_def_dim(inetfile, 'nNetElemMaxNode', nv, id_netelemmaxnodedim)
ierr = nf90_def_dim(inetfile, 'nNetLinkContourPts', 4, id_netlinkcontourptsdim) ! Momentum control volume a la Perot: rectangle around xu/yu
end if
! ierr = nf90_def_dim(inetfile, 'nNetElemLink', numl, id_netelemlinkdim)
! ierr = nf90_def_dim(inetfile, 'nNetElemLinkPts', 2, id_netelemlinkptsdim)
ierr = nf90_def_var(inetfile, 'Mesh2D', nf90_int, id_mesh2d)
ierr = nf90_put_att(inetfile, id_mesh2d, 'cf_role', 'mesh_topology')
ierr = nf90_put_att(inetfile, id_mesh2d, 'node_coordinates', 'NetNode_x NetNode_y')
ierr = nf90_put_att(inetfile, id_mesh2d, 'node_dimension', 'nNetNode')
ierr = nf90_put_att(inetfile, id_mesh2d, 'edge_node_connectivity', 'NetLink')
ierr = nf90_put_att(inetfile, id_mesh2d, 'edge_dimension', 'nNetLink')
ierr = nf90_put_att(inetfile, NF90_GLOBAL, 'Conventions', 'UGRID-0.9')
! Coordinates
ierr = nf90_def_var(inetfile, 'NetNode_x', nf90_double, id_netnodedim, id_netnodex)
ierr = nf90_def_var(inetfile, 'NetNode_y', nf90_double, id_netnodedim, id_netnodey)
ierr = unc_addcoordatts(inetfile, id_netnodex, id_netnodey, jsferic)
ierr = nf90_put_att(inetfile, id_netnodex, 'long_name', 'x-coordinate of net nodes')
ierr = nf90_put_att(inetfile, id_netnodey, 'long_name', 'y-coordinate of net nodes')
ierr = unc_addcoordmapping(inetfile, jsferic)
! Add mandatory lon/lat coords too (only if jsferic==0)
ierr = unc_add_lonlat_vars(inetfile, 'NetNode', '', (/ id_netnodedim /), id_netnodelon, id_netnodelat, jsferic)
ierr = nf90_def_var(inetfile, 'NetNode_z', nf90_double, id_netnodedim, id_netnodez)
ierr = nf90_put_att(inetfile, id_netnodez, 'units', 'm')
ierr = nf90_put_att(inetfile, id_netnodez, 'positive', 'up')
ierr = nf90_put_att(inetfile, id_netnodez, 'standard_name', 'sea_floor_depth')
ierr = nf90_put_att(inetfile, id_netnodez, 'long_name', 'Bottom level at net nodes (flow element''s corners)') !! at flow element''s corner / net node
ierr = nf90_put_att(inetfile, id_netnodez, 'coordinates', 'NetNode_x NetNode_y')
ierr = nf90_put_att(inetfile, id_netnodez, 'mesh', 'Mesh2D')
ierr = nf90_put_att(inetfile, id_netnodez, 'location', 'node')
! ierr = unc_add_gridmapping_att(inetfile, (/ id_netnodex, id_netnodey, id_netnodez /), jsferic)
! Netlinks
ierr = nf90_def_var(inetfile, 'NetLink', nf90_int, (/ id_netlinkptsdim, id_netlinkdim /) , id_netlink)
ierr = nf90_put_att(inetfile, id_netlink, 'standard_name', 'netlink')
ierr = nf90_put_att(inetfile, id_netlink, 'long_name', 'link between two netnodes')
ierr = nf90_put_att(inetfile, id_netlink, 'start_index', 1)
ierr = nf90_def_var(inetfile, 'NetLinkType', nf90_int, id_netlinkdim, id_netlinktype)
ierr = nf90_put_att(inetfile, id_netlinktype, 'long_name', 'type of netlink')
! ierr = nf90_put_att(inetfile, id_netlinktype, 'valid_range', (/ 0, 2 /))
ierr = nf90_put_att(inetfile, id_netlinktype, 'flag_values', (/ 0, 1, 2 /))
ierr = nf90_put_att(inetfile, id_netlinktype, 'flag_meanings', 'closed_link_between_2D_nodes link_between_1D_nodes link_between_2D_nodes')
if (janetcell_ /= 0 .and. nump > 0) then
ierr = nf90_put_att(inetfile, id_mesh2d, 'topology_dimension', 2)
ierr = nf90_put_att(inetfile, id_mesh2d, 'face_node_connectivity', 'NetElemNode')
ierr = nf90_put_att(inetfile, id_mesh2d, 'face_dimension', 'nNetElem')
!
! Netcells
! Netcell-to-netnode mapping
ierr = nf90_def_var(inetfile, 'NetElemNode', nf90_int, (/ id_netelemmaxnodedim, id_netelemdim /) , id_netelemnode)
ierr = nf90_put_att(inetfile, id_netelemnode, 'long_name', 'Mapping from net cell to net nodes.')
ierr = nf90_put_att(inetfile, id_netelemnode, 'start_index', 1)
ierr = nf90_def_var(inetfile, 'NetLinkContour_x', nf90_double, (/ id_netlinkcontourptsdim, id_netlinkdim /) , id_netlinkcontourx)
ierr = nf90_def_var(inetfile, 'NetLinkContour_y', nf90_double, (/ id_netlinkcontourptsdim, id_netlinkdim /) , id_netlinkcontoury)
ierr = unc_addcoordatts(inetfile, id_netlinkcontourx, id_netlinkcontoury, jsferic)
ierr = nf90_put_att(inetfile, id_netlinkcontourx, 'long_name' , 'List of x-contour points of momentum control volume surrounding each net/flow link.')
ierr = nf90_put_att(inetfile, id_netlinkcontoury, 'long_name' , 'List of y-contour points of momentum control volume surrounding each net/flow link.')
ierr = nf90_put_att(inetfile, id_netlinkcontourx, '_FillValue', dmiss)
ierr = nf90_put_att(inetfile, id_netlinkcontoury, '_FillValue', dmiss)
ierr = nf90_def_var(inetfile, 'NetLink_xu', nf90_double, (/ id_netlinkdim /) , id_netlinkxu)
ierr = nf90_def_var(inetfile, 'NetLink_yu', nf90_double, (/ id_netlinkdim /) , id_netlinkyu)
ierr = unc_addcoordatts(inetfile, id_netlinkxu, id_netlinkyu, jsferic)
ierr = nf90_put_att(inetfile, id_netlinkxu, 'long_name' , 'Center coordinate of net link (velocity point).')
ierr = nf90_put_att(inetfile, id_netlinkyu, 'long_name' , 'Center coordinate of net link (velocity point).')
! Add grid_mapping reference to all original coordinate and data variables
! ierr = unc_add_gridmapping_att(inetfile, &
! (/ id_netlinkxu, id_netlinkyu, id_netlinkcontourx, id_netlinkcontoury /), jsferic)
else
ierr = nf90_put_att(inetfile, id_mesh2d, 'topology_dimension', 1)
end if
if ( janetbnd_ /= 0 .and. numbnd > 0) then
! List of boundary netlinks
ierr = nf90_def_var(inetfile, 'BndLink', nf90_int, id_bndlinkdim, id_bndlink)
ierr = nf90_put_att(inetfile, id_bndlink, 'long_name', 'Netlinks that compose the net boundary.')
end if
ierr = nf90_enddef(inetfile)
call readyy('Writing net data',.05d0)
! Write the actual data
ierr = nf90_put_var(inetfile, id_netnodex, xk(1:numk))
call readyy('Writing net data',.25d0)
ierr = nf90_put_var(inetfile, id_netnodey, yk(1:numk))
call readyy('Writing net data',.45d0)
ierr = nf90_put_var(inetfile, id_netnodez, zk(1:numk))
call readyy('Writing net data',.65d0)
! ierr = nf90_put_var(inetfile, id_netlink, kn, count=(/ 2, numl /), map=(/ 1, 3 /))
allocate(kn1write(numL))
allocate(kn2write(numL))
do L=1,numL
kn1write(L)=kn(1,L)
kn2write(L)=kn(2,L)
end do
ierr = nf90_put_var(inetfile, id_netlink, kn1write, count=(/ 1, numl /), start=(/1,1/))
ierr = nf90_put_var(inetfile, id_netlink, kn2write, count=(/ 1, numl /), start=(/2,1/))
deallocate(kn1write)
deallocate(kn2write)
call readyy('Writing net data',.85d0)
! AvD: TODO: if jsferic==0, then use proj.4 to convert x/y and write lon/lat for netnodes too.
! An array slice cannot be passed to netcdf C-library (risk of stack overflow), so use copy.
allocate(kn3(numl))
do L = 1,numl
if (kn(3,L) == 1 .or. kn(3,L) == 2 .or. kn(3,L) == 3) then
kn3(L) = kn(3,L) ! TODO: UNST-715: in rare cases, this will incorrectly change 1D net links into 2D net links.
else
kn3(L) = 2 ! e.g. thind dams
end if
end do
ierr = nf90_put_var(inetfile, id_netlinktype, kn3)
deallocate(kn3)
call readyy('Writing net data',1d0)
if ( janetbnd_ /= 0 .and. numbnd > 0) then
! Write boundary links
ierr = nf90_put_var(inetfile, id_bndlink, ibndlink, count = (/ numbnd /))
end if
if ( janetcell_ /= 0 .and. nump > 0) then
! Write net cells (2D elements)
do k=1,nump
nv = netcell(k)%n
ierr = nf90_put_var(inetfile, id_netelemnode, netcell(k)%nod, &
start = (/ 1, k /), count = (/ nv, 1 /))
end do
! call klok(t0)
allocate(xtt(4, numl), ytt(4, numl), xut(numl), yut(numl))
xtt = dmiss
ytt = dmiss
do L=1,numl1d
xut(L) = .5d0*(xk(kn(1,L)) + xk(kn(2,L)))
yut(L) = .5d0*(yk(kn(1,L)) + yk(kn(2,L)))
end do
do L=numl1d+1,numl
xut(L) = .5d0*(xk(kn(1,L)) + xk(kn(2,L)))
yut(L) = .5d0*(yk(kn(1,L)) + yk(kn(2,L)))
xtt(:,L) = 0d0
ytt(:,L) = 0d0
if (LNN(L) >= 1) then
K1 = kn(1,L)
k2 = kn(2,L)
! 'left' half
n1 = LNE(1,L)
x3 = xk(k1)
y3 = yk(k1)
x4 = xk(k2)
y4 = yk(k2)
xzn = xz(n1)
yzn = yz(n1)
! Normal distance from circumcenter to net link:
call dLINEDIS2(xzn,yzn,x3, y3, x4, y4,JA,DIS,XP,YP,rl)
! Note: we're only in net-mode, not yet in flow-mode, so we can NOT assume that net node 3->4 have a 'rightward' flow node orientation 1->2
! Instead, compute outward normal, and swap points 3 and 4 if necessary, such that we locally achieve the familiar k3->k4 + n1->n2 orientation.
! Outward normal vector of net link (cell 1 considered 'inward'):
call normaloutchk(x3, y3, x4, y4, xzw(n1), yzw(n1), xn, yn, ja)
if (ja == 1) then ! normal was flipped, so swap net point 3 and 4 locally, to construct counterclockwise cell hereafter.
kt = k1
k1 = k2
k2 = kt
xp = x3
yp = y3
x3 = x4
y3 = y4
x4 = xp
y4 = yp
end if
xtt(1,L) = x4 - DIS*xn
ytt(1,L) = y4 - DIS*yn
xtt(2,L) = x3 - DIS*xn
ytt(2,L) = y3 - DIS*yn
if (LNN(L) == 2) then
! second half
n1 = LNE(2,L)
xzn = xz(n1)
yzn = yz(n1)
call dLINEDIS2(xzn,yzn,x3, y3, x4, y4,JA,DIS,XP,YP,rl)
xtt(3, L) = x3 + DIS*xn
ytt(3, L) = y3 + DIS*yn
xtt(4, L) = x4 + DIS*xn
ytt(4, L) = y4 + DIS*yn
else
! closed net boundary, no second half cell, just close off with netlink
xtt(3, L) = x3
ytt(3, L) = y3
xtt(4, L) = x4
ytt(4, L) = y4
end if
else
! No surrounding cells: leave missing fill values in file.
xtt(:,L) = dmiss
ytt(:,L) = dmiss
end if
enddo
ierr = nf90_put_var(inetfile, id_netlinkcontourx, xtt, (/ 1, 1 /), (/ 4, numl /) )
ierr = nf90_put_var(inetfile, id_netlinkcontoury, ytt, (/ 1, 1 /), (/ 4, numl /) )
ierr = nf90_put_var(inetfile, id_netlinkxu, xut)
ierr = nf90_put_var(inetfile, id_netlinkyu, yut)
! call klok(t1)
! write(msgbuf,"('writing netlinkcontours at once, elapsed time: ', G15.5, 's.')") t1-t0
! call msg_flush()
end if
! Leave the dataset in the same mode as we got it.
if (jaInDefine == 1) then
ierr = nf90_redef(inetfile)
end if
if (allocated(ibndlink)) deallocate(ibndlink)
if (allocated(kn3)) deallocate(kn3)
if (allocated(xtt)) deallocate(xtt)
if (allocated(ytt)) deallocate(ytt)
if (allocated(xut)) deallocate(xut)
if (allocated(yut)) deallocate(yut)
call readyy('Writing net data',-1d0)
end subroutine unc_write_net_filepointer
!> Reads the net data from a NetCDF file.
!! Processing is done elsewhere.
subroutine unc_read_net(filename, numk_keep, numl_keep, numk_read, numl_read, ierr)
use network_data
use m_sferic
use m_missing
character(len=*), intent(in) :: filename !< Name of NetCDF file.
integer, intent(in) :: numk_keep !< Number of netnodes to keep in existing net.
integer, intent(in) :: numl_keep !< Number of netlinks to keep in existing net.
integer, intent(out) :: numk_read !< Number of new netnodes read from file.
integer, intent(out) :: numl_read !< Number of new netlinks read from file.
integer, intent(out) :: ierr !< Return status (NetCDF operations)
logical :: stringsequalinsens
character(len=32) :: coordsyscheck
integer, dimension(:), allocatable :: kn3read
integer, dimension(:), allocatable :: kn1read
integer, dimension(:), allocatable :: kn2read
integer :: inetfile, &
id_netnodedim, id_netlinkdim, & !< Dimensions
id_netnodex, id_netnodey, id_netnodez, & ! Node variables
id_netlink, id_netlinktype, & !< Link variables
id_crsvar
integer :: ja, ja_oldformatread, L
call readyy('Reading net data',0d0)
ja_oldformatread = 0
call prepare_error('Could not read NetCDF file '''//trim(filename)//'''. Details follow:')
nerr_ = 0
ierr = unc_open(filename, nf90_nowrite, inetfile)
call check_error(ierr, 'file '''//trim(filename)//'''')
if (nerr_ > 0) return
! Get nr of nodes and edges
ierr = nf90_inq_dimid(inetfile, 'nNetNode', id_netnodedim)
call check_error(ierr, 'nNetNode')
ierr = nf90_inq_dimid(inetfile, 'nNetLink', id_netlinkdim)
call check_error(ierr, 'nNetLink')
if (nerr_ > 0) return
ierr = nf90_inquire_dimension(inetfile, id_netnodedim, len=numk_read)
call check_error(ierr, 'node count')
ierr = nf90_inquire_dimension(inetfile, id_netlinkdim, len=numl_read)
call check_error(ierr, 'link count')
if (nerr_ > 0) return
call readyy('Reading net data',.05d0)
ierr = nf90_inq_varid(inetfile, 'projected_coordinate_system', id_crsvar)
if (ierr /= nf90_noerr) then
ierr = nf90_inq_varid(inetfile, 'wgs84', id_crsvar)
end if
if (ierr == nf90_noerr) then
ierr = nf90_inquire_variable(inetfile, id_crsvar, name = crs%varname)
ierr = nf90_get_var(inetfile, id_crsvar, crs%varvalue)
ierr = ug_get_var_attset(inetfile, id_crsvar, crs%attset)
end if
! Prepare net vars for new data and fill with values from file
call increasenetw(numk_keep+numk_read, numl_keep+numl_read)
call readyy('Reading net data',.1d0)
ierr = nf90_inq_varid(inetfile, 'NetNode_x', id_netnodex)
if (ierr /= nf90_noerr) then
ierr = nf90_inq_varid(inetfile, 'x', id_netnodex)
ja_oldformatread = 1
end if
call check_error(ierr, 'x coordinates')
ierr = nf90_inq_varid(inetfile, 'NetNode_y', id_netnodey)
if (ierr /= nf90_noerr) then
ierr = nf90_inq_varid(inetfile, 'y', id_netnodey)
end if
call check_error(ierr, 'y coordinates')
ierr = nf90_inq_varid(inetfile, 'NetLink' , id_netlink )
call check_error(ierr, 'netlinks')
ierr = nf90_inq_varid(inetfile, 'NetLinkType', id_netlinktype)
call check_error(ierr, 'netlinktypes')
if (nerr_ > 0) return
ierr = nf90_get_var(inetfile, id_netnodex, XK(numk_keep+1:numk_keep+numk_read))
call check_error(ierr, 'x values')
call readyy('Reading net data',.3d0)
ierr = nf90_get_var(inetfile, id_netnodey, YK(numk_keep+1:numk_keep+numk_read))
call check_error(ierr, 'y values')
call readyy('Reading net data',.5d0)
ierr = nf90_inq_varid(inetfile, 'NetNode_z', id_netnodez)
if (ierr /= nf90_noerr) then
ierr = nf90_inq_varid(inetfile, 'z', id_netnodez)
end if
if (ierr == nf90_noerr) then
ierr = nf90_get_var(inetfile, id_netnodez, ZK(numk_keep+1:numk_keep+numk_read))
where (ZK(numk_keep+1:numk_keep+numk_read) == NF90_FILL_DOUBLE) ZK(numk_keep+1:numk_keep+numk_read) = dmiss
call check_error(ierr, 'z values')
else
ZK(numk_keep+1:numk_keep+numk_read) = zkUNI
end if
call readyy('Reading net data',.7d0)
coordsyscheck = ' '
ierr = nf90_get_att(inetfile, id_netnodex, 'standard_name', coordsyscheck)
if (stringsequalinsens(coordsyscheck, 'longitude')) then
jsferic = 1
jsfertek = 0 ! TOT NADER ORDER UITGESTELD
else
jsferic = 0
jsfertek = 0
endif
crs%is_spherical = (jsferic == 1)
! An array slice cannot be passed to netcdf C-library (risk of stack overflow), so use placeholder.
allocate(kn3read(numl_read))
allocate(kn2read(numl_read))
allocate(kn1read(numl_read))
! ierr = nf90_get_var(inetfile, id_netlink, kn(:,numl_keep+1:numl_keep+numl_read), count = (/ 2, numl_read /), map=(/ 1, 3 /))
ierr = nf90_get_var(inetfile, id_netlink, kn1read, count = (/ 1,numl_read /))
ierr = nf90_get_var(inetfile, id_netlink, kn2read, count = (/ 1,numl_read /), start= (/ 2, 1 /))
call check_error(ierr, 'netlink nodes')
do L=numL_keep+1,numL_keep+numL_read
kn(1,L) = kn1read(L-numL_keep)
kn(2,L) = kn2read(L-numL_keep)
end do
ierr = nf90_get_var(inetfile, id_netlinktype, kn3read, count = (/ numl_read /))
call check_error(ierr, 'netlink type')
kn(3,numl_keep+1:numl_keep+numl_read) = kn3read
! Repair invalid kn3 codes (e.g. 0, always set to default 2==2D, i.e., don't read in thin dam codes)
do L=numl_keep+1,numl_keep+numl_read
if (kn(3,L) /= 1 .and. kn(3,L) /= 2 .and. kn(3,L) /= 3 ) then
kn(3,L) = 2
end if
end do
deallocate(kn3read)
deallocate(kn1read)
deallocate(kn2read)
call readyy('Reading net data',.95d0)
! Increment netnode numbers in netlink array to ensure unique ids.
KN(1:2,numl_keep+1:numl_keep+numl_read) = KN(1:2,numl_keep+1:numl_keep+numl_read) + numk_keep
call readyy('Reading net data',1d0)
ierr = unc_close(inetfile)
call readyy('Reading net data',-1d0)
if (ja_oldformatread==1 .and. numk_keep == 0) then
CALL CONFRM('Old file format for net was read. Auto-save in new format to '''//trim(filename)//'''? ',JA)
IF (JA == 1) THEN
numk = numk_read
numl = numl_read
call setnodadm(0)
call unc_write_net(filename)
end if
end if
end subroutine unc_read_net
!> Reads a single array variable from a map file, and optionally,
!! if it was a merged map file from parallel run, reshift the read
!! values to the actual own 1:ndxi / 1:lnx numbering.
!!
!! Details for merged-map file as single restart file for parallel models:
!! In the current parallel model, 1:ndxi contains mainly own nodes, but also several ghost nodes.
!! A merged-map file contains only unique nodes, in long blocks per partition, concatenated in one long
!! domain-global array for each quantity. The nf90_var_get will only read the block for the current rank,
!! and that will yield only 'own' nodes, not ghostnodes. All these values need to be 'spread' into the current
!! s1/u1, etc. arrays, with some empty ghost values in between here and there.
!! The calling routine should later call update_ghosts, such that ghost locations are filled as well.
function get_var_and_shift(ncid, varname, targetarr, tmparr, loctype, kmx, locstart, loccount, it_read, jamergedmap, iloc_own) result(ierr)
use dfm_error
integer, intent(in) :: ncid !< Open NetCDF data set
character(len=*) :: varname !< Variable name in file.
double precision, intent(inout) :: targetarr(:) !< Data will be stored in this array.
double precision, intent(inout) :: tmparr(:) !< Temporary work array where file data will be first read before shifting.
integer, intent(in) :: loctype !< Loc type (UNC_LOC_S, etc.)
integer, intent(in) :: kmx !< Number of layers (0 if 2D)
integer, intent(in) :: locstart !< Spatial index in file where to start reading (e.g. kstart)
integer, intent(in) :: loccount !< Spatial count in file to read (e.g. ndxi_own)
integer, intent(in) :: it_read !< Time index in file to read
integer, intent(in) :: jamergedmap !< Whether input is from a merged map file (i.e. needs shifting or not) (1/0)
integer, intent(in) :: iloc_own(:) !< Mapping array from the unique own nodes to the actual ndxi/lnx numbering
integer :: ierr !< Result, DFM_NOERR if successful
integer :: id_var
integer :: i, ib, it, is
ierr = DFM_NOERR
ierr = nf90_inq_varid(ncid, varname, id_var)
if (kmx == 0 .or. loctype == UNC_LOC_S .or. loctype == UNC_LOC_U) then
if (jamergedmap /= 1) then
ierr = nf90_get_var(ncid, id_var, targetarr(1:loccount), start = (/ locstart, it_read/), count = (/ loccount, 1 /))
else
ierr = nf90_get_var(ncid, id_var, tmparr(1:loccount), start = (/ locstart, it_read/), count = (/ loccount, 1 /))
if (ierr /= nf90_noerr) goto 999
do i=1,loccount
targetarr(iloc_own(i)) = tmparr(i)
end do
end if
else
! NOTE: 3D reader reads directly into targetarr because of do-loop
! is historical, not intentional. May be fixed later, because nf90 calls inside do-loop are known to be slow.
do i=1,loccount
if (jamergedmap /= 1) then
is = i
else
is = iloc_own(i)
end if
if (loctype == UNC_LOC_S3D) then
call getkbotktop(is, ib, it) ! TODO: AvD: double check whether this original 3D restart reading was working at all with kb, kt! (no kbotktopmax here?? lbotltopmax)
else if (loctype == UNC_LOC_U3D) then
call getLbotLtopmax(is, ib, it)
end if
! call getLbotLtopmax(LL,Lb,Lt)
ierr = nf90_get_var(ncid, id_var, targetarr(ib:it), start=(/ 1, locstart-1+i, it_read /), count=(/ it-ib+1, 1, 1 /))
end do
end if
999 continue
end function get_var_and_shift
!> Reads the flow data from a map file.
!! Processing is done elsewhere.
!subroutine unc_read_map(filename, numk_keep, numl_keep, numk_read, numl_read, ierr)
subroutine unc_read_map(filename, tim, ierr)
use m_flow
use m_flowtimes
use m_transport, only: NUMCONST, ISALT, ITEMP, ISED1, ITRA1, ITRAN, constituents, itrac2const, const_names
use m_flowexternalforcings, only: numtracers, trnames
use m_flowgeom
use dfm_error
use m_partitioninfo
use m_alloc
use m_timer
character(len=*), intent(in) :: filename !< Name of NetCDF file.
real(kind=hp), intent(in) :: tim !< Desired time (snapshot) to be read from map file.
integer, intent(out) :: ierr !< Return status (NetCDF operations)
character(len=33) :: refdat_map !< Date time string read from map file.
character(len=15) :: tmpstr
real(kind=hp) :: trefdat_map, trefdat_rst, trefdat_mdu
integer :: imapfile, &
id_flowelemdim, &
id_flowlinkdim, &
id_laydim, &
id_wdim, &
id_timedim, &
id_bndsaldim, &
id_bndtemdim, &
id_bndseddim, &
id_time, &
id_timestep, &
id_s1, &
id_s0, &
id_u1, &
id_u0, &
id_q1, &
id_ww1, &
id_sa1, &
id_tem1, &
id_tsalbnd, &
id_zsalbnd, &
id_ttembnd, &
id_ztembnd, &
id_tsedbnd, &
id_zsedbnd
integer :: id_tmp
integer, allocatable :: id_tr1(:), id_bndtradim(:), id_ttrabnd(:), id_ztrabnd(:)
integer :: it_read, nt_read, ndxi_read, lnx_read, mapref, L, tok1, tok2, tok3
integer :: kloc,kk, kb, kt, LL, Lb, Lt, laydim, wdim, itmp, i, iconst
integer :: iostat
logical :: fname_has_date, mdu_has_date
integer :: titleLength, strlen
integer, allocatable :: maptimes(:)
logical :: file_exists
double precision, allocatable :: max_threttim(:)
double precision, allocatable :: tmpvar(:,:)
double precision, allocatable :: tmpvar1(:)
integer, allocatable :: inode_own(:), ilink_own(:) !< Mapping from unique flow nodes/links that are a domain's own to the actual index in 1:ndxi and 1:lnx
integer :: ndxi_own, lnx_own !< number of nodes/links that are a domain's own (if jampi==0, ndxi_own===ndxi, lnx_own===lnx)
integer :: numpart, jamergedmap, jaghost, idmn_ghost
integer :: kstart, lstart
character(len=8)::numformat
character(len=2)::numtrastr
ierr = DFM_GENERICERROR
numformat = '(I2.2)'
! Identify the type of restart file: *_rst.nc or *_map.nc
tok1 = index( filename, '_rst.nc', success )
tok2 = index( filename, '_map.nc', success )
! Convert the refdat from the mdu to seconds w.r.t. an absolute t0
call maketimeinverse(refdat//'000000',trefdat_mdu, iostat)
call readyy('Reading map data',0d0)
call prepare_error('Could not read NetCDF restart file '''//trim(filename)//'''. Details follow:')
nerr_ = 0
inquire(file=filename,exist=file_exists)
if ( .not. file_exists ) then
call mess(LEVEL_FATAL, 'The specified file for the restart has not been found. Check your .mdu file.')
call readyy('Reading map data',-1d0)
return
endif
ierr = unc_open(filename, nf90_nowrite, imapfile)
call check_error(ierr, 'file '''//trim(filename)//'''')
if (nerr_ > 0) goto 999
!-- Sequential model, or parallel? If parallel: merged-map file, or separate partition-map files?
! First check whether the restart NetCDF file contains a fully merged model, or is just a partition.
jamergedmap = 0
if (jampi == 1) then
ierr = nf90_get_att(imapfile, nf90_global, 'NumPartitionsInFile', numpart)
if (ierr == nf90_noerr) then
if (numpart /= numranks) then
write (msgbuf, '(a,i0,a,a,a,i0,a)') 'Mismatch in number of partitions in model (', numranks, ') and in restart file `', trim(filename), ''' (', numpart, ').'
call warn_flush() ! Error handled on call site.
ierr = DFM_WRONGINPUT
goto 999
end if
nerr_ = 0
ierr = nf90_inq_varid(imapfile, 'partitions_face_count', id_tmp)
call check_error(ierr, 'inquiring partitions_face_count')
ierr = nf90_get_var(imapfile, id_tmp, ndxi_read, start=(/ my_rank+1 /))
call check_error(ierr, 'getting partitions_face_count')
ierr = nf90_inq_varid(imapfile, 'partitions_edge_count', id_tmp)
call check_error(ierr, 'inquiring partitions_edge_count')
ierr = nf90_get_var(imapfile, id_tmp, lnx_read, start=(/ my_rank+1 /))
call check_error(ierr, 'getting partitions_edge_count')
ierr = nf90_inq_varid(imapfile, 'partitions_face_start', id_tmp)
call check_error(ierr, 'getting partitions_face_start')
ierr = nf90_get_var(imapfile, id_tmp, kstart, start=(/ my_rank+1 /))
call check_error(ierr, 'getting partitions_face_start')
ierr = nf90_inq_varid(imapfile, 'partitions_edge_start', id_tmp)
call check_error(ierr, 'getting partitions_edge_start')
ierr = nf90_get_var(imapfile, id_tmp, lstart, start=(/ my_rank+1 /))
call check_error(ierr, 'getting partitions_edge_start')
if (nerr_ > 0) then
write (msgbuf, '(a,a,a)') 'Could not read partition start/count info from file `', trim(filename), '''.'
call warn_flush() ! Error handled on call site.
ierr = DFM_WRONGINPUT
goto 999
end if
! Success: we detected that we're dealing with a merged-map rst file.
jamergedmap = 1
else ! No merged-map file: no problem, we'll assume that each rank got its own unique restart file, so just read data from start.
kstart = 1
lstart = 1
end if
else ! Sequential model: just read all data from restart file.
kstart = 1
lstart = 1
end if
if (jamergedmap == 1) then
! NOTE: Only if jampi==1 and rst file was a merged-map file, read only a domain's own flow nodes and links.
ndxi_own = 0
lnx_own = 0
call realloc(inode_own, ndxi, keepExisting=.false.)
call realloc(ilink_own, lnx, keepExisting=.false.)
call realloc(tmpvar1, max(ndxi,lnx), keepExisting=.false.) ! Only necessary for buffered reading from merged map.
do kk=1,ndxi
if (idomain(kk) == my_rank) then
ndxi_own = ndxi_own + 1
inode_own(ndxi_own) = kk
end if
end do
do LL=1,lnx
call link_ghostdata(my_rank,idomain(ln(1,LL)), idomain(ln(2,LL)), jaghost, idmn_ghost, ighostlev(ln(1,LL)), ighostlev(ln(2,LL)))
if ( jaghost /= 1 ) then
lnx_own = lnx_own + 1
ilink_own(lnx_own) = LL
end if
end do
else
! NOTE: intentional: if jampi==1, but rst file is a normal separate rst file
! *per* partition, just read all ndxi/lnx, including ghost nodes/links (as before)
ndxi_own = ndxi
lnx_own = lnx
nerr_ = 0
! Ask file for dimension id of nodes and edges
ierr = nf90_inq_dimid(imapfile, 'nFlowElem', id_flowelemdim) ! Intentional: read a map/rst is *without* boundary nodes. (so don't read nFlowElemWithBnd)
call check_error(ierr, 'nFlowElem')
ierr = nf90_inq_dimid(imapfile, 'nFlowLink', id_flowlinkdim)
call check_error(ierr, 'nFlowLink')
if (nerr_ > 0) goto 999
! Ask for dimensions of nodes and edges, ergo: the number of netnodes and netlinks
ierr = nf90_inquire_dimension(imapfile, id_flowelemdim, len=ndxi_read)
call check_error(ierr, 'elem count')
ierr = nf90_inquire_dimension(imapfile, id_flowlinkdim, len=lnx_read )
call check_error(ierr, 'link count')
if (nerr_ > 0) goto 999
end if
if (ndxi_read /= ndxi_own .or. lnx_read /= lnx_own) then
tmpstr = ''
if (jampi == 1) then
write (tmpstr, '(a,i0,a)') 'my_rank=', my_rank, ': '
end if
write (msgbuf, '(a,i0,a,i0,a)') trim(tmpstr)//'#nodes in file: ', ndxi_read, ', #nodes in model: ', ndxi_own, '.'
call warn_flush()
write (msgbuf, '(a,i0,a,i0,a)') trim(tmpstr)//'#links in file: ', lnx_read, ', #links in model: ', lnx_own, '.'
call warn_flush()
call qnerror('Number of nodes/links read unequal to nodes/links in model',' ',' ')
call readyy('Reading map data',-1d0)
goto 999
end if
call readyy('Reading map data',0.05d0)
! Choose latest timestep
ierr = nf90_inq_dimid (imapfile, 'time' , id_timedim )
call check_error(ierr, 'time')
ierr = nf90_inquire_dimension(imapfile, id_timedim, len=nt_read)
call check_error(ierr, 'time')
if (nt_read.eq.0) then
call qnerror('There do not exist any time data in file ',trim(filename),' ')
call readyy('Reading map data',-1d0)
return
end if
call readyy('Reading map data',0.10d0)
iostat = 0
call maketimeinverse(restartdatetime(1:14),trefdat_rst,iostat) ! result: refdatnew in seconds w.r.t. absolute t0
mdu_has_date = (iostat==0)
! Restart from *YYYYMMDD_HHMMSS_rst.nc
! 15 0 8 5 1^tok1
if (tok1 .gt. 0) then
! Derive time from restart file name (first: check if the string length is larger than 15 characters at all!)
it_read = 1
fname_has_date = .false.
if (tok1 .gt. 15) then
tmpstr = filename(tok1-15:tok1-8)//filename(tok1-6:tok1-1)
call maketimeinverse(tmpstr(1:14), trefdat_rst, iostat)
fname_has_date = (iostat==0)
tok3 = index( filename(tok1-15:tok1-1), '_', success )
fname_has_date = fname_has_date .and. success ! require connecting underscore between date and time
endif
if (.not.fname_has_date) then
if (.not.mdu_has_date) then
call mess(LEVEL_WARN, 'No valid date-time-string in either the MDU-file or *YYYYMMDD_HHMMSS_rst.nc filename: '''//trim(filename)//'''.')
ierr = DFM_WRONGINPUT
goto 999
else
call mess(LEVEL_INFO, 'No valid date-time-string in *YYYYMMDD_HHMMSS_rst.nc filename: '''//trim(filename) &
//'''. MDU RestartDateTime of '//restartdatetime(1:14)//' will be used.')
endif
endif
if (fname_has_date) then
! Check if restart time is within specified simulation time window
if (trefdat_rst .lt. tstart_user .or. trefdat_rst .gt. tstop_user) then
call mess(LEVEL_WARN, 'The specified time for the restart does not match with the simulation time window. Check your .mdu file.')
ierr = DFM_WRONGINPUT
goto 999
end if
! Update flow times
tstart_user = trefdat_rst - trefdat_mdu
time1 = tstart_user
endif
end if ! tok1 > 0
! Restart from *_map.nc
if (tok2 .gt. 0) then
if (.not. mdu_has_date) then
call mess(LEVEL_WARN, 'Missing RestartDateTime in MDU file. Will not read from map file '''//trim(filename)//'''.')
ierr = DFM_WRONGINPUT
goto 999
end if
allocate(maptimes(nt_read),STAT=ierr)
! Read reference time of the underlying computation
! Seconds since yyyy-dd-mm HH:MM:SS
! 123456789012345678901234567890123
ierr = nf90_inq_varid(imapfile, 'time', id_time)
ierr = nf90_inquire_attribute(imapfile, id_time, "units", len = titleLength)
ierr = nf90_get_att(imapfile, id_time, "units", refdat_map)
tmpstr = ' '
tmpstr = refdat_map(15:18)//refdat_map(20:21)//refdat_map(23:24)//refdat_map(26:27)//refdat_map(29:30)//refdat_map(32:33)
call maketimeinverse(trim(tmpstr),trefdat_map,iostat) ! result: refdatold in seconds w.r.t. absolute t0
! Read map times
ierr = nf90_inq_varid(imapfile, 'time', id_time)
ierr = nf90_get_var(imapfile, id_time, maptimes)
call check_error(ierr, 'time')
call readyy('Reading map data',0.20d0)
! Find last map time <= restartdatetime
it_read = 0
do L = nt_read,1,-1
if (maptimes(L) + trefdat_map <= trefdat_rst) then
it_read = L
exit
end if
end do
! If no map time was found <= restartdatetime, issue warning
if (it_read == 0) then
! TODO: warning
! And stop, because no suitable restart time found.
call mess(LEVEL_WARN, 'No suitable restart time found in '''//trim(filename)//''', using '//trim(restartdatetime)//'.')
ierr = DFM_WRONGINPUT
goto 999
end if
if (maptimes(it_read) + trefdat_map /= trefdat_rst) then
call maketime(tmpstr, maptimes(it_read) + trefdat_map)
call mess(LEVEL_WARN, 'Could not find exact restart datetime in '''//trim(filename)// &
''', now selected: '//tmpstr)
! And proceed, because this is still a good restart time.
end if
if (maptimes(it_read) + trefdat_map < trefdat_mdu) then
call maketime(tmpstr, maptimes(it_read) + trefdat_map)
call mess(LEVEL_WARN, 'Selected restart datetime lies *before* model reference date: '// &
tmpstr//' < '//refdat//'.')
end if
! Check if restart time is within specified simulation time window
if (trefdat_rst .lt. tstart_user .or. trefdat_rst .gt. tstop_user) then
call mess(LEVEL_FATAL, 'The specified time for the restart does not match with the simulation time window. Check your .mdu file.')
call readyy('Reading map data',-1d0)
return
end if
! TODO: AvD: do not modify flowtimes variables here, instead use extra intent(out) var and maybe in flow_setstarttime?
tstart_user = maptimes(it_read) + trefdat_map - trefdat_mdu
time1 = tstart_user
end if
! Read size of latest timestep
ierr = nf90_inq_varid(imapfile, 'timestep', id_timestep)
ierr = nf90_get_var(imapfile, id_timestep, dt_init, start = (/ it_read/))
call check_error(ierr, 'timestep')
! Read waterlevels (flow elem)
ierr = get_var_and_shift(imapfile, 's1', s1, tmpvar1, UNC_LOC_S, kmx, kstart, ndxi_own, it_read, jamergedmap, inode_own)
call check_error(ierr, 'waterlevels')
call readyy('Reading map data',0.40d0)
! Read waterlevels old (flow elem)
ierr = get_var_and_shift(imapfile, 's0', s0, tmpvar1, UNC_LOC_S, kmx, kstart, ndxi_own, it_read, jamergedmap, inode_own)
call check_error(ierr, 'waterlevels old')
call readyy('Reading map data',0.45d0)
! Read normal velocities (flow link)
ierr = get_var_and_shift(imapfile, 'unorm', u1, tmpvar1, UNC_LOC_U3D, kmx, Lstart, lnx_own, it_read, jamergedmap, ilink_own)
call check_error(ierr, 'normal velocities')
call readyy('Reading map data',0.60d0)
! Read normal velocities old (flow link)
ierr = get_var_and_shift(imapfile, 'u0', u0, tmpvar1, UNC_LOC_U3D, kmx, Lstart, lnx_own, it_read, jamergedmap, ilink_own)
call check_error(ierr, 'normal velocities old')
call readyy('Reading map data',0.70d0)
! Read discharges (flow link)
ierr = get_var_and_shift(imapfile, 'q1', q1, tmpvar1, UNC_LOC_U3D, kmx, Lstart, lnx_own, it_read, jamergedmap, ilink_own)
call check_error(ierr, 'discharges')
call readyy('Reading map data',0.70d0)
! TODO: AvD: UNST-993: W LOC
if (kmx > 0 .and. jamergedmap /= 1) then
ierr = nf90_inq_varid(imapfile, 'ww1', id_ww1)
if (ierr == nf90_noerr) then ! ww1 is optional: only read it if it was in the rst/map file.
do kk=1,Ndxi
call getkbotktop(kk,kb,kt)
ierr = nf90_get_var(imapfile, id_ww1 , ww1(kb-1:kt),start=(/ 1, kstart-1+kk, it_read /), count=(/ kt-kb+2, 1, 1 /))
end do
call check_error(ierr, 'vertical velocities')
call readyy('Reading map data',0.80d0)
end if
end if
! Read the salinity (flow elem)
if (jasal > 0) then
ierr = get_var_and_shift(imapfile, 'sa1', sa1, tmpvar1, UNC_LOC_S3D, kmx, kstart, ndxi_own, it_read, jamergedmap, inode_own)
call check_error(ierr, 'salinity')
endif
call readyy('Reading map data',0.90d0)
! Read the temperature (flow elem)
if (jatem > 0) then
ierr = get_var_and_shift(imapfile, 'tem1', tem1, tmpvar1, UNC_LOC_S3D, kmx, kstart, ndxi_own, it_read, jamergedmap, inode_own)
call check_error(ierr, 'temperature')
endif
! Read the tracers
if(ITRA1 > 0) then
if(.not.allocated(id_tr1)) then
allocate(id_tr1(ITRAN-ITRA1+1))
endif
if (allocated(tmpvar)) deallocate(tmpvar)
allocate(tmpvar(max(1,kmx), ndxi))
do iconst = ITRA1,ITRAN
i = iconst - ITRA1 + 1
ierr = nf90_inq_varid(imapfile, const_names(iconst), id_tr1(i))
if(kmx > 0) then
ierr = nf90_get_var(imapfile, id_tr1(i), tmpvar(1:kmx,1:ndxi_own), start=(/ 1, kstart, it_read /), count=(/ kmx, ndxi_own, 1 /))
do kk = 1, ndxi_own
if (jamergedmap == 1) then
kloc = inode_own(kk)
else
kloc = kk
end if
call getkbotktop(kloc, kb, kt)
! TODO: UNST-976, incorrect for Z-layers:
constituents(iconst,kb:kt) = tmpvar(1:kt-kb+1,kk)
enddo
else
ierr = nf90_get_var(imapfile, id_tr1(i), tmpvar(1,1:ndxi_own), start = (/ kstart, it_read/), count = (/ndxi,1/))
do kk = 1, ndxi
if (jamergedmap == 1) then
kloc = inode_own(kk)
else
kloc = kk
end if
constituents(iconst, kloc) = tmpvar(1,kk)
end do
endif
call check_error(ierr, const_names(iconst))
enddo
endif
! Read Thatcher-Harleman boundary data
! TODO: AvD: UNST-994: no TH data in merged files yet. Replace the 1 indices below by a prop kstart later.
if(allocated(threttim)) then
if (jamergedmap == 1) then
call mess(LEVEL_WARN, 'read_map: Thatcher-Harlemann data not present in merged map file. Ignoring for now.')
end if
allocate(max_threttim(NUMCONST))
max_threttim = maxval(threttim,dim=2)
if(jasal > 0) then
if(max_threttim(ISALT) > 0d0) then
ierr = nf90_inq_varid(imapfile, 'tsalbnd', id_tsalbnd)
ierr = nf90_get_var(imapfile, id_tsalbnd, thtbnds(1:nbnds), start=(/1, it_read/), count=(/nbnds, 1/))
ierr = nf90_inq_varid(imapfile, 'zsalbnd', id_zsalbnd)
ierr = nf90_get_var(imapfile, id_zsalbnd, thzbnds(1:nbnds*kmxd), start=(/1, it_read/), count=(/nbnds*kmxd, 1/))
endif
endif
if(jatem > 0) then
if(max_threttim(ITEMP) > 0d0) then
ierr = nf90_inq_varid(imapfile, 'ttembnd', id_ttembnd)
ierr = nf90_get_var(imapfile, id_ttembnd, thtbndtm(1:nbndtm), start=(/1, it_read/), count=(/nbndtm, 1/))
ierr = nf90_inq_varid(imapfile, 'ztembnd', id_ztembnd)
ierr = nf90_get_var(imapfile, id_ztembnd, thzbndtm(1:nbndtm*kmxd), start=(/1, it_read/), count=(/nbndtm*kmxd, 1/))
endif
endif
if(jased > 0) then
if(max_threttim(ISED1) > 0d0) then
ierr = nf90_inq_varid(imapfile, 'tsedbnd', id_tsedbnd)
ierr = nf90_get_var(imapfile, id_tsedbnd, thtbndsd(1:nbndsd), start=(/1, it_read/), count=(/nbndsd, 1/))
ierr = nf90_inq_varid(imapfile, 'zsedbnd', id_zsedbnd)
ierr = nf90_get_var(imapfile, id_zsedbnd, thzbndsd(1:nbndsd*kmxd), start=(/1, it_read/), count=(/nbndsd*kmxd, 1/))
endif
endif
if(numtracers > 0) then
if(.not. allocated(id_ttrabnd)) allocate(id_ttrabnd(numtracers))
if(.not. allocated(id_ztrabnd)) allocate(id_ztrabnd(numtracers))
do i=1,numtracers
iconst = itrac2const(i)
if(max_threttim(iconst) > 0d0) then
write(numtrastr,numformat) i
ierr = nf90_inq_varid(imapfile, 'ttrabnd'//numtrastr, id_ttrabnd(i))
ierr = nf90_get_var(imapfile, id_ttrabnd(i), bndtr(i)%tht(1:nbndtr(i)), start=(/1, it_read/), count=(/nbndtr(i), 1/))
ierr = nf90_inq_varid(imapfile, 'ztrabnd'//numtrastr, id_ztrabnd(i))
ierr = nf90_get_var(imapfile, id_ztrabnd(i), bndtr(i)%thz(1:nbndtr(i)*kmxd), start=(/1, it_read/), count=(/nbndtr(i)*kmxd, 1/))
endif
enddo
endif
call check_error(ierr, 'Thatcher-Harleman boundaries')
endif
call readyy('Reading map data',0.95d0)
!-- Synchronisation to other domains, only for merged-map input
if (jampi == 1 .and. jamergedmap == 1) then
!-- S/S3D --
if ( jatimer.eq.1 ) call starttimer(IUPDSALL)
call update_ghosts(ITYPE_SALL, 1, Ndx, s1, ierr)
call update_ghosts(ITYPE_SALL, 1, Ndx, s0, ierr)
if (kmx == 0) then
! 2D
if (jasal > 0) then
call update_ghosts(ITYPE_Sall, 1, Ndx, sa1, ierr)
endif
if (jatem > 0) then
call update_ghosts(ITYPE_Sall, 1, Ndx, tem1, ierr)
end if
if (ITRA1 > 0) then
! NOTE: This update sends too much (sa1/tem), but ok.
call update_ghosts(ITYPE_Sall, NUMCONST, Ndx, constituents, ierr)
end if
else
! 3D
if (jasal > 0) then
call update_ghosts(ITYPE_Sall3D, 1, Ndkx, sa1, ierr)
endif
if (jatem > 0) then
call update_ghosts(ITYPE_Sall3D, 1, Ndkx, tem1, ierr)
endif
if (ITRA1 > 0) then
! NOTE: This update sends too much (sa1/tem), but ok.
call update_ghosts(ITYPE_Sall3D, NUMCONST, Ndkx, constituents, ierr)
end if
end if
if ( jatimer.eq.1 ) call stoptimer(IUPDSALL)
!-- U/U3D --
if ( jatimer.eq.1 ) call starttimer(IUPDU)
if (kmx == 0) then
! 2D
call update_ghosts(ITYPE_U, 1, Lnx, u1, ierr)
call update_ghosts(ITYPE_U, 1, Lnx, u0, ierr)
call update_ghosts(ITYPE_U, 1, Lnx, q1, ierr)
else
! 3D
call update_ghosts(ITYPE_U3D, 1, Lnkx, u1, ierr)
call update_ghosts(ITYPE_U3D, 1, Lnkx, u0, ierr)
call update_ghosts(ITYPE_U3D, 1, Lnkx, q1, ierr)
end if
if ( jatimer.eq.1 ) call stoptimer(IUPDU)
if (ierr /= 0) then
ierr = DFM_MODELNOTINITIALIZED
goto 999
end if
endif ! jampi .and. jamapmerged
call readyy('Reading map data',1.00d0)
! TODO: AvD: sediment concentrations are not at all in restart files yet
ierr = DFM_NOERR
! Close the netcdf-file _map.nc
999 continue
itmp = unc_close(imapfile)
call readyy('Reading map data',-1d0)
if(allocated(maptimes)) deallocate(maptimes)
if(allocated(max_threttim)) deallocate(max_threttim)
if(allocated(id_ttrabnd)) deallocate(id_ttrabnd)
if(allocated(id_ztrabnd)) deallocate(id_ztrabnd)
if(allocated(tmpvar)) deallocate(tmpvar)
end subroutine unc_read_map
!> Writes the unstructured flow geometry to a netCDF file.
!! If file exists, it will be overwritten.
subroutine unc_write_flowgeom(filename)
character(len=*), intent(in) :: filename
integer :: igeomfile, ierr
ierr = unc_create(filename, 0, igeomfile)
if (ierr /= nf90_noerr) then
call mess(LEVEL_ERROR, 'Could not create flow geometry file '''//trim(filename)//'''.')
call check_error(ierr)
return
end if
call unc_write_flowgeom_filepointer(igeomfile) ! UNC_CONV_CFOLD
ierr = unc_close(igeomfile)
end subroutine unc_write_flowgeom
!> Writes the unstructured network and flow geometry to a netCDF file.
!! If file exists, it will be overwritten.
subroutine unc_write_net_flowgeom(filename)
character(len=*), intent(in) :: filename
integer :: igeomfile, ierr
ierr = unc_create(filename, 0, igeomfile)
if (ierr /= nf90_noerr) then
call mess(LEVEL_ERROR, 'Could not create flow geometry file '''//trim(filename)//'''.')
call check_error(ierr)
return
end if
call unc_write_net_filepointer(igeomfile) ! Write standard net data as well
call unc_write_flowgeom_filepointer(igeomfile) ! UNC_CONV_CFOLD
ierr = unc_close(igeomfile)
end subroutine unc_write_net_flowgeom
!> Writes the unstructured flow geometry to an already opened netCDF dataset.
subroutine unc_write_flowgeom_filepointer_ugrid(mapids, jabndnd)
use m_flowgeom
use network_data
use m_sferic
use m_missing
use netcdf
use m_partitioninfo
use m_flow, only: kmx
use m_alloc
type(t_unc_mapids), intent(inout) :: mapids !< Set of file and variable ids for this map-type file.
integer, optional, intent(in) :: jabndnd !< Whether to include boundary nodes (1) or not (0). Default: no.
integer :: jabndnd_
integer :: nn
integer, allocatable :: edge_nodes(:,:), face_nodes(:,:), edge_type(:)
integer :: id_edgetype(3)
! type(t_crs) :: pj
integer :: ierr
integer :: i, numContPts, numNodes, n, ndxndxi, ndx1d, lnx2d, numl2d, L, Lf
integer :: jaInDefine
double precision :: xx, yy
double precision, dimension(:), allocatable :: zz
double precision, allocatable :: x1dn(:), y1dn(:), xue(:), yue(:)
jaInDefine = 0
if (ndxi <= 0) then
call mess(LEVEL_WARN, 'No flow cells in model, will not write flow geometry.')
return
end if
if (present(jabndnd)) then
jabndnd_ = jabndnd
else
jabndnd_ = 0
endif
! Include boundary cells in output (ndx) or not (ndxi)
if (jabndnd_ == 1) then
ndxndxi = ndx
else
ndxndxi = ndxi
end if
! Put dataset in define mode (possibly again) to add dimensions and variables.
ierr = nf90_redef(mapids%ncid)
if (ierr == nf90_eindefine) jaInDefine = 1 ! Was still in define mode.
if (ierr /= nf90_noerr .and. ierr /= nf90_eindefine) then
call mess(LEVEL_ERROR, 'Could not put header in flow geometry file.')
call check_error(ierr)
return
end if
crs%is_spherical = (jsferic == 1)
! 1D flow grid geometry
ndx1d = ndxi - ndx2d
if (ndx1d > 0) then
call realloc(edge_nodes, (/ 2,lnx1d /), fill = -999) ! TODO: AvD: numl1d instead?
call realloc(x1dn, ndx1d)
call realloc(y1dn, ndx1d)
! First store pure 1D nodes (in flow node order), start counting at 1.
do n=1,ndx1d
x1dn(n) = xz(ndx2d+n)
y1dn(n) = yz(ndx2d+n)
end do
! All 1D flow links + add special nodes (from 1D2D)
do L=1,lnx1d
if (kcu(L) == 1) then ! Standard 1D link
edge_nodes(1:2,L) = ln(1:2,L)
else if (kcu(L) == 4) then ! 1D2D link
! 1D2D link, find the 2D flow node and store its cell center as '1D' node coordinates
ndx1d = ndx1d+1
call realloc(x1dn, ndx1d) ! TODO: AvD: introduce realloc growby
call realloc(y1dn, ndx1d)
if (ln(1,L) <= ndx2d) then ! First point of 1D link is 2D cell
edge_nodes(1,L) = ndx1d
edge_nodes(2,L) = ln(2,L)
x1dn(ndx1d) = xz(ln(1,L)) ! Use 2D circumcenter point for now (alternative: net node coordinate)
y1dn(ndx1d) = yz(ln(1,L))
else ! Second point of 1D link is 2D cell
edge_nodes(1,L) = ln(1,L)
edge_nodes(2,L) = ndx1d
x1dn(ndx1d) = xz(ln(2,L))
y1dn(ndx1d) = yz(ln(2,L))
end if
else
continue ! For now, no handling of other kce codes (3/-1/...)
end if
end do
ierr = ug_write_mesh_arrays(mapids%ncid, mapids%meshids1d, 'mesh1d', 1, UG_LOC_NODE + UG_LOC_EDGE, ndx1d, lnx1d, 0, &
edge_nodes, face_nodes, x1dn, y1dn, xu(1:lnx1d), yu(1:lnx1d), xz(1:1), yz(1:1), &
crs, -999, dmiss)
deallocate(x1dn)
deallocate(y1dn)
deallocate(edge_nodes)
end if ! 1D flow grid geometry
if (ndx2d > 0) then ! 2D flow geometry
numl2d = numl-numl1d
lnx2d = lnx-lnx1d ! todo: AvD: includes bnd links now
call realloc(edge_nodes, (/ 2, numl2d /), fill = -999, keepExisting = .false.)
call realloc(edge_type, numl2d, fill = -999, keepExisting = .false.)
call realloc(xue, numl2d, fill = dmiss, keepExisting = .false.)
call realloc(yue, numl2d, fill = dmiss, keepExisting = .false.)
! First write al edges that are a 2D flow link
do i=1,lnx2d
Lf = lnx1d+i
edge_nodes(1:2,i) = lncn(1:2,Lf)
if (Lf <= lnxi) then
edge_type(i) = UNC_EDGETYPE_INTERNAL
else
edge_type(i) = UNC_EDGETYPE_BND
end if
xue(i) = xu(Lf)
yue(i) = yu(Lf)
end do
! Next write all remaining net links, which are closed.
i = lnx2d
do L=NUML1D+1,NUML
Lf = lne2ln(L)
if (Lf <= 0) then
i = i+1
edge_nodes(1:2,i) = KN(1:2,L)
if (lnn(L) < 2) then
edge_type(i) = UNC_EDGETYPE_BND_CLOSED
else if (kn(3,L) == 0) then
edge_type(i) = UNC_EDGETYPE_INTERNAL_CLOSED
end if
xue(i) = .5d0*(xk(kn(1,L)) + xk(kn(2,L)))
yue(i) = .5d0*(yk(kn(1,L)) + yk(kn(2,L)))
end if
end do
! Determine max nr of vertices and contour points
numNodes = 0
numContPts = 0 ! TODO: AvD: contour points equals nodes here, remove, OR move to 1D
do i=1,ndxndxi
numNodes = max(numNodes, size(nd(i)%nod))
numContPts = max(numContPts, size(nd(i)%x))
end do
! Note: AvD: for cell corners, we write *all* net nodes (numk). This may also be '1D' nodes, but that is not problematic: they will simply not be referenced in face_nodes/edge_nodes.
! Note: AvD: numk may be larger than nr of cell corners. Will cause problems when writing output data on corners (mismatch in dimensions), not crucial now.
call realloc(face_nodes, (/ numNodes, ndx2d /), fill = -999)
do n=1,ndx2d
nn = size(nd(n)%nod)
face_nodes(1:nn,n) = nd(n)%nod
end do
! TODO: AvD: lnx1d+1:lnx includes open bnd links, which may *also* be 1D boundaries (don't want that in mesh2d)
ierr = ug_write_mesh_arrays(mapids%ncid, mapids%meshids2d, 'mesh2d', 2, UG_LOC_EDGE + UG_LOC_FACE, numk, numl2d, ndx2d, &
edge_nodes, face_nodes, xk, yk, xue, yue, xz(1:ndx2d), yz(1:ndx2d), &
crs, -999, dmiss)
deallocate(edge_nodes)
deallocate(face_nodes)
end if
ierr = unc_def_var_map(mapids, mapids%id_flowelemba(:), nf90_double, UNC_LOC_S, 'FlowElem_ba', 'cell_area', '', 'm2', 0)
ierr = unc_def_var_map(mapids, mapids%id_flowelembl(:), nf90_double, UNC_LOC_S, 'FlowElem_bl', 'altitude', 'Bottom level at flow element''s circumcenter.', 'm2', 0)
! ierr = nf90_put_att(igeomfile, id_flowelembl, 'positive', 'up') ! Not allowed for non-coordinate variables
! Prepare edge type variable (edge-flowlink relation)
id_edgetype = 0
ierr = unc_def_var_map(mapids, id_edgetype(:), nf90_int, UNC_LOC_U, 'edge_type', '', 'Edge type (relation between edge and flow geometry).', '', 0)
do i=1,3
if (id_edgetype(i) /= 0) then
ierr = nf90_put_att(mapids%ncid, id_edgetype(i), 'flag_values', (/ UNC_EDGETYPE_INTERNAL_CLOSED, UNC_EDGETYPE_INTERNAL, UNC_EDGETYPE_BND, UNC_EDGETYPE_BND_CLOSED /))
ierr = nf90_put_att(mapids%ncid, id_edgetype(i), 'flag_meanings', 'internal_closed internal boundary boundary_closed')
end if
end do
ierr = nf90_enddef(mapids%ncid)
! -- Start data writing (time-independent data) ------------
! Flow cell cc coordinates (only 1D + internal 2D)
if (ndx1d > 0) then
ierr = nf90_put_var(mapids%ncid, mapids%id_flowelemba(1), ba(ndx2d+1:ndx)) ! TODO: AvD: handle 1D/2D boundaries
ierr = nf90_put_var(mapids%ncid, mapids%id_flowelembl(1), bl(ndx2d+1:ndx)) ! TODO: AvD: handle 1D/2D boundaries
end if
if (ndx2d > 0) then
ierr = nf90_put_var(mapids%ncid, mapids%id_flowelemba(2), ba(1:ndx2d)) ! TODO: AvD: handle 1D/2D boundaries
ierr = nf90_put_var(mapids%ncid, mapids%id_flowelembl(2), bl(1:ndx2d)) ! TODO: AvD: handle 1D/2D boundaries
end if
if (numl2d > 0) then
ierr = nf90_put_var(mapids%ncid, id_edgetype(2), edge_type(1:numl2d))
end if
if (allocated(edge_type)) deallocate(edge_type)
! TODO: AvD: also edge_type for 1D
! TODO: AvD:
! * in WAVE: handle the obsolete 'nFlowElemWithBnd'/'nFlowElem' difference
! * for WAVE: add FlowElem_zcc back in com file.
! * for parallel: add 'FlowElemDomain', 'FlowLinkDomain', 'FlowElemGlobalNr'
! Leave the dataset in the same mode as we got it.
if (jaInDefine == 1) then
ierr = nf90_redef(mapids%ncid)
end if
!call readyy('Writing flow geometry data',-1d0)
end subroutine unc_write_flowgeom_filepointer_ugrid
!> Writes the unstructured flow geometry to an already opened netCDF dataset.
subroutine unc_write_flowgeom_filepointer(igeomfile, jabndnd)
use m_flowgeom
use m_sferic
use m_missing
use netcdf
use m_partitioninfo
use m_flow, only: kmx
integer, intent(in) :: igeomfile
integer, optional, intent(in) :: jabndnd !< Whether to include boundary nodes (1) or not (0). Default: no.
integer :: jabndnd_
integer, allocatable :: kn3(:), ibndlink(:)
integer :: ierr
integer :: &
id_laydim, &
id_flowelemdim, id_flowelemmaxnodedim, id_flowelemcontourptsdim, &
id_flowlinkdim, id_flowlinkptsdim, id_erolaydim, &
id_flowelemxcc, id_flowelemycc, id_flowelemzcc, &
id_flowelemloncc, id_flowelemlatcc, &
id_flowelemcontourx, id_flowelemcontoury, id_flowelemba, &
id_flowelemcontourlon, id_flowelemcontourlat, &
id_flowelembl, &
id_flowlink, id_flowlinktype, &
id_flowlinkxu, id_flowlinkyu, &
id_flowlinklonu, id_flowlinklatu, &
id_flowelemdomain, id_flowlinkdomain, &
id_flowelemglobalnr
integer :: i, numContPts, numNodes, n, ndxndxi, nn
integer :: jaInDefine
integer :: jaghost, idmn
double precision :: xx, yy
double precision, dimension(:), allocatable :: zz
double precision, dimension(:,:), allocatable :: work2
jaInDefine = 0
if (ndxi <= 0) then
call mess(LEVEL_WARN, 'No flow cells in model, will not write flow geometry.')
return
end if
if (present(jabndnd)) then
jabndnd_ = jabndnd
else
jabndnd_ = 0
endif
! Include boundary cells in output (ndx) or not (ndxi)
if (jabndnd_ == 1) then
ndxndxi = ndx
else
ndxndxi = ndxi
end if
! Determine max nr of vertices and contour points
numNodes = 0
numContPts = 0
do i=1,ndxndxi
numNodes = max(numNodes, size(nd(i)%nod))
numContPts = max(numContPts, size(nd(i)%x))
end do
if( allocated(work2) ) deallocate( work2 )
allocate( work2(numContPts,ndxndxi) ) ; work2 = dmiss
! Put dataset in define mode (possibly again) to add dimensions and variables.
ierr = nf90_redef(igeomfile)
if (ierr == nf90_eindefine) jaInDefine = 1 ! Was still in define mode.
if (ierr /= nf90_noerr .and. ierr /= nf90_eindefine) then
call mess(LEVEL_ERROR, 'Could not put header in flow geometry file.')
call check_error(ierr)
return
end if
if (jabndnd_ == 1) then
ierr = nf90_def_dim(igeomfile, 'nFlowElemWithBnd', ndxndxi, id_flowelemdim) ! Different name to easily show boundary nodes are included, rest of code below is generic ndx/ndxi.
else
ierr = nf90_def_dim(igeomfile, 'nFlowElem', ndxndxi, id_flowelemdim)
end if
if (numNodes > 0) then
ierr = nf90_def_dim(igeomfile, 'nFlowElemMaxNode', numNodes, id_flowelemmaxnodedim)
end if
ierr = nf90_def_dim(igeomfile, 'nFlowElemContourPts', numContPts, id_flowelemcontourptsdim)
if (lnx > 0) then
ierr = nf90_def_dim(igeomfile, 'nFlowLink', lnx , id_flowlinkdim)
ierr = nf90_def_dim(igeomfile, 'nFlowLinkPts', 2, id_flowlinkptsdim)
end if
! Flow cells
ierr = nf90_def_var(igeomfile, 'FlowElem_xcc', nf90_double, id_flowelemdim, id_flowelemxcc)
ierr = nf90_def_var(igeomfile, 'FlowElem_ycc', nf90_double, id_flowelemdim, id_flowelemycc)
ierr = nf90_def_var(igeomfile, 'FlowElem_zcc', nf90_double, id_flowelemdim, id_flowelemzcc)
ierr = nf90_def_var(igeomfile, 'FlowElem_bac', nf90_double, id_flowelemdim, id_flowelemba)
ierr = unc_addcoordatts(igeomfile, id_flowelemxcc, id_flowelemycc, jsferic)
ierr = nf90_put_att(igeomfile, id_flowelemxcc, 'long_name' , 'Flow element circumcenter x')
ierr = nf90_put_att(igeomfile, id_flowelemycc, 'long_name' , 'Flow element circumcenter y')
ierr = nf90_put_att(igeomfile, id_flowelemzcc, 'long_name' , 'Flow element average bottom level (average of all corners).')
ierr = nf90_put_att(igeomfile, id_flowelemzcc, 'positive ' , 'down') ! For WAVE
ierr = nf90_put_att(igeomfile, id_flowelemxcc, 'bounds' , 'FlowElemContour_x')
ierr = nf90_put_att(igeomfile, id_flowelemycc, 'bounds' , 'FlowElemContour_y')
ierr = nf90_put_att(igeomfile, id_flowelemba, 'long_name' , 'Flow element area')
ierr = nf90_put_att(igeomfile, id_flowelemba, 'units', 'm2')
ierr = nf90_put_att(igeomfile, id_flowelemba, 'standard_name', 'cell_area')
! Flow elem contours (plot help)
! Todo: generalize x/y's to 2/3-D coords everywhere else [Avd]
ierr = nf90_def_var(igeomfile, 'FlowElemContour_x', nf90_double, (/ id_flowelemcontourptsdim, id_flowelemdim /), id_flowelemcontourx)
ierr = nf90_def_var(igeomfile, 'FlowElemContour_y', nf90_double, (/ id_flowelemcontourptsdim, id_flowelemdim /), id_flowelemcontoury)
ierr = unc_addcoordatts(igeomfile, id_flowelemcontourx, id_flowelemcontoury, jsferic)
ierr = nf90_put_att(igeomfile, id_flowelemcontourx, 'long_name', 'List of x-points forming flow element')
ierr = nf90_put_att(igeomfile, id_flowelemcontoury, 'long_name', 'List of y-points forming flow element')
ierr = nf90_put_att(igeomfile, id_flowelemcontourx, '_FillValue', dmiss)
ierr = nf90_put_att(igeomfile, id_flowelemcontoury, '_FillValue', dmiss)
! Flow elems bottom levels
ierr = nf90_def_var(igeomfile, 'FlowElem_bl', nf90_double, id_flowelemdim, id_flowelembl)
ierr = nf90_put_att(igeomfile, id_flowelembl, 'units', 'm')
ierr = nf90_put_att(igeomfile, id_flowelembl, 'positive', 'up')
ierr = nf90_put_att(igeomfile, id_flowelembl, 'standard_name', 'sea_floor_depth')
ierr = nf90_put_att(igeomfile, id_flowelembl, 'long_name', 'Bottom level at flow element''s circumcenter.')
if (lnx > 0) then
ierr = nf90_def_var(igeomfile, 'FlowLink', nf90_int, (/ id_flowlinkptsdim, id_flowlinkdim /) , id_flowlink)
ierr = nf90_put_att(igeomfile, id_flowlink , 'long_name' , 'link/interface between two flow elements')
ierr = nf90_def_var(igeomfile, 'FlowLinkType', nf90_int, (/ id_flowlinkdim /) , id_flowlinktype)
ierr = nf90_put_att(igeomfile, id_flowlinktype, 'long_name' , 'type of flowlink')
ierr = nf90_put_att(igeomfile, id_flowlinktype, 'valid_range' , (/ 1, 2 /))
ierr = nf90_put_att(igeomfile, id_flowlinktype, 'flag_values' , (/ 1, 2 /))
ierr = nf90_put_att(igeomfile, id_flowlinktype, 'flag_meanings', 'link_between_1D_flow_elements link_between_2D_flow_elements')
ierr = nf90_def_var(igeomfile, 'FlowLink_xu', nf90_double, (/ id_flowlinkdim /) , id_flowlinkxu)
ierr = nf90_def_var(igeomfile, 'FlowLink_yu', nf90_double, (/ id_flowlinkdim /) , id_flowlinkyu)
ierr = unc_addcoordatts(igeomfile, id_flowlinkxu, id_flowlinkyu, jsferic)
ierr = nf90_put_att(igeomfile, id_flowlinkxu, 'long_name' , 'Center coordinate of net link (velocity point).')
ierr = nf90_put_att(igeomfile, id_flowlinkyu, 'long_name' , 'Center coordinate of net link (velocity point).')
end if
! Coordinate/grid mapping
ierr = unc_addcoordmapping(igeomfile, jsferic)
! Add mandatory lon/lat coords too (only if jsferic==0)
! BJ: following two lines commented out since QuickPlot will select longitude and latitude based on preference; however, these arrays don't actually contain data yet!
!ierr = unc_add_lonlat_vars(igeomfile, 'FlowElem', 'cc', (/ id_flowelemdim /), id_flowelemloncc, id_flowelemlatcc, jsferic)
!ierr = unc_add_lonlat_vars(igeomfile, 'FlowElemContour', '' , (/ id_flowelemcontourptsdim, id_flowelemdim /), id_flowelemcontourlon, id_flowelemcontourlat, jsferic)
! Add grid_mapping reference to all original coordinate and data variables
ierr = unc_add_gridmapping_att(igeomfile, &
(/ id_flowelembl /), jsferic)
! (/ id_flowelemxcc, id_flowelemycc, id_flowelemcontourx, id_flowelemcontoury, &
if (lnx > 0) then
ierr = unc_add_lonlat_vars(igeomfile, 'FlowLink', 'u' , (/ id_flowlinkdim /), id_flowlinklonu, id_flowlinklatu, jsferic)
! Add grid_mapping reference to all original coordinate and data variables
!ierr = unc_add_gridmapping_att(igeomfile, &
! (/ id_flowlinkxu, id_flowlinkyu /), jsferic)
end if
! domain numbers and global node/link numbers
if ( jampi.eq.1 ) then
ierr = nf90_def_var(igeomfile, 'FlowElemDomain', nf90_short, id_flowelemdim, id_flowelemdomain)
ierr = nf90_put_att(igeomfile, id_flowelemdomain, 'long_name' , 'Domain number of flow element')
ierr = nf90_def_var(igeomfile, 'FlowLinkDomain', nf90_short, id_flowlinkdim, id_flowlinkdomain)
ierr = nf90_put_att(igeomfile, id_flowlinkdomain, 'long_name' , 'Domain number of flow link')
ierr = nf90_def_var(igeomfile, 'FlowElemGlobalNr', nf90_int, id_flowelemdim, id_flowelemglobalnr)
ierr = nf90_put_att(igeomfile, id_flowelemglobalnr, 'long_name' , 'Global flow element numbering')
end if
ierr = nf90_enddef(igeomfile)
! End of writing time-independent flow net data.
! call readyy('Writing flow geometry data',.05d0)
! -- Start data writing (time-independent data) ------------
! Flow cell cc coordinates (only 1D + internal 2D)
ierr = nf90_put_var(igeomfile, id_flowelemxcc, xz(1:ndxndxi))
ierr = nf90_put_var(igeomfile, id_flowelemycc, yz(1:ndxndxi))
ierr = nf90_put_var(igeomfile, id_flowelemba, ba(1:ndxndxi))
allocate (zz(ndxndxi), stat=ierr)
!
! DFlowFM: z-positive is upwards
! WAVE: z-positive is downwards
! Don't change DMISS
do n = 1,ndxndxi
if (bl(n).eq.DMISS) then
zz(n) = bl(n)
else
zz(n) = -bl(n)
end if
end do
ierr = nf90_put_var(igeomfile, id_flowelemzcc, zz(1:ndxndxi))
if (allocated(zz)) deallocate (zz, stat=ierr)
!call readyy('Writing flow geometry data',.15d0)
! Flow cell contours
!!!do i=1,ndxndxi
!!! numContPts = size(nd(i)%x)
!!! ierr = nf90_put_var(igeomfile, id_flowelemcontourx, nd(i)%x, (/ 1, i /), (/ numContPts, 1 /) )
!!! ierr = nf90_put_var(igeomfile, id_flowelemcontoury, nd(i)%y, (/ 1, i /), (/ numContPts, 1 /) )
!!!enddo
!call readyy('Writing flow geometry data',.45d0)
do i=1,ndxndxi
nn = size(nd(i)%x)
do n = 1,nn
work2(n,i)=nd(i)%x(n)
enddo
enddo
ierr = nf90_put_var(igeomfile, id_flowelemcontourx, work2(1:numContPts,1:ndxndxi), (/ 1, 1 /), (/ numContPts, ndxndxi /) )
do i=1,ndxndxi
nn = size(nd(i)%x)
do n = 1,nn
work2(n,i)=nd(i)%y(n)
enddo
enddo
ierr = nf90_put_var(igeomfile, id_flowelemcontoury, work2(1:numContPts,1:ndxndxi), (/ 1, 1 /), (/ numContPts, ndxndxi /) )
deallocate( work2 )
! flowcells bottom levels
ierr = nf90_put_var(igeomfile, id_flowelembl, bl(1:ndxndxi))
!call readyy('Writing flow geometry data',.55d0)
! Flow links
ierr = nf90_put_var(igeomfile, id_flowlink, ln(:,1:lnx))
do i=1,lnx1D
ierr = nf90_put_var(igeomfile, id_flowlinktype, (/ 1 /), start = (/ i /))
end do
do i=lnx1D+1,lnx
ierr = nf90_put_var(igeomfile, id_flowlinktype, (/ 2 /), start = (/ i /))
end do
!call readyy('Writing flow geometry data',.90d0)
if (lnx > 0) then
! Flow links velocity points
ierr = nf90_put_var(igeomfile, id_flowlinkxu, xu(1:lnx))
ierr = nf90_put_var(igeomfile, id_flowlinkyu, yu(1:lnx))
end if
! domain numbers
if ( jampi.eq.1 ) then
! flow cell domain numbers
ierr = nf90_put_var(igeomfile, id_flowelemdomain, idomain(1:ndxi) ) ! TODO: ndxndxi
! flow link domain numbers
do i=1,Lnx
! determine if flow link is a ghost link and get domain number and ghost level of link
call link_ghostdata(my_rank, idomain(ln(1,i)), idomain(ln(2,i)), jaghost, idmn)
ierr = nf90_put_var(igeomfile, id_flowlinkdomain, (/ idmn /), start=(/ i /) ) ! corresponds with partition_get_ghosts
end do
ierr = nf90_put_var(igeomfile, id_flowelemglobalnr, iglobal_s(1:ndxi)) ! TODO: ndxndxi
end if
!call readyy('Writing flow geometry data',1d0)
! Leave the dataset in the same mode as we got it.
if (jaInDefine == 1) then
ierr = nf90_redef(igeomfile)
end if
!call readyy('Writing flow geometry data',-1d0)
end subroutine unc_write_flowgeom_filepointer
! -- PRIVATE ROUTINES ---------------------------
!> Resets current error status and sets informative message for subsequent
!! errors. Generally called at start of any routine that wants to use
!! routine check_error. The informative message is only shown/used when
!! later check_error's indeed detect an error.
subroutine prepare_error(firstline)
character(len=*), intent(in) :: firstline !< Informative message for screen/log.
err_firstline_ = firstline
err_firsttime_ = .true.
nerr_ = 0
end subroutine prepare_error
subroutine check_error(ierr, info)
integer, intent(in) :: ierr
character(len=*), intent(in), optional :: info
character(len=255) :: infostring
if (ierr /= nf90_noerr) then
nerr_ = nerr_ + 1
! Optional informative message (appended to NetCDF error string)
if (present(info)) then
infostring = '('//trim(info)//')'
else
infostring = ' '
endif
! First error line
if (err_firsttime_) then
call mess(LEVEL_WARN, err_firstline_)
err_firsttime_ = .false.
endif
! Actual error line
call mess(LEVEL_WARN, 'NetCDF error: ', nf90_strerror(ierr), trim(infostring))
endif
end subroutine check_error
!function unc_is_netfile(filename)
! character(len=*), intent(in) :: filename
! logical :: unc_is_netfile
!
! unc_is_netfile = .true.
!
!end function unc_is_netfile
!
! ierr = nf90_def_dim(inetfile, 'nElem', nump, id_elemdim)
! ierr = nf90_def_dim(inetfile, 'nNode', numk, id_nodedim)
! ierr = nf90_def_dim(inetfile, 'nConnect', 7, id_connectdim)
!! ierr = nf90_def_dim(inetfile, 'id_len', 40, id_strlendim)
!! ierr = nf90_def_dim(inetfile, 'time', nf90_unlimited, id_timedim)
!
! ierr = nf90_def_var(inetfile, 'grid1', nf90_int, (/ id_connectdim, id_elemdim /), id_grid1topo)
! ierr = nf90_put_att(inetfile, id_grid1topo, 'standard_name', 'net_topology')
! ierr = nf90_put_att(inetfile, id_grid1topo, 'spatial_dimension', 2)
! ierr = nf90_put_att(inetfile, id_grid1topo, 'topological_dimension', 2)
! ierr = nf90_put_att(inetfile, id_grid1topo, 'cell_type', 'nc_mixed')
! ierr = nf90_put_att(inetfile, id_grid1topo, 'index_start', 1)
! ierr = nf90_put_att(inetfile, id_grid1topo, 'x_nodal_coordinate', 'x')
! ierr = nf90_put_att(inetfile, id_grid1topo, 'y_nodal_coordinate', 'y')
!
! ierr = nf90_def_var(inetfile, 'x', nf90_double, id_nodedim, id_nodex)
! ierr = nf90_put_att(inetfile, id_nodex, 'units', 'm')
! ierr = nf90_put_att(inetfile, id_nodex, 'long_name', 'nodal x-coordinate')
! ierr = nf90_def_var(inetfile, 'y', nf90_double, id_nodedim, id_nodey)
! ierr = nf90_put_att(inetfile, id_nodey, 'units', 'm')
! ierr = nf90_put_att(inetfile, id_nodey, 'long_name', 'nodal y-coordinate')
!
! ierr = nf90_enddef(inetfile)
!
! ierr = nf90_put_var(inetfile, id_nodex, xk(1:numk))
! ierr = nf90_put_var(inetfile, id_nodey, yk(1:numk))
! do i=1,nump
! ierr = nf90_put_var(inetfile, id_grid1topo, (/ netcell(i)%n, ( netcell(i)%nod(k), k=1,netcell(i)%n) /), (/ 1, i /) )
! enddo
!
! ierr = nf90_close(inetfile)
!> Reads the flow data from a map file for one single variable, specified by the user.
!! Processing is done elsewhere.
subroutine read_flowsamples_from_netcdf(fileName, quantityName, ierr)
use m_samples
implicit none
! I/O variables
character(len=256), intent(in) :: fileName !< Name of the NetCDF file.
character(len=256), intent(in) :: quantityName !< Name of the variable (i.e. the QUANTITY in the ext-file, i.e. 'qid').
integer, intent(out) :: ierr !< Return status (NetCDF operations).
! Local variables
integer :: iNetcdfFile, &
id_flowelemdim, &
id_flowlinkdim, &
id_timedim
integer :: id_varXcoord, &
id_varYcoord, &
id_varData
integer :: ndxi_read, &
lnx_read, &
nt_read
logical :: file_exists
! Safety check: does the file exist at all?
inquire(file=trim(fileName), exist=file_exists)
if ( .not. file_exists ) then
call mess(LEVEL_FATAL, 'The specified file for the initial conditions sample set has not been found. Check your .ext file.')
return
endif
ierr = unc_open(trim(fileName), nf90_nowrite, iNetcdfFile)
call check_error(ierr, 'file '''//trim(fileName)//'''')
if (nerr_ > 0) goto 999
! Ask for dimension id of nodes and edges
ierr = nf90_inq_dimid(iNetcdfFile, 'nFlowElem', id_flowelemdim)
ierr = nf90_inq_dimid(iNetcdfFile, 'nFlowLink', id_flowlinkdim)
ierr = nf90_inq_dimid(iNetcdfFile, 'time', id_timedim)
! Ask for dimensions of nodes and edges, ergo: the number of netnodes and netlinks
ierr = nf90_inquire_dimension(iNetcdfFile, id_flowelemdim, len=ndxi_read)
ierr = nf90_inquire_dimension(iNetcdfFile, id_flowlinkdim, len=lnx_read )
ierr = nf90_inquire_dimension(iNetcdfFile, id_timedim, len=nt_read )
! Read the output data
if (quantityName == 'initialwaterlevel') then
! Allocate the output variable to be read, based on the location of the variable
ns = ndxi_read
! Allocate the output variables to be read
if (allocated (xs) ) deallocate (xs,ys,zs)
allocate (xs(ns), ys(ns), zs(ns), stat=ierr)
! Read the xcoord data
ierr = nf90_inq_varid(iNetcdfFile, 'FlowElem_xcc', id_varXcoord)
ierr = nf90_get_var(iNetcdfFile, id_varXcoord, xs(1:ns))
! Read the xcoord data
ierr = nf90_inq_varid(iNetcdfFile, 'FlowElem_ycc', id_varYcoord)
ierr = nf90_get_var(iNetcdfFile, id_varYcoord, ys(1:ns))
! Read the actual water levels
ierr = nf90_inq_varid(iNetcdfFile, 's1', id_varData)
if (ierr .lt. 0) then
ierr = unc_close(iNetcdfFile)
call mess(LEVEL_FATAL, 'No waterlevel data found in the specified NetCDF file.')
return
else
ierr = nf90_get_var(iNetcdfFile, id_varData, zs(1:ns), start = (/ 1, nt_read /))
endif
elseif (quantityName == 'initialsalinity') then
! Allocate the output variable to be read, based on the location of the variable
ns = ndxi_read
! Allocate the output variables to be read
if (allocated (xs) ) deallocate (xs,ys,zs)
allocate (xs(ns), ys(ns), zs(ns), stat=ierr)
! Read the xcoord data
ierr = nf90_inq_varid(iNetcdfFile, 'FlowElem_xcc', id_varXcoord)
ierr = nf90_get_var(iNetcdfFile, id_varXcoord, xs(1:ns))
! Read the xcoord data
ierr = nf90_inq_varid(iNetcdfFile, 'FlowElem_ycc', id_varYcoord)
ierr = nf90_get_var(iNetcdfFile, id_varYcoord, ys(1:ns))
! Read the actual water levels
ierr = nf90_inq_varid(iNetcdfFile, 'sa1', id_varData)
if (ierr .lt. 0) then
ierr = unc_close(iNetcdfFile)
call mess(LEVEL_FATAL, 'No salinity data found in the specified NetCDF file.')
return
else
ierr = nf90_get_var(iNetcdfFile, id_varData, zs(1:ns), start = (/ 1, nt_read /))
endif
elseif (quantityName == 'initialvelocityx') then
! Allocate the output variable to be read, based on the location of the variable
ns = ndxi_read
! Allocate the output variables to be read
if (allocated (xs) ) deallocate (xs,ys,zs)
allocate (xs(ns), ys(ns), zs(ns), stat=ierr)
! Read the xcoord data
ierr = nf90_inq_varid(iNetcdfFile, 'FlowElem_xcc', id_varXcoord)
ierr = nf90_get_var(iNetcdfFile, id_varXcoord, xs(1:ns))
! Read the xcoord data
ierr = nf90_inq_varid(iNetcdfFile, 'FlowElem_ycc', id_varYcoord)
ierr = nf90_get_var(iNetcdfFile, id_varYcoord, ys(1:ns))
! Read the actual water levels
ierr = nf90_inq_varid(iNetcdfFile, 'ucx', id_varData)
if (ierr .lt. 0) then
ierr = unc_close(iNetcdfFile)
call mess(LEVEL_FATAL, 'No velocityx data found in the specified NetCDF file.')
return
else
ierr = nf90_get_var(iNetcdfFile, id_varData, zs(1:ns), start = (/ 1, nt_read /))
endif
elseif (quantityName == 'initialvelocityy') then
! Allocate the output variable to be read, based on the location of the variable
ns = ndxi_read
! Allocate the output variables to be read
if (allocated (xs) ) deallocate (xs,ys,zs)
allocate (xs(ns), ys(ns), zs(ns), stat=ierr)
! Read the xcoord data
ierr = nf90_inq_varid(iNetcdfFile, 'FlowElem_xcc', id_varXcoord)
ierr = nf90_get_var(iNetcdfFile, id_varXcoord, xs(1:ns))
! Read the xcoord data
ierr = nf90_inq_varid(iNetcdfFile, 'FlowElem_ycc', id_varYcoord)
ierr = nf90_get_var(iNetcdfFile, id_varYcoord, ys(1:ns))
! Read the actual water levels
ierr = nf90_inq_varid(iNetcdfFile, 'ucy', id_varData)
if (ierr .lt. 0) then
ierr = unc_close(iNetcdfFile)
call mess(LEVEL_FATAL, 'No velocityy data found in the specified NetCDF file.')
return
else
ierr = nf90_get_var(iNetcdfFile, id_varData, zs(1:ns), start = (/ 1, nt_read /))
endif
else
call mess(LEVEL_FATAL, 'Initial field specification of this quantity not supported through NetCDF file.')
return
endif
! Close the netcdf-file
999 continue
ierr = unc_close(iNetcdfFile)
end subroutine read_flowsamples_from_netcdf
end module unstruc_netcdf