Subroutine zpcou1
  Implicit Double Precision (A-H, O-Z)
  Common /para3/nsevt, nevnt, nsbrun, ievt, isbrun
  Common /ana1/ts(12)
  Common /ana2/det(12), dn(12), detdy(12), detdn(12), dndy(12), det1(12), dn1(12), detdy1(12), detdn1(12), dndy1(12), det2(12), dn2(12), detdy2(12), detdn2(12), dndy2(12)
  Common /ana4/fdetdy(24), fdndy(24), fdndpt(12)
  Save
  dpt = 0.5D0
  dy2 = 1D0
  dy1 = 0.5D0
  dy = 0.2D0
  ntotal = nevnt*nsbrun
  Return
End Subroutine zpcou1


!dis
!dis    Open Source License/Disclaimer, Forecast Systems Laboratory
!dis    NOAA/OAR/FSL, 325 Broadway Boulder, CO 80305
!dis
!dis    This software is distributed under the Open Source Definition,
!dis    which may be found at http://www.opensource.org/osd.html.
!dis
!dis    In particular, redistribution and use in source and binary forms,
!dis    with or without modification, are permitted provided that the
!dis    following conditions are met:
!dis
!dis    - Redistributions of source code must retain this notice, this
!dis    list of conditions and the following disclaimer.
!dis
!dis    - Redistributions in binary form must provide access to this
!dis    notice, this list of conditions and the following disclaimer, and
!dis    the underlying source code.
!dis
!dis    - All modifications to this software must be clearly documented,
!dis    and are solely the responsibility of the agent making the
!dis    modifications.
!dis
!dis    - If significant modifications or enhancements are made to this
!dis    software, the FSL Software Policy Manager
!dis    (softwaremgr@fsl.noaa.gov) should be notified.
!dis
!dis    THIS SOFTWARE AND ITS DOCUMENTATION ARE IN THE PUBLIC DOMAIN
!dis    AND ARE FURNISHED "AS IS."  THE AUTHORS, THE UNITED STATES
!dis    GOVERNMENT, ITS INSTRUMENTALITIES, OFFICERS, EMPLOYEES, AND
!dis    AGENTS MAKE NO WARRANTY, EXPRESS OR IMPLIED, AS TO THE USEFULNESS
!dis    OF THE SOFTWARE AND DOCUMENTATION FOR ANY PURPOSE.  THEY ASSUME
!dis    NO RESPONSIBILITY (1) FOR THE USE OF THE SOFTWARE AND
!dis    DOCUMENTATION; OR (2) TO PROVIDE TECHNICAL SUPPORT TO USERS.
!dis
!dis
  SUBROUTINE HELICITY (USIG, VSIG, ZSIG, TERRAIN, IMAX, JMAX, KSIG, SRELHEL)

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!--
!--   NAME: HELICITY
!--
!--   PURPOSE
!--   =======
!--   CALCULATE STORM RELATIVE HELICITY.
!--
!--   REMARKS
!--   =======
!--   HELICITY IS EQUAL TO THE VERTICAL INTEGRAL OF:
!--
!--   (V - c) x dV/dz
!--
!--   WHERE V IS THE MODEL PREDICTED WIND AND C IS THE
!--   ESTIMATED STORM MOTION VECTOR.
!--
!--   UPDATES
!--   =======
!--   ??? 97   INITIAL VERSION......................................DNXM
!--   DEC 98   MODIFIED CALL TO WDIR FUNCTION.  AN ERROR IN WDIR WAS
!--            CORRECTED............................................DNXM
!--   JAN 99   CHANGED VARIABLE NAMES USIGCRS AND VSIGCRS TO USIG AND
!--            AND VSIG AS WINDS ARE NOW AT THE CROSS POINT.........DNXM
!--   JAN 01   Adapted for use at FSL by B. Shaw, NOAA/FSL
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------

      USE constants
      IMPLICIT NONE

      REAL                         :: DZ
      INTEGER                      :: I
      INTEGER,     INTENT(IN)      :: IMAX
      INTEGER                      :: J
      INTEGER,     INTENT(IN)      :: JMAX
      INTEGER                      :: K
      INTEGER                      :: K3KM
      INTEGER                      :: K10KM
      INTEGER,     INTENT(IN)      :: KSIG
      REAL,        INTENT(OUT)     :: SRELHEL  ( imax , jmax )
      REAL                         :: STORMDIR
      REAL                         :: STORMSPD
      REAL                         :: STORMU
      REAL                         :: STORMV
      REAL                         :: SUMDZ
      REAL                         :: SUMHEL
      REAL                         :: SUMU
      REAL                         :: SUMV
      REAL,        INTENT(IN)      :: TERRAIN  ( imax , jmax )
      REAL,        INTENT(IN)      :: USIG     ( imax , jmax , ksig )
      REAL,        INTENT(IN)      :: VSIG     ( imax , jmax , ksig )
      REAL,        EXTERNAL        :: WDIR
      REAL,        EXTERNAL        :: WSPD
      REAL,        INTENT(IN)      :: ZSIG     ( imax , jmax , ksig )

!-----------------------------------------------------------------------
!--   DETERMINE INDICES OF 3 AND 10 KM LAYERS (ABOVE GROUND LEVEL)
!-----------------------------------------------------------------------

      DO J = 1, JMAX
        DO I = 1, IMAX

          DO K = 1, KSIG

            IF (((ZSIG(I,J,K) - TERRAIN(I,J)) .GE. 3000.0)) THEN
              K3KM = K
              EXIT
            END IF

          ENDDO

          DO K = KSIG, K3KM, -1

            IF (((ZSIG(I,J,K) - TERRAIN(I,J)) .LE. 10000.0)) THEN
              K10KM = K
              EXIT
            END IF

          ENDDO

!-----------------------------------------------------------------------
!--       ESTIMATE STORM MOTION VECTOR. SPEED IS 75 PERCENT OF THE MEAN
!--       WIND BETWEEN 3 AND 10 KM.  DIRECTION IS 30 DEGREES TO THE
!--       RIGHT OF THE MEAN WIND.
!-----------------------------------------------------------------------

          SUMU  = 0.0
          SUMV  = 0.0
          SUMDZ = 0.0

          DO K = K3KM, K10KM

            DZ    = ZSIG(I,J,K) - ZSIG(I,J,K-1)
            SUMDZ = SUMDZ + DZ
            SUMU  = SUMU + (0.5 * DZ * (USIG(I,J,K) + USIG(I,J,K-1)))
            SUMV  = SUMV + (0.5 * DZ * (VSIG(I,J,K) + VSIG(I,J,K-1)))

          ENDDO

          STORMU = SUMU / SUMDZ
          STORMV = SUMV / SUMDZ

          STORMSPD = WSPD (STORMU, STORMV) * 0.75

!-----------------------------------------------------------------------
!--       WHEN CALLING WDIR, SEND IN A CONE FACTOR OF ZERO
!--       SO THAT DIRECTION IS GRID RELATIVE.
!-----------------------------------------------------------------------

          STORMDIR = WDIR (STORMU, STORMV, 0.0, 0.0, 0.0) + 30.0
          IF (STORMDIR .GT. 360.0) STORMDIR = STORMDIR - 360.0

          STORMU = -STORMSPD * SIN(STORMDIR * DEG2RAD)
          STORMV = -STORMSPD * COS(STORMDIR * DEG2RAD)

          SUMHEL = 0.0

!-----------------------------------------------------------------------
!--       CALCULATE HELICITY.  INTEGRATE BETWEEN THE GROUND AND 3 KM,
!--       A DEPTH THAT IS FREQUENTLY USED IN THE LITERATURE.
!-----------------------------------------------------------------------

          DO K = 1, K3KM

            SUMHEL = SUMHEL +  &
                   ((USIG(I,J,K) - STORMU) *  &
                    (VSIG(I,J,K+1) - VSIG(I,J,K))) -  &
                   ((VSIG(I,J,K) - STORMV) *     &
                    (USIG(I,J,K+1) - USIG(I,J,K)))

          ENDDO

          SRELHEL(I,J) = -SUMHEL

        ENDDO
      ENDDO
      RETURN
      END SUBROUTINE HELICITY


module m_rdsed
!----- GPL ---------------------------------------------------------------------
!
!  Copyright (C)  Stichting Deltares, 2011-2016.
!
!  This program is free software: you can redistribute it and/or modify
!  it under the terms of the GNU General Public License as published by
!  the Free Software Foundation version 3.
!
!  This program 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 General Public License for more details.
!
!  You should have received a copy of the GNU General Public License
!  along with this program.  If not, see <http://www.gnu.org/licenses/>.
!
!  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" and "Deltares"
!  are registered trademarks of Stichting Deltares, and remain the property of
!  Stichting Deltares. All rights reserved.
!
!-------------------------------------------------------------------------------
!  $Id: rdsed.f90 5899 2016-02-29 14:58:49Z jagers $
!  $HeadURL: https://svn.oss.deltares.nl/repos/delft3d/tags/6686/src/utils_gpl/morphology/packages/morphology_io/src/rdsed.f90 $
!-------------------------------------------------------------------------------

private

!
! functions and subroutines
!
public rdsed
public count_sed
public echosed

contains

subroutine rdsed(lundia    ,error     ,lsal      ,ltem      ,lsed      , &
               & lsedtot   ,lstsci    ,ltur      ,namcon    ,iopsus    , &
               & nmlb      ,nmub      ,filsed    ,sed_ptr   , &
               & sedpar    ,trapar    ,griddim   )
!!--description-----------------------------------------------------------------
!
! Read sediment parameters from an input file
! File type:
!    ASCII-file if file version below 02.00
!    INI  -file if file version is 02.00 or higher
!
!!--declarations----------------------------------------------------------------
    use precision
    use properties
    use string_module
    use message_module
    use morphology_data_module
    use sediment_basics_module
    use system_utils, only:SHARED_LIB_EXTENSION
    use grid_dimens_module, only: griddimtype
    !
    implicit none
    !
    ! The following list of pointer parameters is used to point inside sedpar and trapar
    !
    real(fp)                           , pointer :: csoil
    real(fp)                           , pointer :: mdcuni
    real(fp)                           , pointer :: kssilt
    real(fp)                           , pointer :: kssand
    integer                            , pointer :: nmudfrac
    real(fp)         , dimension(:)    , pointer :: rhosol
    real(fp)         , dimension(:,:,:), pointer :: logseddia
    real(fp)         , dimension(:)    , pointer :: logsedsig
    real(fp)         , dimension(:)    , pointer :: sedd10
    real(fp)         , dimension(:)    , pointer :: sedd50
    real(fp)         , dimension(:)    , pointer :: sedd50fld
    real(fp)         , dimension(:)    , pointer :: seddm
    real(fp)         , dimension(:)    , pointer :: sedd90
    real(fp)         , dimension(:)    , pointer :: cdryb
    real(fp)         , dimension(:)    , pointer :: dstar
    real(fp)         , dimension(:)    , pointer :: taucr
    real(fp)         , dimension(:)    , pointer :: tetacr
    real(fp)         , dimension(:)    , pointer :: facdss
    real(fp)         , dimension(:)    , pointer :: sdbuni
    real(fp)         , dimension(:)    , pointer :: sedtrcfac
    real(fp)         , dimension(:)    , pointer :: thcmud
    real(fp)         , dimension(:)    , pointer :: tcguni
    real(fp)         , dimension(:)    , pointer :: mudcnt
    real(fp)         , dimension(:)    , pointer :: pmcrit
    integer          , dimension(:)    , pointer :: nseddia
    integer          , dimension(:)    , pointer :: sedtyp
    character(10)    , dimension(:)    , pointer :: inisedunit
    character(20)    , dimension(:)    , pointer :: namsed
    character(256)   , dimension(:)    , pointer :: flsdbd
    character(256)   , dimension(:)    , pointer :: flstcg
    logical                            , pointer :: anymud
    logical                            , pointer :: bsskin
    character(256)                     , pointer :: flsdia
    character(256)                     , pointer :: flsmdc
    character(256)                     , pointer :: flspmc
    character(256)   , dimension(:)    , pointer :: dll_function_settle
    character(256)   , dimension(:)    , pointer :: dll_name_settle
    integer(pntrsize), dimension(:)    , pointer :: dll_handle_settle
    character(256)   , dimension(:)    , pointer :: dll_usrfil_settle
    integer          , dimension(:)    , pointer :: iform_settle
    real(fp)         , dimension(:,:)  , pointer :: par_settle
    integer          , dimension(:)    , pointer :: iform
    character(256)   , dimension(:)    , pointer :: flstrn
