!----- 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