subroutine getcel(filnam ,grpnam ,nelems ,elmnms ,elmdms , &
& elmqty ,elmunt ,elmdes ,elmtps ,nbytsg , &
& elmnam ,celidt ,wrilog ,error )
!----- GPL ---------------------------------------------------------------------
!
! Copyright (C) Stichting Deltares, 2011-2014.
!
! 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 .
!
! 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$
! $HeadURL$
!!--description-----------------------------------------------------------------
!
! Function: Detect the number of time steps on filnam (map-
! or his-file)
! Method used:
!
!!--pseudo code and references--------------------------------------------------
! NONE
!!--declarations----------------------------------------------------------------
use precision
use string_module
!
implicit none
!
! Global variables
!
integer :: celidt ! Description and declaration in nefisio.igs
integer :: error
!! Error flag for NEFIS files
integer :: nelems
!! Number of elements in this cell and
!! group.
integer, dimension(*) :: nbytsg
!! Array containing info about the size,
!! in bytes, of each element type
!! (ELMTPS). So for a REAL*4, this array
!! contains a 4. The size of the array
!! is (NELEMS).
integer, dimension(6, *) :: elmdms ! Description and declaration in nefisio.igs
logical, intent(in) :: wrilog
!! Flag to write file
!! .TRUE. : write to file
!! .FALSE.: read from file
character(*) :: elmnam
!! Name of element, who's values must
!! be written or read. This name must
!! be on of the set ELMNMS.
character(*), intent(in) :: filnam
!! Name for communication file
!! com-