!
! Call variables
!
    integer                                  , intent(in)  :: lsal    !  Description and declaration in dimens.igs
    integer                                  , intent(in)  :: lsed    !  Description and declaration in esm_alloc_int.f90
    integer                                  , intent(in)  :: lsedtot !  Description and declaration in esm_alloc_int.f90
    integer                                  , intent(in)  :: lstsci  !  Description and declaration in esm_alloc_int.f90
    integer                                  , intent(in)  :: ltem    !  Description and declaration in dimens.igs
    integer                                  , intent(in)  :: ltur    !  Description and declaration in esm_alloc_int.f90
    integer                                  , intent(in)  :: lundia  !  Description and declaration in inout.igs
    logical                                  , intent(out) :: error   !!  Flag=TRUE if an error is encountered
    character(20) , dimension(lstsci + ltur) , intent(in)  :: namcon  !  Description and declaration in esm_alloc_char.f90
    integer                                  , intent(out) :: iopsus
    integer                                  , intent(in)  :: nmlb
    integer                                  , intent(in)  :: nmub
    character(len=*)                         , intent(in)  :: filsed
    type(tree_data)                          , pointer     :: sed_ptr
    type(sedpar_type)                        , pointer     :: sedpar
    type(trapar_type)                        , pointer     :: trapar
    type(griddimtype)             , target   , intent(in)  :: griddim
!
! Local variables
!
    integer                     :: i
    integer                     :: iocond
    integer                     :: istat
    integer(pntrsize)           :: istat_ptr
    integer                     :: j
    integer                     :: l
    integer                     :: lbl                 ! bedload fraction number: lbl = l - lsed
    integer                     :: lenc                ! Help var. (length of character var.)
    integer                     :: lfile
    integer                     :: luninp
    integer                     :: n                   ! Temporary storage for nseddia(l)
    integer                     :: nm
    integer                     :: version
    integer          , external :: newunit
    integer(pntrsize), external :: open_shared_library
    real(fp)                    :: rmissval
    real(fp)                    :: seddxx              ! Temporary storage for sediment diameter
    real(fp)                    :: sedsg               ! Temporary storage for geometric standard deviation
    logical                     :: ex
    logical                     :: success
    character(11)               :: fmttmp ! Format file ('formatted  ')
    character(20)               :: sedname
    character(256)              :: filtrn
    character(256)              :: rec
    character(300)              :: message
    character(80)               :: parname
    character(20)               :: sedtype             ! Local variable for sediment type
    character(78)               :: string
    character(10)               :: versionstring
    character(6)                :: seddxxstring
    character(256)              :: errmsg
    type(tree_data), pointer    :: sedblock_ptr
