!----- AGPL -------------------------------------------------------------------- ! ! Copyright (C) Stichting Deltares, 2015. ! ! This file is part of Delft3D (D-Flow Flexible Mesh component). ! ! Delft3D is free software: you can redistribute it and/or modify ! it under the terms of the GNU Affero General Public License as ! published by the Free Software Foundation version 3. ! ! Delft3D is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Affero General Public License for more details. ! ! You should have received a copy of the GNU Affero General Public License ! along with Delft3D. If not, see . ! ! contact: delft3d.support@deltares.nl ! Stichting Deltares ! P.O. Box 177 ! 2600 MH Delft, The Netherlands ! ! All indications and logos of, and references to, "Delft3D", ! "D-Flow Flexible Mesh" and "Deltares" are registered trademarks of Stichting ! Deltares, and remain the property of Stichting Deltares. All rights reserved. ! !------------------------------------------------------------------------------- ! $Id: filez.f90 42642 2015-10-21 11:34:20Z dam_ar $ ! $HeadURL: https://repos.deltares.nl/repos/ds/trunk/additional/unstruc/src/filez.f90 $ !> Opens an existing file for reading. !! !! When file does not exist or is already open, program stops with !! an error message. subroutine oldfil(minp, filename)!, istat) use unstruc_files implicit none integer, intent(out) :: minp !< New file pointer to opened file. character(*), intent(in) :: filename !< Name of the file to open. ! integer, optional, intent(out) :: istat integer :: istat_ integer :: i integer :: ifirstchar integer :: l2,l1 integer :: l3 integer, external :: numuni logical :: jawel istat_ = 0 l1 = max(1, ifirstchar(filename)) l2 = len_trim(filename) if (l2==0) then call err('Oldfil: Filename is empty for #', minp) istat_ = ERR_FILENOTEXIST goto 999 endif inquire (file = filename(l1:l2), exist = jawel) if (jawel) then do i = 1, maxnum l3 = max(1, len_trim(filenames(i))) if (filenames(i)(1:l3)==filename(l1:l2)) then call err('File: ', filename(l1:l2), ' already opened') istat_ = ERR_FILEALREADYOPEN goto 999 endif enddo minp = numuni() open (minp, file = filename(l1:l2)) call reg_file_open(minp, filename(l1:l2)) call mess(LEVEL_INFO, 'Opened file :', filename(l1:l2), ' ') elseif (ifirstchar(filename)==0) then call err('oldfil: Filename is empty for: '''//filename//'''') istat_ = ERR_FILENOTEXIST goto 999 else call err('File: ', filename(l1:l2), ' does not exist') istat_ = ERR_FILENOTEXIST goto 999 endif return 999 continue ! Upon error, reset file pointer. if (istat_ /= 0) then minp = 0 end if ! if (present(istat)) then ! istat = istat_ ! return ! endif end subroutine oldfil !> Closes a filepointer with proper bookkeeping. subroutine doclose(minp) use unstruc_files implicit none integer, intent(inout) :: minp if (minp == 0) return close (minp) call mess(LEVEL_INFO, 'Closed file : ', filenames(minp)) call reg_file_close(minp) minp = 0 end subroutine doclose subroutine zoekal(minp, rec, text, ja) use unstruc_messages implicit none integer, intent(in) :: minp character(len=*), intent(out) :: rec character(len=*), intent(in) :: text integer, intent(out) :: ja rewind (minp) 10 continue read (minp, '(a)', end = 999) rec if (index(rec, text)/=0) then call mess(LEVEL_INFO, 'found keyword: ', text) ja = 1 return endif goto 10 999 continue ja = 0 end subroutine zoekal !> Opens a new file for writing (and reading). !! !! When file already exists, it will be overwritten. !! When access is denied, program stops with an error message. subroutine newfil(minp, filename)!, istat) use unstruc_files implicit none integer, intent(out) :: minp !< New file pointer to opened file. character(*), intent(in) :: filename !< Name of the file to open. ! integer, optional, intent(out) :: istat integer :: istat_ integer :: i integer :: ifirstchar integer :: l2,l1 integer :: l3 integer, external :: numuni character(*) RW*20 istat_ = 0 l1 = max(1, ifirstchar(filename)) l2 = len_trim(filename) if (l2==0) then call err(' ', 'Newfil: filename is empty', ' ') istat_ = ERR_FILENOTEXIST goto 999 endif do i = 1, maxnum l3 = max(1, len_trim(filenames(i))) if (filenames(i)(1:l3)==filename(l1:l2)) then call err('File: ', filename(l1:l2), ' already opened') istat_ = ERR_FILEALREADYOPEN goto 999 endif enddo minp = numuni() open (minp, file = filename(l1:l2), action='readwrite', IOSTAT=istat_) inquire(minp, readwrite=rw) IF (istat_ .GT. 0 .or. trim(rw)/='YES') THEN call err('File: ', filename(l1:l2), ' could not be opened for writing.') istat_ = ERR_FILEACCESSDENIED goto 999 end if call reg_file_open(minp, filename(l1:l2)) call mess(LEVEL_INFO, 'Opened file : ', filename(l1:l2)) return 999 continue ! if (present(istat)) then ! istat = istat_ ! return ! endif end subroutine newfil function iwordlength(rec) !!--copyright------------------------------------------------------------------- ! Copyright (c) 2003, WL | Delft Hydraulics. All rights reserved. !!--disclaimer------------------------------------------------------------------ ! This code is part of the Delft3D software system. WL|Delft Hydraulics has ! developed c.q. manufactured this code to its best ability and according to the ! state of the art. Nevertheless, there is no express or implied warranty as to ! this software whether tangible or intangible. In particular, there is no ! express or implied warranty as to the fitness for a particular purpose of this ! software, whether tangible or intangible. The intellectual property rights ! related to this software code remain with WL|Delft Hydraulics at all times. ! For details on the licensing agreement, we refer to the Delft3D software ! license and any modifications to this license, if applicable. These documents ! are available upon request. !!--version information--------------------------------------------------------- ! $Author$ ! $Date$ ! $Revision$ !!--description----------------------------------------------------------------- ! NONE !!--pseudo code and references-------------------------------------------------- ! NONE !!--declarations---------------------------------------------------------------- implicit none ! ! Global variables ! integer :: iwordlength character(len=*), intent(in) :: rec ! ! ! Local variables ! integer :: i integer :: i1 integer :: len_trim integer :: l ! ! !! executable statements ------------------------------------------------------- ! ! ! GEEF LENGTE EERSTE WOORD l = len_trim(rec) iwordlength = l do i = 1, l i1 = index(' ', rec(i:i)) if (i1/=0) then iwordlength = i - 1 return endif enddo end function iwordlength subroutine nummer12(rec, i1, i2, num) !!--copyright------------------------------------------------------------------- ! Copyright (c) 2003, WL | Delft Hydraulics. All rights reserved. !!--disclaimer------------------------------------------------------------------ ! This code is part of the Delft3D software system. WL|Delft Hydraulics has ! developed c.q. manufactured this code to its best ability and according to the ! state of the art. Nevertheless, there is no express or implied warranty as to ! this software whether tangible or intangible. In particular, there is no ! express or implied warranty as to the fitness for a particular purpose of this ! software, whether tangible or intangible. The intellectual property rights ! related to this software code remain with WL|Delft Hydraulics at all times. ! For details on the licensing agreement, we refer to the Delft3D software ! license and any modifications to this license, if applicable. These documents ! are available upon request. !!--version information--------------------------------------------------------- ! $Author$ ! $Date$ ! $Revision$ !!--description----------------------------------------------------------------- ! NONE !!--pseudo code and references-------------------------------------------------- ! NONE !!--declarations---------------------------------------------------------------- implicit none ! ! Global variables ! character(len=*), intent(in) :: rec integer, intent(out) :: i1 integer, intent(out) :: i2 integer, intent(out) :: num ! ! ! Local variables ! integer :: i integer :: len_trim integer :: k integer :: knul integer :: l character(6) :: form ! ! !! executable statements ------------------------------------------------------- ! ! ! GEEFT GETAL EN POSITIE VAN EERSTE EN LAATSTE CIJFER UIT AANEENGESLOTEN REEKS l = len_trim(rec) !EERSTE NUMMER MOET NUL ZIJN i1 = 0 i2 = 0 do i = 1, l k = index('0123456789', rec(i:i)) knul = index('0', rec(i:i)) if (i1==0 .and. knul/=0) i1 = i if (i1/=0 .and. k/=0) i2 = i if (i1/=0 .and. i2/=0) then form = '(I8.8)' write (form(3:3), '(I1)') i2 - i1 + 1 write (form(5:5), '(I1)') i2 - i1 + 1 read (rec(i1:i2), form) num endif if (i1/=0 .and. index(' ', rec(i:i))/=0) then return endif enddo end subroutine nummer12 function numbersonline(rec) !!--copyright------------------------------------------------------------------- ! Copyright (c) 2003, WL | Delft Hydraulics. All rights reserved. !!--disclaimer------------------------------------------------------------------ ! This code is part of the Delft3D software system. WL|Delft Hydraulics has ! developed c.q. manufactured this code to its best ability and according to the ! state of the art. Nevertheless, there is no express or implied warranty as to ! this software whether tangible or intangible. In particular, there is no ! express or implied warranty as to the fitness for a particular purpose of this ! software, whether tangible or intangible. The intellectual property rights ! related to this software code remain with WL|Delft Hydraulics at all times. ! For details on the licensing agreement, we refer to the Delft3D software ! license and any modifications to this license, if applicable. These documents ! are available upon request. !!--version information--------------------------------------------------------- ! $Author$ ! $Date$ ! $Revision$ !!--description----------------------------------------------------------------- ! NONE !!--pseudo code and references-------------------------------------------------- ! NONE !!--declarations---------------------------------------------------------------- implicit none ! ! Global variables ! integer :: numbersonline character(len=*), intent(in) :: rec ! ! ! Local variables ! integer :: i integer :: ifirstnum integer :: ilastnum integer :: l1 integer :: l2 integer :: leeg ! ! !! executable statements ------------------------------------------------------- ! ! numbersonline = 0 leeg = 0 L1 = ifirstnum(rec) if (L1 == 0) then return end if L2 = ilastnum(rec) if (L2 == 0) then return end if do i = l1, l2 if (ifirstnum(rec(i:i))>=1) then ! hier staat een cijfer if (leeg==0) then leeg = 1 numbersonline = numbersonline + 1 endif elseif (index(rec(i:i), '.')>=1 .and. leeg==1) then ! puntje na cijfer ook goed else leeg = 0 endif enddo end function numbersonline function ifirstchar(rec) !!--copyright------------------------------------------------------------------- ! Copyright (c) 2003, WL | Delft Hydraulics. All rights reserved. !!--disclaimer------------------------------------------------------------------ ! This code is part of the Delft3D software system. WL|Delft Hydraulics has ! developed c.q. manufactured this code to its best ability and according to the ! state of the art. Nevertheless, there is no express or implied warranty as to ! this software whether tangible or intangible. In particular, there is no ! express or implied warranty as to the fitness for a particular purpose of this ! software, whether tangible or intangible. The intellectual property rights ! related to this software code remain with WL|Delft Hydraulics at all times. ! For details on the licensing agreement, we refer to the Delft3D software ! license and any modifications to this license, if applicable. These documents ! are available upon request. !!--version information--------------------------------------------------------- ! $Author$ ! $Date$ ! $Revision$ !!--description----------------------------------------------------------------- ! NONE !!--pseudo code and references-------------------------------------------------- ! NONE !!--declarations---------------------------------------------------------------- implicit none ! ! Global variables ! integer :: ifirstchar character(*), intent(in) :: rec ! ! ! Local variables ! integer :: i ! ! !! executable statements ------------------------------------------------------- ! ! do i = 1, len(rec) if (index(rec(i:i), ' ')==0) then ifirstchar = i return endif enddo ifirstchar = 0 end function ifirstchar ! function ifirstletter(rec) ! Moved to public function find_first_letter in module string_module of Deltares_common. ! end function ifirstletter ! subroutine ifirstword(rec, i1, i2) ! Moved to public function find_first_word in module string_module of Deltares_common. ! end subroutine ifirstword ! function isblank(letter) ! Moved to private function is_whitespace in module string_module of Deltares_common. ! end function isblank function empty(rec) !!--copyright------------------------------------------------------------------- ! Copyright (c) 2003, WL | Delft Hydraulics. All rights reserved. !!--disclaimer------------------------------------------------------------------ ! This code is part of the Delft3D software system. WL|Delft Hydraulics has ! developed c.q. manufactured this code to its best ability and according to the ! state of the art. Nevertheless, there is no express or implied warranty as to ! this software whether tangible or intangible. In particular, there is no ! express or implied warranty as to the fitness for a particular purpose of this ! software, whether tangible or intangible. The intellectual property rights ! related to this software code remain with WL|Delft Hydraulics at all times. ! For details on the licensing agreement, we refer to the Delft3D software ! license and any modifications to this license, if applicable. These documents ! are available upon request. !!--version information--------------------------------------------------------- ! $Author$ ! $Date$ ! $Revision$ !!--description----------------------------------------------------------------- ! NONE !!--pseudo code and references-------------------------------------------------- ! NONE !!--declarations---------------------------------------------------------------- implicit none ! ! Global variables ! logical :: empty character(*), intent(in) :: rec ! ! ! Local variables ! integer :: i integer :: l ! ! !! executable statements ------------------------------------------------------- ! ! l = len(rec) do i = 1, l if (rec(i:i)/=' ') then empty = .false. return endif enddo empty = .true. end function empty subroutine zoekja(minp, rec, text, ja) use unstruc_messages implicit none integer, intent(in) :: minp character(len=*), intent(out) :: rec character(len=*), intent(in) :: text integer, intent(out) :: ja ! ! voorwaarts zoeken, geen error als mislukt ! write (msgbuf, '(a,a)') 'looking for keyword: ', trim(text) ! call msg_flush() 10 continue read (minp, '(a)', end = 9999, err = 999) rec if (rec(1:1) == '*') goto 10 if (index(rec, trim(text))/=0) then ja = 1 return endif goto 10 999 continue call mess(LEVEL_INFO, 'keyword', trim(text), 'NOT found!') ja = 0 return 9999 continue ja = 0 return end subroutine zoekja !> Searches for a keyword in file and returns the text value. !! 'key=text' subroutine zoekval(minp, key, val, ja) implicit none integer, intent(out) :: ja !< Whether key was found or not. integer, intent(in) :: minp !< File pointer character(*), intent(out) :: val !< character(*), intent(in) :: key character(len=255) :: rec integer :: l1 call zoekja(minp,rec,trim(key), ja) if (ja .eq. 1) then l1 = index(rec,'=') + 1 read(rec(l1:),*) val else return endif end subroutine zoekval subroutine zoekinteger(minp, key, val, ja) implicit none integer, intent(in) :: minp !< File pointer integer, intent(inout) :: val !< character(len=*), intent(in) :: key integer, intent(out) :: ja !< Whether key was found or not. character(len=255) :: rec integer :: l1 call zoekja(minp,rec,trim(key), ja) if (ja .eq. 1) then l1 = index(rec,'=') + 1 read(rec(l1:),*) val else return endif end subroutine zoekinteger subroutine zoekdouble(minp, key, val, ja) implicit none integer, intent(out) :: ja !< Whether key was found or not. integer, intent(in) :: minp !< File pointer double precision :: val !< character(*), intent(in) :: key character(len=255) :: rec integer :: l1 call zoekja(minp,rec,trim(key), ja) if (ja .eq. 1) then l1 = index(rec,'=') + 1 read(rec(l1:),*,err = 888) val call message(rec,' ',' ') else return endif 888 continue end subroutine zoekdouble !> Searches for an optional keyword on current line and returns the text value. !! 'key=text'. Rewinds the file pointer to the original line. subroutine zoekopt(minp, value, key, ja) use unstruc_messages use unstruc_files implicit none integer, intent(out) :: ja !< Whether key was found or not. integer, intent(in) :: minp !< File pointer character(*), intent(out) :: value !< value behind '=' character. character(*), intent(in) :: key !< integer :: iostat character(len=255) :: rec integer :: l1 !write (msgbuf, '(a,a)') 'looking for optional keyword: ', key !call msg_flush() ja = 0 10 continue read (minp, '(a255)', end = 999, err=998, iostat=iostat) rec if (rec(1:1) == '*') goto 10 ! call mess(LEVEL_INFO, 'Looking for optional '//trim(key)//' in: ', rec ) if (index(rec, trim(key)) /= 0) then ja = 1 l1 = index(rec,'=') + 1 read(rec(l1:),*) value ! call mess(LEVEL_INFO, 'Found optional keyword', trim(key) ) return else backspace(minp) endif 998 continue if (iostat/=0) then ! handle exception ! write (msgbuf, '(a,a,a,i0,a)') 'FILE ',trim(filenames(minp)),' returned IOSTAT ',iostat,' !!' ! call warn_flush() endif 999 continue !backspace(minp) ! call mess(LEVEL_INFO, 'optional keyword', trim(key), 'NOT found.') end subroutine zoekopt !> Performs a clean program stop upon errors. !! This routine is automatically called from the MessageHandling module. subroutine unstruc_errorhandler(level) use unstruc_messages use unstruc_files use dfm_error #ifdef HAVE_MPI use mpi use m_partitioninfo, only: DFM_COMM_DFMWORLD #endif implicit none integer, intent(in) :: level integer :: ierr ierr=0 if (level >= LEVEL_ERROR) then call close_all_files close(mdia) #ifdef HAVE_MPI call MPI_Abort(DFM_COMM_DFMWORLD, DFM_GENERICERROR, ierr) #endif stop end if end subroutine unstruc_errorhandler subroutine error(w1, w2, w3) !!--copyright------------------------------------------------------------------- ! Copyright (c) 2003, WL | Delft Hydraulics. All rights reserved. !!--disclaimer------------------------------------------------------------------ ! This code is part of the Delft3D software system. WL|Delft Hydraulics has ! developed c.q. manufactured this code to its best ability and according to the ! state of the art. Nevertheless, there is no express or implied warranty as to ! this software whether tangible or intangible. In particular, there is no ! express or implied warranty as to the fitness for a particular purpose of this ! software, whether tangible or intangible. The intellectual property rights ! related to this software code remain with WL|Delft Hydraulics at all times. ! For details on the licensing agreement, we refer to the Delft3D software ! license and any modifications to this license, if applicable. These documents ! are available upon request. !!--version information--------------------------------------------------------- ! $Author$ ! $Date$ ! $Revision$ !!--description----------------------------------------------------------------- ! NONE !!--pseudo code and references-------------------------------------------------- ! NONE !!--declarations---------------------------------------------------------------- use unstruc_messages use unstruc_files implicit none ! ! Global variables ! character(len=*), intent(in) :: w1 character(len=*), intent(in) :: w2 character(len=*), intent(in) :: w3 ! ! !! executable statements ------------------------------------------------------- ! ! call mess(LEVEL_ERROR, w1, w2, w3) ! call doclose(mdia) ! stop ! TODO: netjes afsluiten elders [AvD] end subroutine error function thisisanumber(rec) !!--copyright------------------------------------------------------------------- ! Copyright (c) 2003, WL | Delft Hydraulics. All rights reserved. !!--disclaimer------------------------------------------------------------------ ! This code is part of the Delft3D software system. WL|Delft Hydraulics has ! developed c.q. manufactured this code to its best ability and according to the ! state of the art. Nevertheless, there is no express or implied warranty as to ! this software whether tangible or intangible. In particular, there is no ! express or implied warranty as to the fitness for a particular purpose of this ! software, whether tangible or intangible. The intellectual property rights ! related to this software code remain with WL|Delft Hydraulics at all times. ! For details on the licensing agreement, we refer to the Delft3D software ! license and any modifications to this license, if applicable. These documents ! are available upon request. !!--version information--------------------------------------------------------- ! $Author$ ! $Date$ ! $Revision$ !!--description----------------------------------------------------------------- ! NONE !!--pseudo code and references-------------------------------------------------- ! NONE !!--declarations---------------------------------------------------------------- implicit none ! ! Global variables ! logical :: thisisanumber character(len=*), intent(in) :: rec ! ! ! Local variables ! integer :: ich integer :: ifirstchar integer :: l ! ! !! executable statements ------------------------------------------------------- ! ! ! is waar als eerste character van rec een getal is. l = ifirstchar(rec) if (l==0) then thisisanumber = .false. else ich = ichar(rec(l:l)) if (ich==43 .or. ich==45 .or. ich==46 .or. ich>=48 .and. ich<=57) then thisisanumber = .true. else thisisanumber = .false. endif endif end function thisisanumber function ifirstnum(rec) ! first digit !!--copyright------------------------------------------------------------------- ! Copyright (c) 2003, WL | Delft Hydraulics. All rights reserved. !!--disclaimer------------------------------------------------------------------ ! This code is part of the Delft3D software system. WL|Delft Hydraulics has ! developed c.q. manufactured this code to its best ability and according to the ! state of the art. Nevertheless, there is no express or implied warranty as to ! this software whether tangible or intangible. In particular, there is no ! express or implied warranty as to the fitness for a particular purpose of this ! software, whether tangible or intangible. The intellectual property rights ! related to this software code remain with WL|Delft Hydraulics at all times. ! For details on the licensing agreement, we refer to the Delft3D software ! license and any modifications to this license, if applicable. These documents ! are available upon request. !!--version information--------------------------------------------------------- ! $Author$ ! $Date$ ! $Revision$ !!--description----------------------------------------------------------------- ! NONE !!--pseudo code and references-------------------------------------------------- ! NONE !!--declarations---------------------------------------------------------------- implicit none ! ! Global variables ! integer :: ifirstnum character(len=*), intent(in) :: rec ! ! ! Local variables ! integer :: i integer :: i1 integer :: len_trim integer :: l ! ! !! executable statements ------------------------------------------------------- ! ! ! geeft positie van eerste nummer l = len_trim(rec) ifirstnum = 0 do i = 1, l i1 = index('+.-0123456789', rec(i:i)) if (i1/=0) then ifirstnum = i return endif enddo end function ifirstnum function ilastnum(rec) !!--copyright------------------------------------------------------------------- ! Copyright (c) 2003, WL | Delft Hydraulics. All rights reserved. !!--disclaimer------------------------------------------------------------------ ! This code is part of the Delft3D software system. WL|Delft Hydraulics has ! developed c.q. manufactured this code to its best ability and according to the ! state of the art. Nevertheless, there is no express or implied warranty as to ! this software whether tangible or intangible. In particular, there is no ! express or implied warranty as to the fitness for a particular purpose of this ! software, whether tangible or intangible. The intellectual property rights ! related to this software code remain with WL|Delft Hydraulics at all times. ! For details on the licensing agreement, we refer to the Delft3D software ! license and any modifications to this license, if applicable. These documents ! are available upon request. !!--version information--------------------------------------------------------- ! $Author$ ! $Date$ ! $Revision$ !!--description----------------------------------------------------------------- ! NONE !!--pseudo code and references-------------------------------------------------- ! NONE !!--declarations---------------------------------------------------------------- implicit none ! ! Global variables ! integer :: ilastnum character(len=*), intent(in) :: rec ! ! ! Local variables ! integer :: i integer :: i1 integer :: len_trim integer :: l ! ! !! executable statements ------------------------------------------------------- ! ! ! GEEFT POSITIE VAN LAATSTE NUMMER l = len_trim(rec) ilastnum = 0 do i = l, 1, -1 i1 = index('.0123456789', rec(i:i)) if (i1/=0) then ilastnum = i return endif enddo end function ilastnum !> Error when reading incorrectly formatted data from file. subroutine readerror(w1, w2, minp) use unstruc_files implicit none character(len=*), intent(in) :: w1 character(len=*), intent(in) :: w2 integer, intent(in) :: minp call mess(LEVEL_ERROR, w1, w2, ' in file ' // filenames(minp)) end subroutine readerror !> Error when a premature EOF is encountered. subroutine eoferror(minp) use unstruc_files implicit none integer, intent(in) :: minp call mess(LEVEL_ERROR, 'unexpected end of file in ', filenames(minp)) end subroutine eoferror subroutine message(w1, w2, w3) !!--copyright------------------------------------------------------------------- ! Copyright (c) 2003, WL | Delft Hydraulics. All rights reserved. !!--disclaimer------------------------------------------------------------------ ! This code is part of the Delft3D software system. WL|Delft Hydraulics has ! developed c.q. manufactured this code to its best ability and according to the ! state of the art. Nevertheless, there is no express or implied warranty as to ! this software whether tangible or intangible. In particular, there is no ! express or implied warranty as to the fitness for a particular purpose of this ! software, whether tangible or intangible. The intellectual property rights ! related to this software code remain with WL|Delft Hydraulics at all times. ! For details on the licensing agreement, we refer to the Delft3D software ! license and any modifications to this license, if applicable. These documents ! are available upon request. !!--version information--------------------------------------------------------- ! $Author$ ! $Date$ ! $Revision$ !!--description----------------------------------------------------------------- ! NONE !!--pseudo code and references-------------------------------------------------- ! NONE !!--declarations---------------------------------------------------------------- use unstruc_messages implicit none ! ! Global variables ! character(len=*), intent(in) :: w1 character(len=*), intent(in) :: w2 character(len=*), intent(in) :: w3 ! ! !! executable statements ------------------------------------------------------- ! ! call mess(LEVEL_INFO, w1, w2, w3) end subroutine message !> Returns a new unused file pointer function numuni() use unstruc_files implicit none integer :: numuni logical :: opened numuni = 10 opened = .true. ! get unit specifier 10 continue if (opened) then numuni = numuni + 1 inquire (unit = numuni, opened = opened) goto 10 endif ! if (opened) then numuni = 0 call mess(LEVEL_ERROR, 'new unit number not available') endif end function numuni