!
!! executable statements -------------------------------------------------------
!
    csoil                => sedpar%csoil
    mdcuni               => sedpar%mdcuni
    kssilt               => sedpar%kssilt
    kssand               => sedpar%kssand
    nmudfrac             => sedpar%nmudfrac
    rhosol               => sedpar%rhosol
    logseddia            => sedpar%logseddia
    logsedsig            => sedpar%logsedsig
    sedd10               => sedpar%sedd10
    sedd50               => sedpar%sedd50
    sedd50fld            => sedpar%sedd50fld
    seddm                => sedpar%seddm
    sedd90               => sedpar%sedd90
    cdryb                => sedpar%cdryb
    dstar                => sedpar%dstar
    taucr                => sedpar%taucr
    tetacr               => sedpar%tetacr
    sdbuni               => sedpar%sdbuni
    thcmud               => sedpar%thcmud
    mudcnt               => sedpar%mudcnt
    pmcrit               => sedpar%pmcrit
    nseddia              => sedpar%nseddia
    sedtyp               => sedpar%sedtyp
    inisedunit           => sedpar%inisedunit
    namsed               => sedpar%namsed
    flsdbd               => sedpar%flsdbd
    anymud               => sedpar%anymud
    bsskin               => sedpar%bsskin
    flsdia               => sedpar%flsdia
    flsmdc               => sedpar%flsmdc
    flspmc               => sedpar%flspmc
    dll_function_settle  => trapar%dll_function_settle
    dll_name_settle      => trapar%dll_name_settle
    dll_handle_settle    => trapar%dll_handle_settle
    dll_usrfil_settle    => trapar%dll_usrfil_settle
    iform_settle         => trapar%iform_settle
    par_settle           => trapar%par_settle
    iform                => trapar%iform
    flstrn               => trapar%flstrn
    !
    rmissval = -999.0_fp
    fmttmp   = 'formatted'
    !
    istat = 0
    if (.not. associated(sedpar%sedd50)) then
       !
       ! allocation of namsed, rhosol and sedtyp have been allocated in count_sed routine
       !
       if (istat==0) allocate (sedpar%sedblock  (                          lsedtot), stat = istat)
       if (istat==0) allocate (sedpar%nseddia   (                          lsedtot), stat = istat)
       if (istat==0) allocate (sedpar%logseddia (2, 101,                   lsedtot), stat = istat)
       if (istat==0) allocate (sedpar%logsedsig (                          lsedtot), stat = istat)
       if (istat==0) allocate (sedpar%sedd10    (                          lsedtot), stat = istat)
       if (istat==0) allocate (sedpar%sedd50    (                          lsedtot), stat = istat)
       if (istat==0) allocate (sedpar%seddm     (                          lsedtot), stat = istat)
       if (istat==0) allocate (sedpar%sedd90    (                          lsedtot), stat = istat)
       !
       if (istat==0) allocate (sedpar%cdryb     (                          lsedtot), stat = istat)
       if (istat==0) allocate (sedpar%dstar     (                          lsedtot), stat = istat)
       if (istat==0) allocate (sedpar%taucr     (                          lsedtot), stat = istat)
       if (istat==0) allocate (sedpar%tetacr    (                          lsedtot), stat = istat)
       if (istat==0) allocate (sedpar%sdbuni    (                          lsedtot), stat = istat)
       if (istat==0) allocate (sedpar%sedtrcfac (                          lsedtot), stat = istat)
       if (istat==0) allocate (sedpar%flsdbd    (                          lsedtot), stat = istat)
       if (istat==0) allocate (sedpar%inisedunit(                          lsedtot), stat = istat)
       !
       if (istat==0) allocate (sedpar%dss       (nmlb:nmub            ,max(1,lsed)), stat = istat)
       if (istat==0) allocate (sedpar%facdss    (                      max(1,lsed)), stat = istat)
       if (istat==0) allocate (sedpar%tcguni    (                      max(1,lsed)), stat = istat)
       !
       if (istat==0) allocate (sedpar%thcmud    (nmlb:nmub            ), stat = istat)
       if (istat==0) allocate (sedpar%flstcg    (                      max(1,lsed)), stat = istat)
       !
       if (istat==0) allocate (sedpar%mudcnt    (nmlb:nmub            ), stat = istat)
       if (istat==0) allocate (sedpar%pmcrit    (nmlb:nmub            ), stat = istat)
       if (istat==0) allocate (sedpar%sedd50fld (nmlb:nmub            ), stat = istat)
       !
       if (istat/=0) then
          errmsg = 'RDSED: memory alloc error'
          call write_error(errmsg, unit=lundia)
          error = .true.
          return
       endif
       !
       ! update local pointers
       !
       nseddia       => sedpar%nseddia
       logseddia     => sedpar%logseddia
       logsedsig     => sedpar%logsedsig
       sedd10        => sedpar%sedd10
       sedd50        => sedpar%sedd50
       seddm         => sedpar%seddm
       sedd90        => sedpar%sedd90
       !
       cdryb         => sedpar%cdryb
       dstar         => sedpar%dstar
       taucr         => sedpar%taucr
       tetacr        => sedpar%tetacr
       sdbuni        => sedpar%sdbuni
       sedtrcfac     => sedpar%sedtrcfac
       flsdbd        => sedpar%flsdbd
       inisedunit    => sedpar%inisedunit
       !
       facdss        => sedpar%facdss
       thcmud        => sedpar%thcmud
       !
       mudcnt        => sedpar%mudcnt
       pmcrit        => sedpar%pmcrit
       sedd50fld     => sedpar%sedd50fld
       tcguni        => sedpar%tcguni
       flstcg        => sedpar%flstcg
       !
       !
       ! end check on assocation of sedpar%sedd50
       !
    endif
    !
    ! Initialization of the just allocated arrays
    !
    do i = 1,lsedtot
       sedpar%sedblock(i)%node_name => null()
    enddo
    flsdbd              = ' '
    flsmdc              = ' '
    flspmc              = ' '
    flsdia              = ' '
    dll_function_settle = ' '
    dll_usrfil_settle   = ' '
    flstcg              = ' '
    flstrn              = ' '
    !
    nseddia      = 0        ! nseddia counts relevant data
    logseddia    = rmissval
    logsedsig    = rmissval
    sedd10       = rmissval
    sedd50       = rmissval
    seddm        = rmissval
    sedd90       = rmissval
    !
    sedtrcfac    = rmissval
    !
    dstar        = rmissval
    taucr        = rmissval
    tetacr       = rmissval
    inisedunit   = 'kg/m2'
    !
    thcmud       = rmissval
    !
    mudcnt       =  0.0
    pmcrit       = -1.0
    sedd50fld    = rmissval
    !
    tcguni       = 1.5
    !
    ! Initialization of local parameters/arrays
    !
    version      = 0
    error        = .false.
    lenc         = 4
    !
    facdss       = rmissval
    !
    seddxxstring = 'SedDXX'
    anymud       = .false.
    !
    ! Check version number of sed input file
    !
    versionstring = ' '
    call prop_get_string(sed_ptr, 'SedimentFileInformation', 'FileVersion', versionstring)
    if (versionstring == '02.00' .or. versionstring == '03.00') then
       if (versionstring == '03.00') sedpar%version = 3.0_fp
       error  = .false.
       !
       csoil  = 1.0e4_fp
       call prop_get(sed_ptr, 'SedimentOverall', 'Cref', csoil)
       !
       iopsus = 0
       call prop_get_integer(sed_ptr, 'SedimentOverall', 'IopSus', iopsus)
       !
       call prop_get_string(sed_ptr, 'SedimentOverall', 'MudCnt', flsmdc)
       !
       sedpar%flnrd(0) = ' '
       call prop_get_string(sed_ptr, 'SedimentOverall', 'NodeRelations', sedpar%flnrd(0))
       if (sedpar%flnrd(0) .ne. ' ') then
          call combinepaths(filsed, sedpar%flnrd(0))
       endif
       !
       !
       ! Intel 7.0 crashes on an inquire statement when file = ' '
       !
       if (flsmdc == ' ') then
          ex = .false.
       else
          call combinepaths(filsed, flsmdc)
          inquire (file = flsmdc, exist = ex)
       endif
       if (ex) then
          !
          ! Space varying data has been specified
          ! Use routine that also read the depth file to read the data
          !
          call depfil(lundia    ,error     ,flsmdc    ,fmttmp    , &
                    & mudcnt    ,1         ,1         ,griddim   )
          if (error) return
          do nm = 1, griddim%nmmax
             mudcnt(nm) = max(0.0_fp, min(mudcnt(nm), 1.0_fp))
          enddo
       else
          flsmdc = ' '
          mdcuni = 0.0_fp
          call prop_get(sed_ptr, 'SedimentOverall', 'MudCnt', mdcuni)
          !
          ! Uniform data has been specified
          !
          mudcnt = max(0.0_fp,min(mdcuni,1.0_fp))
       endif
       !
       if ( .not. associated(sed_ptr%child_nodes) ) then
          errmsg = 'Unable to read sediment information'
          call write_error(errmsg, unit=lundia)
          error = .true.
          return
       endif
       !
       ! Sand-mud interaction parameters
       !
       call prop_get_string(sed_ptr, 'SedimentOverall', 'PmCrit', flspmc)
       !
       ! Intel 7.0 crashes on an inquire statement when file = ' '
       !
       if (flspmc == ' ') then
          ex = .false.
       else
          call combinepaths(filsed, flspmc)
          inquire (file = flspmc, exist = ex)
       endif
       if (ex) then
          !
          ! Space varying data has been specified
          ! Use routine that also read the depth file to read the data
          !
          call depfil(lundia    ,error     ,flspmc    ,fmttmp    , &
                    & pmcrit    ,1         ,1         ,griddim   )
          if (error) return
          do nm = 1, griddim%nmmax
             pmcrit(nm) = min(pmcrit(nm), 1.0_fp)
          enddo
       else
          flspmc = ' '
          call prop_get(sed_ptr, 'SedimentOverall', 'PmCrit', pmcrit(1))
          pmcrit = min(pmcrit(1), 1.0_fp)
       endif
       !
       ! Get bed shear skin stress parameters
       !
       bsskin = .false.
       call prop_get_logical(sed_ptr, 'SedimentOverall', 'BsSkin', bsskin)
       if (bsskin) then
          kssilt = 0.0_fp
          kssand = 0.0_fp
          call prop_get(sed_ptr, 'SedimentOverall', 'KsSilt', kssilt)
          call prop_get(sed_ptr, 'SedimentOverall', 'KsSand', kssand)
       endif
       !
       do l = 1, lsedtot
          !
          ! namsed pre-filled in count-sed routine
          !
          sedname = namsed(l)
          write(lundia,'(a,i2,2a)') 'Sediment fraction ', l, ': ', sedname
          !
          ! find associated block (note that name order and block order may not correspond since
          ! suspended fractions need to be associated with the lower indices and e.g. Delft3D-FLOW
          ! requires suspended fraction order to match order of constituents).
          !
          do i = 1, size(sed_ptr%child_nodes)
             !
             ! Does sed_ptr contain a child with name 'Sediment' (converted to lower case)?
             !
             sedblock_ptr => sed_ptr%child_nodes(i)%node_ptr
             parname = tree_get_name( sedblock_ptr )
             call str_lower(parname)
             if ( trim(parname) /= 'sediment') cycle
             !
             parname = ' '
             call prop_get_string(sedblock_ptr, '*', 'Name', parname)
             if (.not. strcmpi(parname, sedname)) cycle
             !
             ! sediment fraction found
             !
             sedpar%flnrd(l) = ' '
             call prop_get_string(sedblock_ptr, '*', 'NodeRelations', sedpar%flnrd(l))
             if (sedpar%flnrd(l) .ne. ' ') then
                call combinepaths(filsed, sedpar%flnrd(l))
             endif
             !
             exit
          enddo
          sedpar%sedblock(l) = sedblock_ptr
          !
          rhosol(l) = rmissval
          call prop_get(sedblock_ptr, '*', 'RhoSol', rhosol(l))
          !
          ! Get the geometric standard deviation of the sediment fraction
          !
          sedsg = rmissval
          call prop_get(sedblock_ptr, '*', 'SedSg', sedsg)
          if (comparereal(sedsg,rmissval) /= 0) then
             logsedsig(l) = log(sedsg)
          endif
          !
          ! In case of one sediment fraction, it is possible to use a spatially
          ! varying grain size.
          !
          if (lsedtot == 1) then
             call prop_get_string(sedblock_ptr, '*', 'SedD50', flsdia)
             if (flsdia == ' ') then
                !
                ! Alternative for SedD50 is SedDia (backward compatibility)
                !
                call prop_get_string(sedblock_ptr, '*', 'SedDia', flsdia)
             endif
             !
             ! Intel 7.0 crashes on an inquire statement when file = ' '
             !
             if (flsdia == ' ') then
                ex = .false.
             else
                call combinepaths(filsed, flsdia)
                inquire (file = flsdia, exist = ex)
             endif
             if (ex) then
                !
                !  File with space varying data has been specified, read it now.
                !
                call depfil(lundia    ,error     ,flsdia    ,fmttmp    , &
                          & sedd50fld ,1         ,1         ,griddim   )
                if (error) return
             else
                flsdia = ' '
             endif
          else
             ex = .false.
          endif
          !
          ! If there are multiple sediment fractions, or if no spatially
          ! varying grain size file was specified, read the sediment size
          ! properties.
          !
          if (.not. ex) then
             do j = 0, 100
                seddxx = rmissval
                if (j == 0) then
                   call prop_get(sedblock_ptr, '*', 'SedMinDia', seddxx)
                elseif (j == 100) then
                   call prop_get(sedblock_ptr, '*', 'SedMaxDia', seddxx)
                else
                   write(seddxxstring(5:6),'(i2.2)') j
                   call prop_get(sedblock_ptr, '*', seddxxstring, seddxx)
                   if (j == 50 .and. comparereal(seddxx,rmissval) == 0) then
                      !
                      ! Alternative for SedD50 is SedDia (backward compatibility)
                      !
                      call prop_get(sedblock_ptr, '*', 'SedDia', seddxx)
                   endif
                endif
                if (comparereal(seddxx,rmissval) /= 0) then
                   if (seddxx <= 0.0_fp) then
                      !
                      ! error: sediment diameter less than or equal to zero!!
                      !
                      errmsg = 'Sediment diameters must be positive!'
                      call write_error(errmsg, unit=lundia)
                      error = .true.
                      return
                   endif
                   !
                   nseddia(l)       = nseddia(l) + 1
                   n                = nseddia(l)
                   logseddia(1,n,l) = real(j,fp)
                   logseddia(2,n,l) = log(seddxx)
                   if (n > 1) then
                      if (logseddia(2,n,l) <= logseddia(2,n-1,l)) then
                         !
                         ! error: sediment diameters not increasing!!
                         !
                         errmsg = 'Sediment diameters must be increasing!'
                         call write_error(errmsg, unit=lundia)
                         error = .true.
                         return
                      endif
                   endif
                endif
             enddo
          endif
          !
          if (l <= lsed) then
             rec = ' '
             call prop_get(sedblock_ptr, '*', 'SettleLib', rec)
             dll_name_settle(l) = rec
             if (rec /= ' ') then
                rec(len_trim(rec)+1:) = SHARED_LIB_EXTENSION
                dll_name_settle(l) = rec
                istat_ptr = 0
                istat_ptr = open_shared_library(dll_handle_settle(l), dll_name_settle(l))
                if (istat_ptr /= 0) then
                   write(errmsg,'(a,a)') 'Can not open shared library ', trim(dll_name_settle(l))
                   errmsg = FILE_NOT_FOUND // trim(errmsg)
                   call write_error(errmsg, unit=lundia)
                   error = .true.
                   return
                endif
                !
                call prop_get_string(sedblock_ptr, '*', 'SettleFunction', dll_function_settle(l))
                call prop_get_string(sedblock_ptr, '*', 'SettleInput'   , dll_usrfil_settle(l))
                iform_settle(l) = 15
             elseif (sedtyp(l) == SEDTYP_COHESIVE) then
                iform_settle(l) = 1
             elseif (sedtyp(l) == SEDTYP_NONCOHESIVE_SUSPENDED) then
                iform_settle(l) = 2
             endif
             !
             par_settle(:,l) = rmissval
             if (iform_settle(l) == 1) then
                call prop_get(sedblock_ptr, '*', 'SalMax', par_settle(1,l))
                call prop_get(sedblock_ptr, '*', 'WS0'   , par_settle(2,l))
                call prop_get(sedblock_ptr, '*', 'WSM'   , par_settle(3,l))
             elseif (iform_settle(l) == 2) then
                !
                ! These parameters will only be used for iform = -2, but unfortunately iform hasn't been determined yet.
                ! In the future we may have to read the parameters in a different order.
                !
                call prop_get(sedblock_ptr, '*', 'SalMax', par_settle(1,l))
                par_settle(2,l) = 1.0_fp
                call prop_get(sedblock_ptr, '*', 'GamFloc', par_settle(2,l))
             endif
             !
             ! Tracer calibration factor
             !
             call prop_get(sedblock_ptr, '*', 'TracerCalibrationFactor', sedtrcfac(l))
          endif
          !
          cdryb(l) = rmissval
          call prop_get(sedblock_ptr, '*', 'CDryB', cdryb(l))
          !
          ! First assume that 'IniSedThick'/'SdBUni' contains a filename
          ! If the file does not exist, assume that 'SdBUni' contains a uniform value (real)
          !
          call prop_get_string(sedblock_ptr, '*', 'IniSedThick', flsdbd(l))
          if (flsdbd(l) /= ' ') then
             inisedunit(l) = 'm'
          else
             inisedunit(l) = 'kg/m2'
             call prop_get_string(sedblock_ptr, '*', 'SdBUni', flsdbd(l))
          endif
          !
          ! Intel 7.0 crashes on an inquire statement when file = ' '
          !
          if (flsdbd(l) == ' ') then
             ex = .false.
          else
             call combinepaths(filsed, flsdbd(l))
             inquire (file = flsdbd(l), exist = ex)
          endif
          if (.not. ex) then
             sdbuni(l) = rmissval
             if (inisedunit(l) == 'm') then
                call prop_get(sedblock_ptr, '*', 'IniSedThick', sdbuni(l), success)
             else
                call prop_get(sedblock_ptr, '*', 'SdBUni', sdbuni(l), success)
             endif
             if (.not. success) then
                if (inisedunit(l) == 'm') then
                   errmsg = 'Error in IniSedThick: ' // trim(flsdbd(l)) // ' is not a file and not a value.'
                else
                   errmsg = 'Error in SdBUni.' // trim(flsdbd(l))
                endif
                errmsg = FILE_NOT_FOUND // trim(errmsg)
                call write_error(errmsg, unit=lundia)
                error = .true.
                return
             endif
             flsdbd(l) = ' '
          endif
          !
          if (l <= lsed) then
             call prop_get(sedblock_ptr, '*', 'FacDSS', facdss(l))
          endif
          !
          filtrn = ' '
          call prop_get(sedblock_ptr, '*', 'TraFrm', filtrn)
          !
          ! Intel 7.0 crashes on an inquire statement when file = ' '
          !
          if (filtrn /= ' ') then
             call combinepaths(filsed, filtrn)
             inquire (file = filtrn, exist = ex)
             if (ex) flstrn(l) = filtrn
             !
             call prop_get(sedblock_ptr, '*', 'TraFrm', iform(l))
          endif
       enddo
    else
       !
       ! sediment input version is 0 or 1:
       ! No keywords
       !
       call opensedfil(lundia    ,error     ,filsed    ,luninp    ,version  )
       if (error) return
       !write (versionstring, '(i4)') version
       !
       ! version 0 and 1 files don't contain sediment names.
       ! copy the names from the constituent array.
       !
       do l = 1, lsed
          namsed(l) = namcon(max(0, lsal, ltem) + l)
       enddo
       call rdsed01(lsed      ,luninp    ,lundia    ,csoil     ,iopsus    , &
                  & facdss    ,sedtyp    ,rhosol    ,sedd50    ,par_settle, &
                  & sdbuni    ,flsdbd    ,cdryb     ,sedpar%sedblock      , &
                  & version   ,error     )
       close (luninp)
       if (error) return
       !
       do l = 1, lsed
          if (sedtyp(l) == SEDTYP_COHESIVE) then
             iform_settle(l) = 1
          elseif (sedtyp(l) == SEDTYP_NONCOHESIVE_SUSPENDED) then
             iform_settle(l) = 2
             par_settle(2,l) = 1.0_fp ! gamflc default
          endif
       enddo
       !
       ! Old format: SedDia specified, but stored in "wrong" array.
       !
       do l = 1, lsedtot
          if (sedd50(l) > 0.0_fp) then
             nseddia(l)       = 1
             logseddia(1,1,l) = 50.0_fp
             logseddia(2,1,l) = log(sedd50(l))
          endif
       enddo
    endif
    if (error) goto 9999
    do l = 1, lsedtot
       if (sedtyp(l) == SEDTYP_COHESIVE) then
          anymud   = .true.
          nmudfrac = nmudfrac + 1
       endif
    enddo
 9999 continue
end subroutine rdsed

subroutine rdsed01(lsed      ,luninp    ,lundia    ,csoil     ,iopsus    , &
                 & facdss    ,sedtyp    ,rhosol    ,seddia    ,parsettle , &
                 & sdbuni    ,flsdbd    ,cdryb     ,sedblock  ,version   , &
                 & error     )
!!--description-----------------------------------------------------------------
!
! Reads sediment input version 0 (or no version number found) or 1
!
!!--declarations----------------------------------------------------------------
    use precision
    use properties
    use sediment_basics_module
    use message_module, only: write_error
    !
    implicit none
!
! Call variables
!
    integer                        , intent(out):: iopsus
    integer                        , intent(in) :: lundia !  Description and declaration in inout.igs
    integer                        , intent(in) :: luninp
    integer                        , intent(in) :: version
    integer                                     :: lsed
    logical                        , intent(out):: error
    real(fp)                       , intent(out):: csoil
    real(fp)       , dimension(:)  , intent(out):: cdryb
    real(fp)       , dimension(:)  , intent(out):: facdss
    real(fp)       , dimension(:)  , intent(out):: rhosol
    real(fp)       , dimension(:,:), intent(out):: parsettle
    real(fp)       , dimension(:)  , intent(out):: sdbuni
    real(fp)       , dimension(:)  , intent(out):: seddia
    integer        , dimension(:)  , intent(out):: sedtyp !  sediment type: 0=total/1=noncoh/2=coh
    character(256) , dimension(:)  , intent(out):: flsdbd
    type(tree_data), dimension(:)  , intent(out):: sedblock
!
! Local variables
!
    integer                  :: iocond
    integer                  :: l
    integer                  :: lenc
    integer                  :: lsedlc
    character(4)             :: sedtype
    character(256)           :: errmsg
    character(256)           :: line
    type(tree_data), pointer :: sedblock_ptr
    type(tree_data), pointer :: anode
!
!! executable statements -------------------------------------------------------
!
    error  = .false.
    !
    if (version==0) then
       read (luninp, *, iostat = iocond) lsedlc, csoil
       iopsus = 0
    else
       read (luninp, *, iostat = iocond) lsedlc, csoil, iopsus
    endif
    !
    if (lsedlc /= lsed) then
       errmsg = 'Inconsistent number of sediment fractions'
       call write_error(errmsg, unit=lundia)
       error = .true.
       return
    endif
    !
    lenc = 4
    do l = 1, lsed
       call tree_create('Sediment',sedblock_ptr)
       !
       sedtype   = ' '
       read (luninp, '(a)', iostat = iocond) sedtype
       if (iocond == 0) then
          call small(sedtype, lenc)
          if (index(sedtype, 'sand') == 1) then
              sedtyp(l) = SEDTYP_NONCOHESIVE_SUSPENDED
          elseif (index(sedtype, 'mud') == 1) then
              sedtyp(l) = SEDTYP_COHESIVE
          else
             errmsg = 'Invalid suspended sediment type (must start with sand or mud)'
             call write_error(errmsg, unit=lundia)
             error = .true.
             return
          endif
       endif
       read (luninp, *, iostat = iocond) rhosol(l)
       if (iocond == 0) read (luninp, *, iostat = iocond) seddia(l)
       if (iocond == 0) read (luninp, *, iostat = iocond) parsettle(1,l) ! salmax
       if (iocond == 0) read (luninp, *, iostat = iocond) parsettle(2,l) ! ws0
       if (iocond == 0) read (luninp, *, iostat = iocond) parsettle(3,l) ! wsm
       if (iocond == 0) read (luninp, '(a)', iostat = iocond) line ! tcd
       call tree_create_node(sedblock_ptr,'TcrSed',anode)
       call tree_put_data(anode,transfer(trim(line),node_value),"STRING")
       if (iocond == 0) read (luninp, '(a)', iostat = iocond) line ! tce
       call tree_create_node(sedblock_ptr,'TcrEro',anode)
       call tree_put_data(anode,transfer(trim(line),node_value),"STRING")
       if (iocond == 0) read (luninp, '(a)', iostat = iocond) line ! ero
       call tree_create_node(sedblock_ptr,'EroPar',anode)
       call tree_put_data(anode,transfer(trim(line),node_value),"STRING")
       if (iocond == 0) read (luninp, *, iostat = iocond) cdryb(l)
       if (iocond == 0) read (luninp, *, iostat = iocond) sdbuni(l)
       if (iocond /= 0) then
          backspace (luninp)
          read (luninp, '(a)', iostat = iocond) flsdbd(l)
       endif
       if (version==0) then
          facdss(l) = 1.0_fp
       else
          if (iocond == 0) read (luninp, *, iostat = iocond) facdss(l)
       endif
       !
       sedblock(l) = sedblock_ptr
    enddo
    !
    deallocate(sedblock_ptr)
end subroutine rdsed01

subroutine opensedfil(lundia    ,error     ,filsed    ,luninp    ,version  )
!!--description-----------------------------------------------------------------
!
! Read sediment parameters from an input file
! File type:
!    ASCII-file if file version below 02.00
!    INI  -file if file version is 02.00 or higher
!
!!--declarations----------------------------------------------------------------
    use message_module
    use string_module
    implicit none
!
! Call variables
!
    integer                                  , intent(in)  :: lundia  ! unit of diagnostic file
    integer                                  , intent(out) :: luninp  ! unit of opened .sed file
    integer                                  , intent(out) :: version ! version of .sed file
    logical                                  , intent(out) :: error   ! .true. if error occured
    character(*)                                           :: filsed  ! name of .sed file
!
! Local variables
!
    integer                                                :: i
    integer                                                :: iocond
    integer                                     , external :: newunit
    character(256)                                         :: string
    character(256)                                         :: errmsg
!
!! executable statements -------------------------------------------------------
!
    error   = .false.
    version = 0
    !
    call remove_leading_spaces(filsed)
    luninp = newunit()
    open (luninp, file = filsed, form = 'formatted', status = 'old',            &
        & iostat = iocond)
    if (iocond /= 0) then
       errmsg = ERROR_FILE_OPEN // trim(filsed)
       call write_error(errmsg, unit=lundia)
       error = .true.
       return
    endif
    !
    ! Free formatted file, skip lines starting with a '*'
    !
    read (luninp, '(a)') string
    do while (string(:1) == '*')
       call str_lower(string)
       i = index(string, 'version')
       if (i /= 0) then
          read (string(i + 8:), '(i2)') version
       else
          write (lundia, '(a)') 'No version number found'
       endif
       read (luninp, '(a)') string
    enddo
    !
    rewind (luninp)
    call skipstarlines(luninp)
end subroutine opensedfil

subroutine echosed(lundia    ,error     ,lsed      ,lsedtot   , &
                 & iopsus    ,sedpar    ,trapar    )
!!--description-----------------------------------------------------------------
!
! Report sediment parameter to diag file
!
!!--declarations----------------------------------------------------------------
    use precision
    use message_module
    use morphology_data_module
    use sediment_basics_module
    use m_rdtrafrm, only:echotrafrm
    !
    implicit none
!
! Call variables
!
    integer                                  , intent(in)  :: iopsus
    integer                                  , intent(in)  :: lsed    !  Description and declaration in iidim.f90
    integer                                  , intent(in)  :: lsedtot !  Description and declaration in iidim.f90
    integer                                                :: lundia  !  Description and declaration in inout.igs
    logical                                  , intent(out) :: error   !!  Flag=TRUE if an error is encountered
    type(sedpar_type)                        , pointer     :: sedpar
    type(trapar_type)                        , pointer     :: trapar
!
! Local variables
!
    real(fp)                          , pointer :: csoil
    real(fp)                          , pointer :: mdcuni
    real(fp)                          , pointer :: kssilt
    real(fp)                          , pointer :: kssand
    real(fp)        , dimension(:)    , pointer :: rhosol
    real(fp)        , dimension(:,:,:), pointer :: logseddia
    real(fp)        , dimension(:)    , pointer :: logsedsig
    real(fp)        , dimension(:)    , pointer :: sedd10
    real(fp)        , dimension(:)    , pointer :: sedd50
    real(fp)        , dimension(:)    , pointer :: sedd50fld
    real(fp)        , dimension(:)    , pointer :: seddm
    real(fp)        , dimension(:)    , pointer :: sedd90
    real(fp)        , dimension(:)    , pointer :: cdryb
    real(fp)        , dimension(:,:)  , pointer :: dss
    real(fp)        , dimension(:)    , pointer :: facdss
    real(fp)        , dimension(:)    , pointer :: sdbuni
    real(fp)        , dimension(:)    , pointer :: sedtrcfac
    real(fp)        , dimension(:)    , pointer :: tcguni
    real(fp)        , dimension(:)    , pointer :: pmcrit
    integer         , dimension(:)    , pointer :: nseddia
    integer         , dimension(:)    , pointer :: sedtyp
    character(10)   , dimension(:)    , pointer :: inisedunit
    character(20)   , dimension(:)    , pointer :: namsed
    character(256)  , dimension(:)    , pointer :: flsdbd
    character(256)  , dimension(:)    , pointer :: flstcg
    logical                           , pointer :: anymud
    logical                           , pointer :: bsskin
    character(256)                    , pointer :: flsdia
    character(256)                    , pointer :: flsmdc
    character(256)                    , pointer :: flspmc
    character(256)  , dimension(:)    , pointer :: dll_function_settle
    character(256)  , dimension(:)    , pointer :: dll_name_settle
    character(256)  , dimension(:)    , pointer :: dll_usrfil_settle
    integer         , dimension(:)    , pointer :: iform_settle
    real(fp)        , dimension(:,:)  , pointer :: par_settle
    integer         , dimension(:)    , pointer :: iform
    !
    integer                   :: i
    integer                   :: l
    integer                   :: n                   ! Temporary storage for nseddia(l)
    integer                   :: nm
    real(fp)                  :: logsedd50
    real(fp)                  :: rmissval
    real(fp)                  :: xxinv               ! Help var. [1/xx or 1/(1-xx) in log unif distrib.]
    real(fp)                  :: xm
    logical        , external :: stringsequalinsens
    character(40)             :: txtput1
    character(10)             :: txtput2
    character(256)            :: errmsg
!
!! executable statements -------------------------------------------------------
!
    csoil                => sedpar%csoil
    mdcuni               => sedpar%mdcuni
    kssilt               => sedpar%kssilt
    kssand               => sedpar%kssand
    rhosol               => sedpar%rhosol
    logseddia            => sedpar%logseddia
    logsedsig            => sedpar%logsedsig
    sedd10               => sedpar%sedd10
    sedd50               => sedpar%sedd50
    sedd50fld            => sedpar%sedd50fld
    seddm                => sedpar%seddm
    sedd90               => sedpar%sedd90
    cdryb                => sedpar%cdryb
    dss                  => sedpar%dss
    facdss               => sedpar%facdss
    sdbuni               => sedpar%sdbuni
    sedtrcfac            => sedpar%sedtrcfac
    tcguni               => sedpar%tcguni
    pmcrit               => sedpar%pmcrit
    nseddia              => sedpar%nseddia
    sedtyp               => sedpar%sedtyp
    inisedunit           => sedpar%inisedunit
    namsed               => sedpar%namsed
    flsdbd               => sedpar%flsdbd
    flstcg               => sedpar%flstcg
    anymud               => sedpar%anymud
    bsskin               => sedpar%bsskin
    flsdia               => sedpar%flsdia
    flsmdc               => sedpar%flsmdc
    flspmc               => sedpar%flspmc
    dll_function_settle  => trapar%dll_function_settle
    dll_name_settle      => trapar%dll_name_settle
    dll_usrfil_settle    => trapar%dll_usrfil_settle
    iform_settle         => trapar%iform_settle
    par_settle           => trapar%par_settle
    iform                => trapar%iform
    !
    rmissval = -999.0_fp
    !
    ! echo input in diagnose-file
    !
    write (lundia, '(a)')   '*** Start  of sediment input'
    txtput1 = 'Ref concentration'
    write (lundia, '(2a,e12.4)') txtput1, ':', csoil
    if (csoil <= 0.0_fp) then
       errmsg = 'Reference concentration should be positive.'
       call write_error(errmsg, unit=lundia)
       error = .true.
       return
    endif
    txtput1 = 'Option Dss'
    write (lundia, '(2a,i12)') txtput1, ':', iopsus
    if (anymud) then
       if (flsmdc /= ' ' .or. comparereal(mdcuni,0.0_fp) /= 0) then
          errmsg = 'User defined mud content ignored: mud fraction simulated.'
          call write_warning(errmsg, unit=lundia)
       endif
       flsmdc = ' '
       mdcuni = 0.0_fp
       !
       ! Sand-mud interaction
       !
       txtput1 = 'Crit mud frac for sand mud interaction'
       if (flspmc /= ' ') then
          write (lundia, '(3a)') txtput1, ':  ', trim(flspmc)
       else
          write (lundia, '(2a,e12.4)') txtput1, ':', pmcrit(1)
       endif
    else
       if (flsmdc /= ' ') then
          txtput1 = 'File mud content'
          write (lundia, '(3a)') txtput1, ':  ', trim(flsmdc)
       else
          txtput1 = 'Uniform mud content'
          write (lundia, '(2a,e12.4)') txtput1, ':', mdcuni
       endif
       !
       ! Sand-mud interaction
       !
       if (flspmc /= ' ' .or. comparereal(pmcrit(1),0.0_fp) > 0) then
          errmsg = 'Sand mud interaction ignored: no mud fraction simulated.'
          call write_warning(errmsg, unit=lundia)
       endif
       flspmc = ' '
       pmcrit = -1.0_fp
    endif
    if (bsskin) then
       txtput1 = 'Skin friction Soulsby 2004'
       write (lundia, '(a)') txtput1
       txtput1 = 'Kssilt '
       write (lundia, '(2a,f12.6)') txtput1,':', kssilt
       txtput1 = 'Kssand '
       write (lundia, '(2a,f12.6)') txtput1,':', kssand
    endif
    !
    do l = 1, lsedtot
       txtput1 = 'Sediment number'
       write (lundia, '(2a,i12)') txtput1, ':', l
       txtput1 = '  Name'
       write (lundia, '(3a)') txtput1, ': ', trim(namsed(l))
       txtput1 = '  Type'
       select case (sedtyp(l))
          case (SEDTYP_NONCOHESIVE_TOTALLOAD)
             write (lundia, '(2a,a12)') txtput1, ':', 'bedload'
          case (SEDTYP_NONCOHESIVE_SUSPENDED)
             write (lundia, '(2a,a12)') txtput1, ':', 'sand'
          case (SEDTYP_COHESIVE)
             write (lundia, '(2a,a12)') txtput1, ':', 'mud'
       end select
       if (sedtrcfac(l)>0.0_fp) then
           txtput1 = '  Tracer calibration factor '
           write (lundia, '(2a,e12.4)') txtput1, ':', sedtrcfac(l)
       endif
       txtput1 = '  RHOSOL'
       write (lundia, '(2a,e12.4)') txtput1, ':', rhosol(l)
       if (flsdia /= ' ') then
          !
          ! One sediment diameter between 0 and 100%
          !
          write (lundia, '(3a)') txtput1, ':  ', 'lognormal'
          if (comparereal(logsedsig(l),rmissval) == 0) then
             !
             ! no standard deviation specified: use default geometric
             ! standard deviation of 1.34 which is in the middle of the
             ! range of sigma_g values representing "well sorted" mixtures
             ! indicated in Blott & Pye, 2001. Earth Surface Processes
             ! and Landforms 26, p. 1237-1248.
             !
             logsedsig(l) = log(1.34)
          endif
          !
          nseddia(l) = -999
          txtput1 = '  geom. st. dev.'
          write (lundia, '(2a,e12.4)') txtput1, ':', exp(logsedsig(l))
          txtput1 = '  SedD50'
          write (lundia, '(3a)') txtput1, ':  ', trim(flsdia)
       elseif (sedtyp(l) /= SEDTYP_COHESIVE) then
          !
          ! Determine various sediment diameters in case of
          ! sand or bedload.
          !
          txtput1 = '  sed. distribution'
          if (nseddia(l) == 0) then
             !
             ! error: no sediment diameter specified!
             !
             errmsg = 'Missing sediment diameter data'
             call write_error(errmsg, unit=lundia)
             error = .true.
             return
          elseif (nseddia(l) == 1) then
             !
             ! Just one sediment diameter
             !
             if (nint(logseddia(1,1,l)) == 0) then
                !
                ! error: only minimum sediment diameter is insufficient
                !
                errmsg = 'Missing maximum diameter data'
                call write_error(errmsg, unit=lundia)
                error = .true.
                return
             elseif (nint(logseddia(1,1,l)) == 100) then
                !
                ! error: only maximum sediment diameter is insufficient
                !
                errmsg = 'Missing minimum diameter data'
                call write_error(errmsg, unit=lundia)
                error = .true.
                return
             endif
             !
             ! One sediment diameter between 0 and 100%
             !
             if (comparereal(sedpar%version,3.0_fp) >= 0) then
                !
                ! New behaviour: lognormal distribution
                !
                write (lundia, '(3a)') txtput1, ':  ', 'lognormal'
                if (comparereal(logsedsig(l),rmissval) == 0) then
                   !
                   ! no standard deviation specified: use default geometric
                   ! standard deviation of 1.34 which is in the middle of the
                   ! range of sigma_g values representing "well sorted" mixtures
                   ! indicated in Blott & Pye, 2001. Earth Surface Processes
                   ! and Landforms 26, p. 1237-1248.
                   !
                   logsedsig(l) = log(1.34)
                endif
                txtput1 = '  geom. st. dev.'
                write (lundia, '(2a,e12.4)') txtput1, ':', exp(logsedsig(l))
                !
                ! Approximate lognormal distribution using the following
                ! percentiles:
                ! 0.1 (set to 0) --- ilognormal --- 99.9 (set to 100)
                !
                logsedd50        = logseddia(2,1,l) - logsedsig(l)*lognormal(nint(logseddia(1,1,l)))
                logseddia(1,1,l) = 0.0_fp
                logseddia(2,1,l) = logsedd50 - 3.0_fp*logsedsig(l)
                n = 1
                do i = 1, size(ilognormal)
                   n = n + 1
                   logseddia(1,n,l) = real(ilognormal(i),fp)
                   logseddia(2,n,l) = logsedd50 + lognormal(ilognormal(i))*logsedsig(l)
                enddo
                n = n + 1
                logseddia(1,n,l) = 100.0_fp
                logseddia(2,n,l) = logsedd50 + 3.0_fp*logsedsig(l)
                nseddia(l)       = n
                !
                ! Compute characteristic sediment diameters
                !
                sedd50(l) = exp(logsedd50)
                sedd10(l) = exp(logsedd50 + lognormal(10)*logsedsig(l))
                sedd90(l) = exp(logsedd50 + lognormal(90)*logsedsig(l))
                seddm(l)  = exp(logsedd50 + 0.5_fp*logsedsig(l)*logsedsig(l))
             else
                !
                ! Old behaviour: D10 = 0.75 * D50, D90 = 1.5 * D50
                ! Piecewise loguniform approach: requires D50
                !
                if (nint(logseddia(1,1,l)) /= 50) then
                   !
                   ! error: old approach requires D50
                   !
                   errmsg = 'Missing median diameter data'
                   call write_error(errmsg, unit=lundia)
                   error = .true.
                   return
                endif
                !
                write (lundia, '(3a)') txtput1, ':  ', 'piecewise loguniform'
                !
                nseddia(l)       = 3
                logseddia(1,2,l) = 50.0_fp
                logseddia(2,2,l) = logseddia(2,1,l)
                !
                logseddia(1,1,l) = 0.0_fp
                logseddia(2,1,l) = logseddia(2,2,l) + 5.0_fp*log(0.75_fp)/4.0_fp
                !
                logseddia(1,3,l) = 100.0_fp
                logseddia(2,3,l) = logseddia(2,2,l) + 5.0_fp*log(1.5_fp)/4.0_fp
                !
                ! Compute characteristic sediment diameters
                !
                sedd50(l) = exp(logseddia(2,2,l))
                sedd10(l) = 0.75_fp * sedd50(l)
                sedd90(l) = 1.50_fp * sedd50(l)
                !
                seddm(l)  = 0.0_fp
                logsedsig(l) = 0.0_fp
                xm = 0.0_fp
                do n = 2, nseddia(l)
                   xxinv    = logseddia(1,n,l) - logseddia(1,n-1,l)
                   seddm(l) = seddm(l) &
                            & + xxinv * (exp(logseddia(2,n,l)) - exp(logseddia(2,n-1,l))) &
                            & / (logseddia(2,n,l) - logseddia(2,n-1,l))
                   logsedsig(l) = logsedsig(l) + xxinv * (&
                                & (logseddia(2,n,l)-logseddia(2,n-1,l))/sqrt(3.0_fp)/2.0_fp &
                                & + ((logseddia(2,n,l)+logseddia(2,n-1,l))/2.0_fp)**2 &
                                & )
                   xm = xm + xxinv * (logseddia(2,n,l)+logseddia(2,n-1,l))/2.0_fp
                enddo
                seddm(l) = seddm(l) / 100.0_fp
                xm = xm / 100.0_fp
                logsedsig(l) = logsedsig(l) / 100.0_fp - xm**2
             endif
          elseif (nseddia(l) == 2) then
             !
             ! Two sediment diameters specified
             !
             if (comparereal(logsedsig(l),rmissval) /= 0) then
                !
                ! standard deviation specified
                ! error: not allowed in combination with multiple
                ! sediment diameters
                !
                errmsg = 'Geom. st. dev. not allowed in combination with multiple sediment diameters'
                call write_error(errmsg, unit=lundia)
                error = .true.
                return
             endif
             if (nint(logseddia(1,1,l))==0 .or. nint(logseddia(1,2,l))==100) then
                !
                ! Minimum or maximum sediment diameter given:
                ! loguniform distribution
                !
                write (lundia, '(3a)') txtput1, ':  ', 'loguniform'
                !
                ! Compute characteristic sediment diameters
                !
                if (nint(logseddia(1,1,l)) > 0) then
                   !
                   ! Only maximum sediment diameter given and some
                   ! percentile: compute minimum sediment diameter.
                   !
                   xxinv            = 1.0_fp / (1.0_fp - (real(logseddia(1,1,l),fp)/100.0_fp))
                   logseddia(2,1,l) = logseddia(2,1,l)*xxinv + logseddia(2,2,l)*(1.0_fp-xxinv)
                   logseddia(1,1,l) = 0.0_fp
                elseif (nint(logseddia(1,2,l)) < 100) then
                   !
                   ! Only minimum sediment diameter given and some
                   ! percentile: compute maximum sediment diameter.
                   !
                   xxinv            = 100.0_fp / real(logseddia(1,2,l),fp)
                   logseddia(2,2,l) = logseddia(2,2,l)*xxinv + logseddia(2,1,l)*(1.0_fp-xxinv)
                   logseddia(1,2,l) = 100.0_fp
                endif
                !
                ! Both minimum and maximum sediment diameters given
                !
                sedd50(l) = exp(0.5_fp*logseddia(2,1,l) + 0.5_fp*logseddia(2,2,l))
                sedd10(l) = exp(0.9_fp*logseddia(2,1,l) + 0.1_fp*logseddia(2,2,l))
                sedd90(l) = exp(0.1_fp*logseddia(2,1,l) + 0.9_fp*logseddia(2,2,l))
                seddm(l)  = (exp(logseddia(2,2,l)) - exp(logseddia(2,1,l))) / &
                          & (logseddia(2,2,l) - logseddia(2,1,l))
                logsedsig(l) = (logseddia(2,2,l) - logseddia(2,1,l))/sqrt(3.0_fp)/2.0_fp
             else
                !
                ! Neither minimum nor maximum sediment diameter given:
                ! lognormal distribution
                !
                write (lundia, '(3a)') txtput1, ':  ', 'lognormal'
                !
                ! Compute geometric standard deviation
                !
                logsedsig(l) = (logseddia(2,2,l) - logseddia(2,1,l))/ &
                             & (lognormal(nint(logseddia(1,2,l))) -   &
                             &  lognormal(nint(logseddia(1,1,l))))
                txtput1 = ' geom. stand. dev.'
                write (lundia, '(2a,e12.4)') txtput1, ':', exp(logsedsig(l))
                !
                ! Approximate lognormal distribution using the following
                ! percentiles:
                ! 0.1 (set to 0) --- ilognormal --- 99.9 (set to 100)
                !
                logsedd50        = logseddia(2,1,l) - logsedsig(l)*lognormal(nint(logseddia(1,1,l)))
                logseddia(1,1,l) = 0.0_fp
                logseddia(2,1,l) = logsedd50 - 3.0_fp*logsedsig(l)
                n = 1
                do i = 1, size(ilognormal)
                   n = n + 1
                   logseddia(1,n,l) = real(ilognormal(i),fp)
                   logseddia(2,n,l) = logsedd50 + lognormal(ilognormal(i))*logsedsig(l)
                enddo
                n = n + 1
                logseddia(1,n,l) = 100.0_fp
                logseddia(2,n,l) = logsedd50 + 3.0_fp*logsedsig(l)
                nseddia(l)       = n
                !
                ! Compute characteristic sediment diameters
                !
                sedd50(l) = exp(logsedd50)
                sedd10(l) = exp(logsedd50 + lognormal(10)*logsedsig(l))
                sedd90(l) = exp(logsedd50 + lognormal(90)*logsedsig(l))
                seddm(l)  = exp(logsedd50 + 0.5_fp*logsedsig(l)*logsedsig(l))
             endif
          else
             !
             ! More than two sediment diameters specified
             !
             if (comparereal(logsedsig(l),rmissval) /= 0) then
                !
                ! standard deviation specified
                ! error: not allowed in combination with multiple
                ! sediment diameters
                !
                errmsg = 'Geom. std. dev. not allowed in combination with multiple sediment diameters'
                call write_error(errmsg, unit=lundia)
                error = .true.
                return
             endif
             !
             ! Always piecewise loguniform distribution
             !
             write (lundia, '(3a)') txtput1, ':  ', 'piecewise loguniform'
             !
             ! Compute characteristic sediment diameters
             !
             if (nint(logseddia(1,1,l)) > 0) then
                !
                ! sediment diameter table does not include sedmindia
                ! replace the first entry by extending the first loguniform range
                ! by keeping the density constant
                !
                xxinv            =  real(logseddia(1,2,l),fp) / &
                                 & (real(logseddia(1,2,l),fp) - real(logseddia(1,1,l),fp))
                logseddia(2,1,l) = logseddia(2,1,l)*xxinv + logseddia(2,2,l)*(1.0_fp-xxinv)
                logseddia(1,1,l) = 0.0_fp
             endif
             n = nseddia(l)
             if (nint(logseddia(1,n,l)) < 100) then
                !
                ! sediment diameter table does not include sedmaxdia
                ! replace the last entry by extending the last loguniform range
                ! by keeping the density constant
                !
                xxinv            = (100.0_fp - real(logseddia(1,n-1,l),fp)) / &
                                 & (real(logseddia(1,n,l),fp) - real(logseddia(1,n-1,l),fp))
                logseddia(2,n,l) = logseddia(2,n,l)*xxinv + logseddia(2,n-1,l)*(1.0_fp-xxinv)
                logseddia(1,n,l) = 100.0_fp
             endif
             !
             seddm(l)  = 0.0_fp
             do n = 2, nseddia(l)
                xxinv    = logseddia(1,n,l) - logseddia(1,n-1,l)
                seddm(l) = seddm(l) &
                         & + xxinv * (exp(logseddia(2,n,l)) - exp(logseddia(2,n-1,l))) &
                         & / (logseddia(2,n,l) - logseddia(2,n-1,l))
                xxinv    = 1.0_fp / xxinv
                if (logseddia(1,n-1,l) < 10.0_fp .and. logseddia(1,n,l) >= 10.0_fp) then
                   sedd10(l) = exp(logseddia(2,n-1,l)*((logseddia(1,n,l)-10.0_fp)*xxinv) + &
                                 & logseddia(2,n,l)*((10.0_fp-logseddia(1,n-1,l))*xxinv))
                endif
                if (logseddia(1,n-1,l) < 50.0_fp .and. logseddia(1,n,l) >= 50.0_fp) then
                   sedd50(l) = exp(logseddia(2,n-1,l)*((logseddia(1,n,l)-50.0_fp)*xxinv) + &
                                 & logseddia(2,n,l)*((50.0_fp-logseddia(1,n-1,l))*xxinv))
                endif
                if (logseddia(1,n-1,l) < 90.0_fp .and. logseddia(1,n,l) >= 90.0_fp) then
                   sedd90(l) = exp(logseddia(2,n-1,l)*((logseddia(1,n,l)-90.0_fp)*xxinv) + &
                                 & logseddia(2,n,l)*((90.0_fp-logseddia(1,n-1,l))*xxinv))
                endif
             enddo
             seddm(l) = seddm(l) / 100.0_fp
          endif
          !
          ! convert percentages to fractions
          !
          do n = 1, nseddia(l)
             logseddia(1,n,l) = logseddia(1,n,l) / 100.0_fp
          enddo
          !
          txtput1 = '  SedD10'
          write (lundia, '(2a,e12.4)') txtput1, ':', sedd10(l)
          txtput1 = '  SedD50'
          write (lundia, '(2a,e12.4)') txtput1, ':', sedd50(l)
          txtput1 = '  SedDM'
          write (lundia, '(2a,e12.4)') txtput1, ':', seddm(l)
          txtput1 = '  SedD90'
          write (lundia, '(2a,e12.4)') txtput1, ':', sedd90(l)
       endif
       txtput1 = '  CDRYB'
       write (lundia, '(2a,e12.4)') txtput1, ':', cdryb(l)
       if (flsdbd(l) /= ' ') then
          if (inisedunit(l) == 'kg/m2') then
             txtput1 = '  File IniCon'
          else
             txtput1 = '  File IniThick'
          endif
          write (lundia, '(3a)') txtput1, ':  ', trim(flsdbd(l))
       else
          if (inisedunit(l) == 'kg/m2') then
             txtput1 = '  Uniform IniCon'
             txtput2 = ' [kg/m2]'
          else
             txtput1 = '  Uniform IniThick'
             txtput2 = ' [m]'
          endif
          write (lundia, '(2a,e12.4,a)') txtput1, ':', sdbuni(l), trim(txtput2)
       endif
       if (l <= lsed) then
          txtput1 = '  FACDSS'
          write (lundia, '(2a,e12.4)') txtput1, ':', facdss(l)
          if (facdss(l) <= 0.0_fp) then
             errmsg = 'FACDSS <= 0.0'
             call write_error(errmsg, unit=lundia)
             error = .true.
             return
          endif
          !
          if (lsedtot==1 .and. flsdia/=' ') then ! l=1
             !
             ! Wrong: do nm=1,size(sedd50fld)
             ! nm goes from nmlb (negative!) to nmub
             !
             do nm = lbound(sedd50fld,1), ubound(sedd50fld,1)
                dss(nm, 1) = sedd50fld(nm)*facdss(1)
             enddo
          else
             dss(:, l) = sedd50(l)*facdss(l)
          endif
       endif
       !
       call echotrafrm(lundia      ,trapar     ,l         )
       !
       if (iform_settle(l) == 1) then
          txtput1 = '  SALMAX'
          write (lundia, '(2a,e12.4)') txtput1, ':', par_settle(1,l)
          txtput1 = '  WS0'
          write (lundia, '(2a,e12.4)') txtput1, ':', par_settle(2,l)
          txtput1 = '  WSM'
          write (lundia, '(2a,e12.4)') txtput1, ':', par_settle(3,l)
       elseif (iform_settle(l) == 2) then
          if (iform(l) == -2) then
             iform_settle(l) = -2
             txtput1 = '  SALMAX'
             write (lundia, '(2a,e12.4)') txtput1, ':', par_settle(1,l)
             txtput1 = '  Flocculation factor GamFloc'
             write (lundia, '(2a,e12.4)') txtput1, ':', par_settle(2,l)
          endif
       elseif (iform_settle(l) == 15) then
          !
          ! User defined settling velocity function
          !
          txtput1 = '  Settle library'
          write (lundia, '(3a)') txtput1, ': ', trim(dll_name_settle(l))
          txtput1 = '  Function in Settle lib'
          write (lundia, '(3a)') txtput1, ': ', trim(dll_function_settle(l))
          if (dll_usrfil_settle(l) /= ' ') then
             txtput1 = '  Input for Settle function'
             write (lundia, '(3a)') txtput1, ': ', trim(dll_usrfil_settle(l))
          endif
       endif
    enddo
    !
    write (lundia, '(a)') '*** End    of sediment input'
    write (lundia, *)
end subroutine echosed

subroutine count_sed(lundia    ,error     ,lsed      ,lsedtot   , &
                   & filsed    ,sedpar    ,sed_ptr   )
!!--description-----------------------------------------------------------------
!
! - Determines number of sediment fractions from sediment input file
!
!!--declarations----------------------------------------------------------------
    use properties
    use string_module
    use message_module
    use sediment_basics_module
    use morphology_data_module
    !
    implicit none
!
! Call variables
!
    integer                         , intent(out) :: lsed    ! Number of suspended sediment fractions
    integer                         , intent(out) :: lsedtot ! Total number of sediment fractions
    integer                         , intent(in)  :: lundia  ! Unit of diagnostic file
    logical                         , intent(out) :: error
    character(len=*)                , intent(in)  :: filsed
    type(sedpar_type)               , pointer     :: sedpar
    type(tree_data)                 , pointer     :: sed_ptr
!
! Local variables
!
    integer                                                :: i
    integer                                                :: ibl
    integer                                                :: istat
    integer                                                :: j
    integer                                                :: lsedbl        ! Number of bedload fractions
    integer                                                :: sedtypnr
    integer         , dimension(:) , allocatable           :: typsedim      ! Type of the sediments
    logical                                                :: found
    character(20)                                          :: versionstring
    character(20)   , dimension(:) , allocatable           :: namsedim      ! Names of the sediments as read from sed-file
    character(20)                                          :: sedtyptmp     ! Sediment type in sed-file
    character(80)                                          :: parname
    character(300)                                         :: message
    type(tree_data)                            , pointer   :: asedblock_ptr
!
!! executable statements -------------------------------------------------------
!
    lsedbl        = 0
    lsed          = 0
    lsedtot       = 0
    istat         = 0
    error         = .false.
    !
    ! Check 'Filsed' record for attribute file containing parameters
    ! for sediment transport computation
    !
    if (filsed == ' ') then
       !
       ! file does not exist
       !
       message = 'No sediment file name specified.'
       call write_error(message,unit=lundia)
       error = .true.
       return
    endif
    !
    ! Read sed-file into tree data structure
    !
    call prop_file('ini', trim(filsed), sed_ptr, istat)
    if (istat /= 0) then
       select case (istat)
       case(1)
          call write_error(FILE_NOT_FOUND//trim(filsed), unit=lundia)
       case(3)
          call write_error(PREMATURE_EOF//trim(filsed), unit=lundia)
       case default
          call write_error(FILE_READ_ERROR//trim(filsed), unit=lundia)
       endselect
       error = .true.
       return
    endif
    !
    if ( .not.associated(sed_ptr%child_nodes) ) then
       call write_error(FILE_READ_ERROR//trim(filsed), unit=lundia)
       error = .true.
       return
    endif
    !
    ! Check version number of sed input file
    !
    versionstring = ' '
    call prop_get_string(sed_ptr, 'SedimentFileInformation', 'FileVersion', versionstring)
    if (trim(versionstring) == '02.00') then
       !
       ! allocate temporary arrays with length equal to the number of data blocks in the file
       ! the sediment blocks will be a subset of that
       !
       allocate(namsedim(size(sed_ptr%child_nodes)))
       allocate(typsedim(size(sed_ptr%child_nodes)))
       namsedim = ' '
       typsedim = -999
       !
       do j = 1, size(sed_ptr%child_nodes)
          !
          ! Does sed_ptr contain a child with name 'Sediment' (converted to lower case)?
          !
          asedblock_ptr => sed_ptr%child_nodes(j)%node_ptr
          parname = tree_get_name( asedblock_ptr )
          if (parname == 'sediment') then
             parname = ' '
             call prop_get_string(asedblock_ptr, '*', 'Name', parname)
             !
             ! Check if the same sediment name was used before
             !
             found = .false.
             do i = 1, j-1
                if (strcmpi(parname,namsedim(i))) then
                   found = .true.
                   exit
                endif
             enddo
             if (found) then
                message = 'Sediment #'//trim(parname)//'# is specified more than once in sediment file '//trim(filsed)
                call write_error(message, unit=lundia)
                error = .true.
                return
             endif
             !
             ! Determine sediment type
             !
             sedtyptmp = ' '
             call prop_get_string(asedblock_ptr, '*', 'SedTyp', sedtyptmp)
             call small(sedtyptmp, 999)
             !
             if (index(sedtyptmp, 'mud') == 1) then
                sedtypnr = SEDTYP_COHESIVE
                lsed = lsed+1
             elseif (index(sedtyptmp, 'sand') == 1) then
                sedtypnr = SEDTYP_NONCOHESIVE_SUSPENDED
                lsed = lsed+1
             elseif (index(sedtyptmp,'bedload') == 1) then
                sedtypnr = SEDTYP_NONCOHESIVE_TOTALLOAD
                lsedbl = lsedbl+1
             else
                message = 'Sediment type of '//trim(parname)//' invalid: '//trim(sedtyptmp)
                call write_error(message,unit=lundia)
                error = .true.
                return
             endif
             !
             namsedim(j) = parname
             typsedim(j) = sedtypnr
          endif
       enddo
    else
       !
       ! sediment input version is 0 or 1:
       ! No keywords and no bedload option
       !
       lsedbl = 0
       call count_sed01(lundia    ,error     ,lsed      ,filsed    , &
                      & namsedim  ,typsedim  )
    endif
    lsedtot = lsed + lsedbl
    !
    ! rhosol, namsed and sedtyp must always be allocated
    !
                    allocate (sedpar%rhosol(lsedtot), stat = istat)
    if (istat == 0) allocate (sedpar%namsed(lsedtot), stat = istat)
    if (istat == 0) allocate (sedpar%sedtyp(lsedtot), stat = istat)
    if (istat == 0) allocate (sedpar%flnrd(0:lsedtot), stat = istat)
    if (istat /= 0) then
       call write_error('Memory allocation error in COUNT_SED', unit=lundia)
    endif
    !
    i   = 1
    ibl = lsed+1
    do j = 1,size(typsedim)
       select case (typsedim(j))
          case (SEDTYP_NONCOHESIVE_TOTALLOAD)
             sedpar%namsed(ibl) = namsedim(j)
             sedpar%sedtyp(ibl) = typsedim(j)
             ibl = ibl+1
          case (SEDTYP_NONCOHESIVE_SUSPENDED, SEDTYP_COHESIVE)
             sedpar%namsed(i) = namsedim(j)
             sedpar%sedtyp(i) = typsedim(j)
             i = i+1
          case default
             ! not a sediment block, so continue
       end select
    enddo
    !
    deallocate(namsedim)
    deallocate(typsedim)
end subroutine count_sed

subroutine count_sed01(lundia    ,error     ,lsed      ,filsed    , &
                     & namsedim  ,typsedim  )
!!--description-----------------------------------------------------------------
!
! - Determines number of sediment fractions from sediment input file
!   supports both VERSION 0 and VERSION 1
!
!!--declarations----------------------------------------------------------------
    use string_module
    use message_module
    use sediment_basics_module
    !
    implicit none
!
! Call variables
!
    integer                         , intent(out) :: lsed     ! Number of suspended sediment fractions
    integer                         , intent(in)  :: lundia   ! Unit of diagnostic file
    character(*)                                  :: filsed
    logical                         , intent(out) :: error    ! error flag
    integer         , dimension(:) , allocatable  :: typsedim ! Type of the sediments
    character(20)   , dimension(:) , allocatable  :: namsedim ! Names of the sediments as read from sed-file
!
! Local variables
!
    integer                                                :: i
    integer                                                :: iocond
    integer                                                :: l
    integer                                                :: luninp   ! Unit of .sed file
    integer                                                :: npar
    integer                                                :: version  ! version number (0 or 1)
    character(20)                                          :: sedtyptmp     ! Sediment type in sed-file
    character(300)                                         :: line
    character(300)                                         :: errmsg
!
!! executable statements -------------------------------------------------------
!
    error  = .false.
    call opensedfil(lundia    ,error     ,filsed    ,luninp    ,version  )
    if (error) return
    !
    read (luninp, *, iostat = iocond) lsed ! skip other parameters on line
    !
    allocate(namsedim(lsed))
    allocate(typsedim(lsed))
    !
    do l = 1, lsed
       write(namsedim(l),'(a,1i0)') 'sed.fraction ',l
       read (luninp, '(a)', iostat = iocond) sedtyptmp
       if (iocond == 0) then
          call str_lower(sedtyptmp)
          if (index(sedtyptmp, 'sand') == 1) then
              typsedim(l) = SEDTYP_NONCOHESIVE_SUSPENDED
          elseif (index(sedtyptmp, 'mud') == 1) then
              typsedim(l) = SEDTYP_COHESIVE
          else
             errmsg = 'Invalid suspended sediment type (must start with sand or mud)'
             call write_error(errmsg, unit=lundia)
             error = .true.
             goto 999
          endif
       endif
       !
       ! number of parameter values is 10 for version 0 and 11 for version 1 files
       !
       npar = 10+version
       do i = 1,npar
          read (luninp, *, iostat = iocond) line
          if (iocond /= 0) then
             write(errmsg,'(A,I0)') 'Error reading parameters for sediment fraction',l
             call write_error(errmsg, unit=lundia)
             error = .true.
             goto 999
          endif
       enddo
    enddo
    !
999 continue
    close (luninp)
end subroutine count_sed01

end module m_rdsed


MODULE istate
  USE oce
  USE dom_oce
  USE daymod
  USE divhor
  USE dtatsd
  USE dtauvd
  USE domvvl
  USE iscplrst
  USE wet_dry
  USE usrdef_istate
  USE in_out_manager
  USE iom
  USE lib_mpp
  USE restart
  IMPLICIT NONE
  PRIVATE
  PUBLIC :: istate_init
  CONTAINS
  SUBROUTINE istate_init
    INTEGER :: ji, jj, jk
    REAL(KIND = wp), ALLOCATABLE, DIMENSION(:, :, :, :) :: zuvd
    IF (lwp) WRITE(numout, FMT = *)
    IF (lwp) WRITE(numout, FMT = *) 'istate_init : Initialization of the dynamics and tracers'
    IF (lwp) WRITE(numout, FMT = *) '~~~~~~~~~~~'
    CALL dta_tsd_init
    !$ACC KERNELS
    rhd(:, :, :) = 0._wp
    rhop(:, :, :) = 0._wp
    rn2b(:, :, :) = 0._wp
    rn2(:, :, :) = 0._wp
    tsa(:, :, :, :) = 0._wp
    rab_b(:, :, :, :) = 0._wp
    rab_n(:, :, :, :) = 0._wp
    !$ACC END KERNELS
    IF (ln_rstart) THEN
      CALL rst_read
      IF (ln_iscpl) CALL iscpl_stp
      CALL day_init
    ELSE
      numror = 0
      neuler = 0
      CALL day_init
      IF (ln_tsd_init) THEN
        CALL dta_tsd(nit000, tsb)
        !$ACC KERNELS
        sshb(:, :) = 0._wp
        ub(:, :, :) = 0._wp
        vb(:, :, :) = 0._wp
        !$ACC END KERNELS
      ELSE
        CALL usr_def_istate(gdept_b, tmask, tsb, ub, vb, sshb)
      END IF
      !$ACC KERNELS
      tsn(:, :, :, :) = tsb(:, :, :, :)
      sshn(:, :) = sshb(:, :)
      un(:, :, :) = ub(:, :, :)
      vn(:, :, :) = vb(:, :, :)
      hdivn(:, :, jpk) = 0._wp
      !$ACC END KERNELS
      CALL div_hor(0)
    END IF
    !$ACC KERNELS
    un_b(:, :) = 0._wp
    vn_b(:, :) = 0._wp
    ub_b(:, :) = 0._wp
    vb_b(:, :) = 0._wp
    DO jk = 1, jpkm1
      DO jj = 1, jpj
        DO ji = 1, jpi
          un_b(ji, jj) = un_b(ji, jj) + e3u_n(ji, jj, jk) * un(ji, jj, jk) * umask(ji, jj, jk)
          vn_b(ji, jj) = vn_b(ji, jj) + e3v_n(ji, jj, jk) * vn(ji, jj, jk) * vmask(ji, jj, jk)
          ub_b(ji, jj) = ub_b(ji, jj) + e3u_b(ji, jj, jk) * ub(ji, jj, jk) * umask(ji, jj, jk)
          vb_b(ji, jj) = vb_b(ji, jj) + e3v_b(ji, jj, jk) * vb(ji, jj, jk) * vmask(ji, jj, jk)
        END DO
      END DO
    END DO
    un_b(:, :) = un_b(:, :) * r1_hu_n(:, :)
    vn_b(:, :) = vn_b(:, :) * r1_hv_n(:, :)
    ub_b(:, :) = ub_b(:, :) * r1_hu_b(:, :)
    vb_b(:, :) = vb_b(:, :) * r1_hv_b(:, :)
    !$ACC END KERNELS
  END SUBROUTINE istate_init
END MODULE istate


MODULE iscplrst
  USE oce
  USE dom_oce
  USE domwri
  USE domvvl, ONLY: dom_vvl_interpol
  USE phycst
  USE sbc_oce
  USE iscplini
  USE iscplhsb
  USE in_out_manager
  USE iom
  USE lib_mpp
  USE lib_fortran
  USE lbclnk
  IMPLICIT NONE
  PRIVATE
  PUBLIC :: iscpl_stp
  CONTAINS
  SUBROUTINE iscpl_stp
    INTEGER :: inum0
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: zsmask_b
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk) :: ztmask_b, zumask_b, zvmask_b
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk) :: ze3t_b, ze3u_b, ze3v_b
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk) :: zdepw_b
    CHARACTER(LEN = 20) :: cfile
    CALL iom_get(numror, jpdom_autoglo, 'tmask', ztmask_b, ldxios = lrxios)
    CALL iom_get(numror, jpdom_autoglo, 'umask', zumask_b, ldxios = lrxios)
    CALL iom_get(numror, jpdom_autoglo, 'vmask', zvmask_b, ldxios = lrxios)
    CALL iom_get(numror, jpdom_autoglo, 'smask', zsmask_b, ldxios = lrxios)
    CALL iom_get(numror, jpdom_autoglo, 'e3t_n', ze3t_b(:, :, :), ldxios = lrxios)
    CALL iom_get(numror, jpdom_autoglo, 'e3u_n', ze3u_b(:, :, :), ldxios = lrxios)
    CALL iom_get(numror, jpdom_autoglo, 'e3v_n', ze3v_b(:, :, :), ldxios = lrxios)
    CALL iom_get(numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:, :, :), ldxios = lrxios)
    CALL iscpl_init
    CALL iscpl_rst_interpol(ztmask_b, zumask_b, zvmask_b, zsmask_b, ze3t_b, ze3u_b, ze3v_b, zdepw_b)
    IF (ln_hsb) THEN
      IF (iscpl_alloc() /= 0) CALL ctl_stop('STOP', 'rst_iscpl : unable to allocate rst_iscpl arrays')
      CALL iscpl_cons(ztmask_b, zsmask_b, ze3t_b, htsc_iscpl, hdiv_iscpl, rdt_iscpl)
    END IF
    IF (ln_meshmask .AND. ln_iscpl) CALL dom_wri
    IF (ln_hsb) THEN
      cfile = 'correction'
      cfile = TRIM(cfile)
      CALL iom_open(cfile, inum0, ldwrt = .TRUE., kiolib = jprstlib)
      CALL iom_rstput(0, 0, inum0, 'vol_cor', hdiv_iscpl(:, :, :))
      CALL iom_rstput(0, 0, inum0, 'tem_cor', htsc_iscpl(:, :, :, jp_tem))
      CALL iom_rstput(0, 0, inum0, 'sal_cor', htsc_iscpl(:, :, :, jp_sal))
      CALL iom_close(inum0)
    END IF
    !$ACC KERNELS
    neuler = 0
    tsb(:, :, :, :) = tsn(:, :, :, :)
    ub(:, :, :) = un(:, :, :)
    vb(:, :, :) = vn(:, :, :)
    sshb(:, :) = sshn(:, :)
    e3t_b(:, :, :) = e3t_n(:, :, :)
    e3u_b(:, :, :) = e3u_n(:, :, :)
    e3v_b(:, :, :) = e3v_n(:, :, :)
    e3uw_b(:, :, :) = e3uw_n(:, :, :)
    e3vw_b(:, :, :) = e3vw_n(:, :, :)
    gdept_b(:, :, :) = gdept_n(:, :, :)
    gdepw_b(:, :, :) = gdepw_n(:, :, :)
    hu_b(:, :) = hu_n(:, :)
    hv_b(:, :) = hv_n(:, :)
    r1_hu_b(:, :) = r1_hu_n(:, :)
    r1_hv_b(:, :) = r1_hv_n(:, :)
    !$ACC END KERNELS
  END SUBROUTINE iscpl_stp
  SUBROUTINE iscpl_rst_interpol(ptmask_b, pumask_b, pvmask_b, psmask_b, pe3t_b, pe3u_b, pe3v_b, pdepw_b)
    REAL(KIND = wp), DIMENSION(:, :, :), INTENT(IN ) :: ptmask_b, pumask_b, pvmask_b
    REAL(KIND = wp), DIMENSION(:, :, :), INTENT(IN ) :: pe3t_b, pe3u_b, pe3v_b
    REAL(KIND = wp), DIMENSION(:, :, :), INTENT(IN ) :: pdepw_b
    REAL(KIND = wp), DIMENSION(:, :), INTENT(IN ) :: psmask_b
    INTEGER :: ji, jj, jk, iz
    INTEGER :: jip1, jim1, jjp1, jjm1, jkp1, jkm1
    REAL(KIND = wp) :: summsk, zsum, zsum1, zarea, zsumn, zsumb
    REAL(KIND = wp) :: zdz, zdzm1, zdzp1
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: zdmask, zsmask0, zucorr, zbub, zbun, zssh0, zhu1, zde3t
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: zdsmask, zsmask1, zvcorr, zbvb, zbvn, zssh1, zhv1
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk) :: ztmask0, zwmaskn, ztrp
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk) :: ztmask1, zwmaskb, ztmp3d
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk, jpts) :: zts0
    !$ACC KERNELS
    tsn(:, :, :, jp_tem) = tsn(:, :, :, jp_tem) * ptmask_b(:, :, :)
    tsn(:, :, :, jp_sal) = tsn(:, :, :, jp_sal) * ptmask_b(:, :, :)
    zwmaskn(:, :, 1) = tmask(:, :, 1)
    zwmaskb(:, :, 1) = ptmask_b(:, :, 1)
    DO jk = 2, jpk
      zwmaskn(:, :, jk) = tmask(:, :, jk) * tmask(:, :, jk - 1)
      zwmaskb(:, :, jk) = ptmask_b(:, :, jk) * ptmask_b(:, :, jk - 1)
    END DO
    sshb(:, :) = sshn(:, :)
    zssh0(:, :) = sshn(:, :)
    zsmask0(:, :) = psmask_b(:, :)
    zsmask1(:, :) = psmask_b(:, :)
    !$ACC END KERNELS
    DO iz = 1, 10
      !$ACC KERNELS
      zdsmask(:, :) = ssmask(:, :) - zsmask0(:, :)
      DO jj = 2, jpj - 1
        DO ji = 2, jpim1
          jip1 = ji + 1
          jim1 = ji - 1
          jjp1 = jj + 1
          jjm1 = jj - 1
          summsk = (zsmask0(jip1, jj) + zsmask0(jim1, jj) + zsmask0(ji, jjp1) + zsmask0(ji, jjm1))
          IF (zdsmask(ji, jj) == 1._wp .AND. summsk /= 0._wp) THEN
            sshn(ji, jj) = (zssh0(jip1, jj) * zsmask0(jip1, jj) + zssh0(jim1, jj) * zsmask0(jim1, jj) + zssh0(ji, jjp1) * zsmask0(ji, jjp1) + zssh0(ji, jjm1) * zsmask0(ji, jjm1)) / summsk
            zsmask1(ji, jj) = 1._wp
          END IF
        END DO
      END DO
      !$ACC END KERNELS
      CALL lbc_lnk_multi(sshn, 'T', 1., zsmask1, 'T', 1.)
      zssh0 = sshn
      zsmask0 = zsmask1
    END DO
    !$ACC KERNELS
    sshn(:, :) = sshn(:, :) * ssmask(:, :)
    !$ACC END KERNELS
    IF (.NOT. ln_linssh) THEN
      !$ACC KERNELS
      DO jk = 1, jpk
        DO jj = 1, jpj
          DO ji = 1, jpi
            IF (tmask(ji, jj, 1) == 0._wp .OR. ptmask_b(ji, jj, 1) == 0._wp) THEN
              e3t_n(ji, jj, jk) = e3t_0(ji, jj, jk) * (1._wp + sshn(ji, jj) / (ht_0(ji, jj) + 1._wp - ssmask(ji, jj)) * tmask(ji, jj, jk))
            END IF
          END DO
        END DO
      END DO
      !$ACC END KERNELS
      CALL dom_vvl_interpol(e3t_n(:, :, :), e3u_n(:, :, :), 'U')
      CALL dom_vvl_interpol(e3t_n(:, :, :), e3v_n(:, :, :), 'V')
      CALL dom_vvl_interpol(e3u_n(:, :, :), e3f_n(:, :, :), 'F')
      CALL dom_vvl_interpol(e3t_n(:, :, :), e3w_n(:, :, :), 'W')
      CALL dom_vvl_interpol(e3u_n(:, :, :), e3uw_n(:, :, :), 'UW')
      CALL dom_vvl_interpol(e3v_n(:, :, :), e3vw_n(:, :, :), 'VW')
      !$ACC KERNELS
      gdept_n(:, :, 1) = 0.5_wp * e3w_n(:, :, 1)
      gdepw_n(:, :, 1) = 0.0_wp
      gde3w_n(:, :, 1) = gdept_n(:, :, 1) - sshn(:, :)
      !$ACC END KERNELS
      DO jj = 1, jpj
        DO ji = 1, jpi
          !$ACC KERNELS
          DO jk = 2, mikt(ji, jj) - 1
            gdept_n(ji, jj, jk) = gdept_0(ji, jj, jk)
            gdepw_n(ji, jj, jk) = gdepw_0(ji, jj, jk)
            gde3w_n(ji, jj, jk) = gdept_0(ji, jj, jk) - sshn(ji, jj)
          END DO
          !$ACC END KERNELS
          IF (mikt(ji, jj) > 1) THEN
            jk = mikt(ji, jj)
            gdept_n(ji, jj, jk) = gdepw_0(ji, jj, jk) + 0.5_wp * e3w_n(ji, jj, jk)
            gdepw_n(ji, jj, jk) = gdepw_0(ji, jj, jk)
            gde3w_n(ji, jj, jk) = gdept_n(ji, jj, jk) - sshn(ji, jj)
          END IF
          !$ACC KERNELS
          DO jk = mikt(ji, jj) + 1, jpk
            gdept_n(ji, jj, jk) = gdept_n(ji, jj, jk - 1) + e3w_n(ji, jj, jk)
            gdepw_n(ji, jj, jk) = gdepw_n(ji, jj, jk - 1) + e3t_n(ji, jj, jk - 1)
            gde3w_n(ji, jj, jk) = gdept_n(ji, jj, jk) - sshn(ji, jj)
          END DO
          !$ACC END KERNELS
        END DO
      END DO
      !$ACC KERNELS
      ht_n(:, :) = 0._wp
      hu_n(:, :) = 0._wp
      hv_n(:, :) = 0._wp
      DO jk = 1, jpkm1
        hu_n(:, :) = hu_n(:, :) + e3u_n(:, :, jk) * umask(:, :, jk)
        hv_n(:, :) = hv_n(:, :) + e3v_n(:, :, jk) * vmask(:, :, jk)
        ht_n(:, :) = ht_n(:, :) + e3t_n(:, :, jk) * tmask(:, :, jk)
      END DO
      r1_hu_n(:, :) = 1._wp / (hu_n(:, :) + 1._wp - ssumask(:, :)) * ssumask(:, :)
      r1_hv_n(:, :) = 1._wp / (hv_n(:, :) + 1._wp - ssvmask(:, :)) * ssvmask(:, :)
      !$ACC END KERNELS
    END IF
    !$ACC KERNELS
    ub(:, :, :) = un(:, :, :)
    vb(:, :, :) = vn(:, :, :)
    DO jk = 1, jpk
      DO jj = 1, jpj
        DO ji = 1, jpi
          un(ji, jj, jk) = ub(ji, jj, jk) * pe3u_b(ji, jj, jk) * pumask_b(ji, jj, jk) / e3u_n(ji, jj, jk) * umask(ji, jj, jk)
          vn(ji, jj, jk) = vb(ji, jj, jk) * pe3v_b(ji, jj, jk) * pvmask_b(ji, jj, jk) / e3v_n(ji, jj, jk) * vmask(ji, jj, jk)
        END DO
      END DO
    END DO
    ztrp(:, :, :) = ub(:, :, :) * pe3u_b(:, :, :)
    !$ACC END KERNELS
    zbub(:, :) = SUM(ztrp, DIM = 3)
    !$ACC KERNELS
    ztrp(:, :, :) = vb(:, :, :) * pe3v_b(:, :, :)
    !$ACC END KERNELS
    zbvb(:, :) = SUM(ztrp, DIM = 3)
    !$ACC KERNELS
    ztrp(:, :, :) = un(:, :, :) * e3u_n(:, :, :)
    !$ACC END KERNELS
    zbun(:, :) = SUM(ztrp, DIM = 3)
    !$ACC KERNELS
    ztrp(:, :, :) = vn(:, :, :) * e3v_n(:, :, :)
    !$ACC END KERNELS
    zbvn(:, :) = SUM(ztrp, DIM = 3)
    !$ACC KERNELS
    zhu1 = 0.0_wp
    zhv1 = 0.0_wp
    DO jk = 1, jpk
      zhu1(:, :) = zhu1(:, :) + e3u_n(:, :, jk) * umask(:, :, jk)
      zhv1(:, :) = zhv1(:, :) + e3v_n(:, :, jk) * vmask(:, :, jk)
    END DO
    zucorr = 0._wp
    zvcorr = 0._wp
    DO jj = 1, jpj
      DO ji = 1, jpi
        IF (zbun(ji, jj) /= zbub(ji, jj) .AND. zhu1(ji, jj) /= 0._wp) THEN
          zucorr(ji, jj) = (zbun(ji, jj) - zbub(ji, jj)) / zhu1(ji, jj)
        END IF
        IF (zbvn(ji, jj) /= zbvb(ji, jj) .AND. zhv1(ji, jj) /= 0._wp) THEN
          zvcorr(ji, jj) = (zbvn(ji, jj) - zbvb(ji, jj)) / zhv1(ji, jj)
        END IF
      END DO
    END DO
    DO jk = 1, jpk
      un(:, :, jk) = (un(:, :, jk) - zucorr(:, :)) * umask(:, :, jk)
      vn(:, :, jk) = (vn(:, :, jk) - zvcorr(:, :)) * vmask(:, :, jk)
    END DO
    tsb(:, :, :, :) = tsn(:, :, :, :)
    zts0(:, :, :, :) = tsn(:, :, :, :)
    ztmask1(:, :, :) = ptmask_b(:, :, :)
    ztmask0(:, :, :) = ptmask_b(:, :, :)
    !$ACC END KERNELS
    DO iz = 1, nn_drown
      DO jk = 1, jpk - 1
        zdmask = tmask(:, :, jk) - ztmask0(:, :, jk)
        !$ACC KERNELS
        DO jj = 2, jpj - 1
          DO ji = 2, jpim1
            jip1 = ji + 1
            jim1 = ji - 1
            jjp1 = jj + 1
            jjm1 = jj - 1
            summsk = (ztmask0(jip1, jj, jk) + ztmask0(jim1, jj, jk) + ztmask0(ji, jjp1, jk) + ztmask0(ji, jjm1, jk))
            IF (zdmask(ji, jj) == 1._wp .AND. summsk /= 0._wp) THEN
              tsn(ji, jj, jk, 1) = (zts0(jip1, jj, jk, 1) * ztmask0(jip1, jj, jk) + zts0(jim1, jj, jk, 1) * ztmask0(jim1, jj, jk) + zts0(ji, jjp1, jk, 1) * ztmask0(ji, jjp1, jk) + zts0(ji, jjm1, jk, 1) * ztmask0(ji, jjm1, jk)) / summsk
              tsn(ji, jj, jk, 2) = (zts0(jip1, jj, jk, 2) * ztmask0(jip1, jj, jk) + zts0(jim1, jj, jk, 2) * ztmask0(jim1, jj, jk) + zts0(ji, jjp1, jk, 2) * ztmask0(ji, jjp1, jk) + zts0(ji, jjm1, jk, 2) * ztmask0(ji, jjm1, jk)) / summsk
              ztmask1(ji, jj, jk) = 1
            ELSE IF (zdmask(ji, jj) == 1._wp .AND. summsk == 0._wp) THEN
              jkm1 = MAX(1, jk - 1)
              jkp1 = MIN(jpk, jk + 1)
              summsk = (ztmask0(ji, jj, jkm1) + ztmask0(ji, jj, jkp1))
              IF (zdmask(ji, jj) == 1._wp .AND. summsk /= 0._wp) THEN
                tsn(ji, jj, jk, 1) = (zts0(ji, jj, jkp1, 1) * ztmask0(ji, jj, jkp1) + zts0(ji, jj, jkm1, 1) * ztmask0(ji, jj, jkm1)) / summsk
                tsn(ji, jj, jk, 2) = (zts0(ji, jj, jkp1, 2) * ztmask0(ji, jj, jkp1) + zts0(ji, jj, jkm1, 2) * ztmask0(ji, jj, jkm1)) / summsk
                ztmask1(ji, jj, jk) = 1._wp
              END IF
            END IF
          END DO
        END DO
        !$ACC END KERNELS
      END DO
      CALL lbc_lnk_multi(tsn(:, :, :, jp_tem), 'T', 1., tsn(:, :, :, jp_sal), 'T', 1., ztmask1, 'T', 1.)
      !$ACC KERNELS
      zts0(:, :, :, :) = tsn(:, :, :, :)
      ztmask0 = ztmask1
      !$ACC END KERNELS
    END DO
    !$ACC KERNELS
    tsn(:, :, :, jp_tem) = tsn(:, :, :, jp_tem) * tmask(:, :, :)
    tsn(:, :, :, jp_sal) = tsn(:, :, :, jp_sal) * tmask(:, :, :)
    !$ACC END KERNELS
    IF (.NOT. ln_linssh) THEN
      DO jk = 2, jpk - 1
        DO jj = 1, jpj
          DO ji = 1, jpi
            IF (zwmaskn(ji, jj, jk) * zwmaskb(ji, jj, jk) == 1._wp .AND. (tmask(ji, jj, 1) == 0._wp .OR. ptmask_b(ji, jj, 1) == 0._wp)) THEN
              zdzp1 = MAX(0._wp, gdepw_n(ji, jj, jk + 1) - pdepw_b(ji, jj, jk + 1))
              zdz = gdepw_n(ji, jj, jk + 1) - pdepw_b(ji, jj, jk)
              zdzm1 = MAX(0._wp, pdepw_b(ji, jj, jk) - gdepw_n(ji, jj, jk))
              IF (zdz .LT. 0._wp) THEN
                CALL ctl_stop('STOP', 'rst_iscpl : unable to compute the interpolation')
              END IF
              tsn(ji, jj, jk, jp_tem) = (zdzp1 * tsb(ji, jj, jk + 1, jp_tem) + zdz * tsb(ji, jj, jk, jp_tem) + zdzm1 * tsb(ji, jj, jk - 1, jp_tem)) / e3t_n(ji, jj, jk)
              tsn(ji, jj, jk, jp_sal) = (zdzp1 * tsb(ji, jj, jk + 1, jp_sal) + zdz * tsb(ji, jj, jk, jp_sal) + zdzm1 * tsb(ji, jj, jk - 1, jp_sal)) / e3t_n(ji, jj, jk)
            END IF
          END DO
        END DO
      END DO
    END IF
    WHERE (tmask(:, :, :) == 1._wp .AND. tsn(:, :, :, 2) == 0._wp)
      tsn(:, :, :, 2) = - 99._wp
      tmask(:, :, :) = 0._wp
      umask(:, :, :) = 0._wp
      vmask(:, :, :) = 0._wp
    END WHERE
    WHERE (SUM(tmask, dim = 3) == 0)
      mbkt(:, :) = 1
      mbku(:, :) = 1
      mbkv(:, :) = 1
      mikt(:, :) = 1
      miku(:, :) = 1
      mikv(:, :) = 1
    END WHERE
  END SUBROUTINE iscpl_rst_interpol
END MODULE iscplrst