ocpcre.f90

Go to the documentation of this file.

!               OCEAN PACK  command reading routines
!
!  Contents of this file:
!     RDINIT
!     NWLINE
!     INKEYW
!     INREAL
!     INDBLE
!     ININTG
!     INCSTR
!     INCTIM
!     ININTV
!     LEESEL
!     GETKAR
!     PUTKAR
!     UPCASE
!     KEYWIS
!     WRNKEY
!     IGNORE
!     RDHMS
!
!****************************************************************
!                                                               *
   SUBROUTINE rdinit
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                       
   USE ocpcomm3                                                       
   USE ocpcomm4                                                       
!
   IMPLICIT NONE
!
!
!   --|-----------------------------------------------------------|--
!     | Delft University of Technology                            |
!     | Faculty of Civil Engineering                              |
!     | Environmental Fluid Mechanics Section                     |
!     | P.O. Box 5048, 2600 GA  Delft, The Netherlands            |
!     |                                                           |
!     | Programmers: R.C. Ris, N. Booij,                          |
!     |              IJ.G. Haagsma, A.T.M.M. Kieftenburg,         |
!     |              M. Zijlema, E.E. Kriezi,                     |
!     |              R. Padilla-Hernandez, L.H. Holthuijsen       |
!   --|-----------------------------------------------------------|--
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     40.41: Marcel Zijlema
!
!  1. UPDATES
!
!     40.41, Oct. 04: common blocks replaced by modules, include files removed
!
!  2. PURPOSE
!
!     Initialises the command reading system
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!  5. PARAMETER VARIABLES
!
!  6. LOCAL VARIABLES
!
!     IENT   : Number of entries into this subroutine
!
   INTEGER   IENT
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
   SAVE ient
   DATA ient/0/
   CALL strace (ient,'RDINIT')
   kar = ';'
   karnr = lineln + 1                                                  
   eltype = 'USED'
   blank = '    '
   RETURN
   END SUBROUTINE rdinit
 
!****************************************************************
!                                                               *
   SUBROUTINE nwline
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
!   USE OCPCOMM3                                                        
   USE ocpcomm4                                                        
!
   IMPLICIT NONE
!
!
!   --|-----------------------------------------------------------|--
!     | Delft University of Technology                            |
!     | Faculty of Civil Engineering                              |
!     | Environmental Fluid Mechanics Section                     |
!     | P.O. Box 5048, 2600 GA  Delft, The Netherlands            |
!     |                                                           |
!     | Programmers: R.C. Ris, N. Booij,                          |
!     |              IJ.G. Haagsma, A.T.M.M. Kieftenburg,         |
!     |              M. Zijlema, E.E. Kriezi,                     |
!     |              R. Padilla-Hernandez, L.H. Holthuijsen       |
!   --|-----------------------------------------------------------|--
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     34.01: IJsbrand Haagsma
!     40.03: Nico Booij
!     40.41: Marcel Zijlema
!
!  1. UPDATES
!
!     34.01, Feb. 99: Changed STOP statement in a MSGERR(4,'message')
!     40.03, Apr. 99: length of command lines changed from 80 to LINELN (=120)
!                     name of input file included in error message
!     40.41, Oct. 04: common blocks replaced by modules, include files removed
!
!  2. PURPOSE
!
!     Jumps to reading of the next input line,
!     if the end of the previous one is reached.
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!  5. PARAMETER VARIABLES
!
!  6. LOCAL VARIABLES
!
!     IENT   : Number of entries into this subroutine
!
   INTEGER   IENT
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
   SAVE ient
   DATA  ient/0/
   CALL strace (ient,'NWLINE')
5  IF((eltype == 'USED').OR.(eltype == 'EOR')) CALL leesel
!   print*,'after calling LEESEL. ***********',ELTYPE
   IF(eltype == 'EOF') GOTO 90
   IF(eltype == 'KEY' .AND. keywrd /= '        ') GOTO 50
   IF(eltype == 'INT') GOTO 50
   IF(eltype == 'REAL') GOTO 50
   IF(eltype == 'CHAR') GOTO 50
   IF(karnr <= lineln) GOTO 50                                        
!  The end of the previous line is reached, there are no more
!  unprocessed data items on that line.
!  Jump to new line can take place.
   WRITE (printf,9) '    '
9  FORMAT (a4)
   karnr=0
   kar=' '
   eltype='USED'
   GOTO 5
90 IF(itest >= 10)THEN
     INQUIRE (unit=inputf, name=filenm)                                
     WRITE (printf, *) ' end of input file '//filenm                   
   ENDIF
50 RETURN
   END SUBROUTINE nwline
 
!****************************************************************
!                                                               *
   SUBROUTINE inkeyw (KONT, CSTA)
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
   USE ocpcomm3                                                        
   USE ocpcomm4                                                        
!
   IMPLICIT NONE
!
!
!   --|-----------------------------------------------------------|--
!     | Delft University of Technology                            |
!     | Faculty of Civil Engineering                              |
!     | Environmental Fluid Mechanics Section                     |
!     | P.O. Box 5048, 2600 GA  Delft, The Netherlands            |
!     |                                                           |
!     | Programmers: R.C. Ris, N. Booij,                          |
!     |              IJ.G. Haagsma, A.T.M.M. Kieftenburg,         |
!     |              M. Zijlema, E.E. Kriezi,                     |
!     |              R. Padilla-Hernandez, L.H. Holthuijsen       |
!   --|-----------------------------------------------------------|--
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     40.41: Marcel Zijlema
!
!  1. UPDATES
!
!     ver 30.70, Jan. 1998: data type 'OTHR' is condidered
!     40.41, Oct. 04: common blocks replaced by modules, include files removed
!
!  2. PURPOSE
!
!     this subroutine reads a keyword.
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!     KONT   : action to be taken if no keyword is found in input:
!              'REQ' (required) error message
!              'STA' (standard) the value of csta is assigned to keywrd.
!
!     CSTA   : see above.
!
   CHARACTER CSTA *(*), KONT *(*)
!
!  5. PARAMETER VARIABLES
!
!  6. LOCAL VARIABLES
!
!     IENT   : Number of entries into this subroutine
!     LENS   : length of default string (CSTA)
!
   INTEGER   IENT, LENS
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
   SAVE ient
   DATA  ient/0/
   CALL  strace ( ient, 'INKEYW')
!
!     if necessary, a new data item is read.
!
   IF(eltype == 'KEY' .AND. keywrd == '        ') GOTO 510
   IF(eltype == 'KEY') GOTO 900
   IF(eltype == 'EOR') GOTO 510
   IF(eltype == 'USED') GOTO 510
   GOTO 520
510 CALL leesel
520 IF(eltype == 'KEY') GOTO 900
!  KEYWORD IS READ
   IF((kont == 'STA').OR.(kont == 'NSKP'))THEN
     lens = len(csta)
     IF(lens >= 8)THEN
       keywrd = csta(1:8)
     ELSE
       keywrd = '        '
       keywrd(1:lens) = csta
     ENDIF
     GOTO 900
   ENDIF
!  at the end of the input 'STOP' is generated.
   IF(eltype == 'EOF')THEN
     keywrd='STOP'
     CALL msgerr (2, 'STOP statement is missing')
     GOTO 900
   ENDIF
!  ----------------------------------------------------------
!  Data appear where a keyword is expected.
!  The user must be informed.
!  ----------------------------------------------------------
   IF(eltype == 'EOR')THEN
     keywrd = '        '
     GOTO 900
   ENDIF
   IF(eltype == 'INT')THEN
     CALL msgerr (2, 'Data field skipped:'//eltext)
     GOTO 510
   ENDIF
   IF(eltype == 'REAL')THEN
     CALL msgerr (2, 'Data field skipped:'//eltext)
     GOTO 510
   ENDIF
   IF(eltype == 'CHAR' .OR. eltype == 'OTHR')THEN                    
     CALL msgerr (2, 'Data field skipped:'//eltext)
     GOTO 510
   ENDIF
   IF(eltype == 'EMPT')THEN
     CALL msgerr (2, 'Empty data field skipped')
     GOTO 510
   ENDIF
   CALL msgerr (3, 'Error subr. INKEYW')
!  ----------------------------------------------------------
900 IF(itest >= 10) WRITE (printf,910) keywrd
910 FORMAT (' KEYWORD: ',a8)
   RETURN
   END SUBROUTINE inkeyw
 
!****************************************************************
!                                                               *
   SUBROUTINE inreal (NAAM, R, KONT, RSTA)
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
   USE ocpcomm3                                                        
   USE ocpcomm4 
   USE mod_utils                                                       
!
   IMPLICIT NONE
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!     FVCOM-SWAVE; a third generation wave model
!     Copyright (C) 2008-2009  University of Massachusetts Dartmouth
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     Jianhua Qi Dec. 20 2006
!
!  1. UPDATES
!
!  2. PURPOSE
!
!     Reads a REAL number in free format.
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!     R      : The value of the variable that is to be read.
!     RSTA   : Reference value needed for KONT='STA'or 'RQI'
!
   REAL      R, RSTA
!
!     KONT   : What to do with the varible?
!              ='REQ'; Variable is required
!              ='UNC'; If no variable, then variable will not be changed
!              ='STA'; If no variable, then variable will get value of RSTA
!              ='RQI'; Variable may not have the value of RSTA
!              ='REP' (REPEAT)
!              ='NSKP' (NO SKIP) IF DATA ITEM IS OF DIFFERENT TYPE,
!                VALUE IS LEFT UNCHANGED.
!     NAAM   : Name of the variable according to the user manual.
!
   CHARACTER NAAM *(*), KONT *(*)
!
!  5. PARAMETER VARIABLES
!
!  6. LOCAL VARIABLES
!
!     INPFIL
!     ISCAN
!     FNTMP
!
   CHARACTER(LEN=7) INPFIL
   INTEGER  ISCAN  
   REAL(SP)  FNTMP
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
!   INTEGER, SAVE IENT
!   DATA IENT /0/
!   CALL STRACE ( IENT, 'INREAL')
!
   inpfil = "./INPUT"

   chgval = .false.
   iscan = scan_file2(inpfil,naam,fscal = fntmp)
   IF(iscan == 0)THEN
     IF(abs(r-fntmp) > 1.0e-6)chgval = .true.
     r = fntmp
   ELSE
     IF(kont == 'STA')THEN
       r = rsta
     ELSE IF(kont == 'REQ')THEN  
       WRITE(printf,*)'ERROR READING ',naam,': ',iscan
       CALL pstop
     END IF
   END IF

!JQI   IF(KONT == 'STA')THEN
!JQI     R = RSTA
!JQI   ELSE  
!JQI     ISCAN = SCAN_FILE(INPFIL,NAAM,FSCAL = FNTMP)
!JQI     IF(ISCAN == 0)THEN
!JQI       IF(ABS(R-FNTMP) > 1.0E-6)CHGVAL = .TRUE.
!JQI       R = FNTMP
!JQI     ELSE
!JQI       IF(KONT /= 'UNC')THEN
!JQI         WRITE(PRINTF,*)'ERROR READING ',NAAM,': ',ISCAN
!JQI         CALL PSTOP
!JQI       END IF
!JQI     END IF  
!JQI   END IF        

   RETURN
   END SUBROUTINE inreal
 
!****************************************************************
!                                                               *
   SUBROUTINE inintg (NAAM, IV, KONT, ISTA)
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
   USE ocpcomm3                                                        
   USE ocpcomm4                                                        
   USE mod_utils                                                        
!
   IMPLICIT NONE
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!     FVCOM-SWAVE; a third generation wave model
!     Copyright (C) 2008-2009  University of Massachusetts Dartmouth
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     Jianhua Qi
!
!  1. UPDATES
!
!  2. PURPOSE
!
!     Reads an integer number, in free format
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!     IV     :  integer variable which is to be assigned a value
!     ISTA   :  default value
!
   INTEGER   IV, ISTA
!
!     NAAM   :  name of the variable according to the user manual
!     KONT   : What to do with the variable?
!              ='REQ'; error message if no value is found in the input file
!              ='UNC'; If no value, then variable will not be changed
!              ='STA'; If no value, then variable will get default value
!              ='RQI'; Variable may not have the value of RSTA
!              ='REP'  (repeat)
!              ='NSKP' (no skip) if data item is of different type,
!                      value is left unchanged.
!
   CHARACTER NAAM *(*), KONT *(*)
!
!  5. PARAMETER VARIABLES
!
!     PARAMETERS: SEE SUBR. INREAL
!
!  6. LOCAL VARIABLES
!
!     INPFIL
!     ISCAN
!     INTMP
!
   CHARACTER(LEN=7) INPFIL
   INTEGER  ISCAN  
   INTEGER  INTMP
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
!   SAVE IENT
!   DATA  IENT /0/
!   CALL  STRACE ( IENT, 'ININTG')
!
   inpfil = "./INPUT"

!JQIJQI   IF(KONT == 'STA')THEN
!JQIJQI     IV = ISTA
!JQIJQI   ELSE  
!JQIJQI     ISCAN = SCAN_FILE(INPFIL,NAAM,ISCAL = INTMP)
!JQIJQI     IF(ISCAN == 0)THEN
!JQIJQI       IV = INTMP
!JQIJQI     ELSE
!JQIJQI       IF(KONT /= 'UNC')THEN
!JQIJQI         WRITE(PRINTF,*)'ERROR READING ',NAAM,': ',ISCAN
!JQIJQI         CALL PSTOP
!JQIJQI       END IF
!JQIJQI     END IF  
!JQIJQI   END IF        
      
   iscan = scan_file2(inpfil,naam,iscal = intmp)
   IF(iscan == 0)THEN
     iv = intmp
   ELSE
     IF(kont == 'STA')THEN
       iv = ista
     ELSE IF(kont == 'REQ')THEN    
       WRITE(printf,*)'ERROR READING ',naam,': ',iscan
       CALL pstop
     END IF
   END IF    
      
   RETURN
   END SUBROUTINE inintg
 
!****************************************************************
!                                                               *
   SUBROUTINE inlogc (NAAM, L, KONT, LSTA)
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
   USE ocpcomm3                                                        
   USE ocpcomm4 
   USE mod_utils                                                       
!
   IMPLICIT NONE
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!     FVCOM-SWAVE; a third generation wave model
!     Copyright (C) 2008-2009  University of Massachusetts Dartmouth
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     Jianhua Qi Dec. 20 2006
!
!  1. UPDATES
!
!  2. PURPOSE
!
!     Reads a REAL number in free format.
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!     R      : The value of the variable that is to be read.
!     RSTA   : Reference value needed for KONT='STA'or 'RQI'
!
   LOGICAL      L, LSTA
!
!     KONT   : What to do with the varible?
!              ='REQ'; Variable is required
!              ='UNC'; If no variable, then variable will not be changed
!              ='STA'; If no variable, then variable will get value of RSTA
!              ='RQI'; Variable may not have the value of RSTA
!              ='REP' (REPEAT)
!              ='NSKP' (NO SKIP) IF DATA ITEM IS OF DIFFERENT TYPE,
!                VALUE IS LEFT UNCHANGED.
!     NAAM   : Name of the variable according to the user manual.
!
   CHARACTER NAAM *(*), KONT *(*)
!
!  5. PARAMETER VARIABLES
!
!  6. LOCAL VARIABLES
!
!     INPFIL
!     ISCAN
!     FNTMP
!
   CHARACTER(LEN=7) INPFIL
   INTEGER  ISCAN  
   LOGICAL LTMP
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
!   INTEGER, SAVE IENT
!   DATA IENT /0/
!   CALL STRACE ( IENT, 'INREAL')
!
   inpfil = "./INPUT"
   iscan = scan_file2(inpfil,naam,lval = ltmp)
   IF(iscan == 0)THEN
     l = ltmp
   ELSE
     IF(kont == 'STA')THEN
       l = lsta
     ELSE IF(kont == 'REQ')THEN 
       WRITE(printf,*)'ERROR READING ',naam,': ',iscan
       CALL pstop
     END IF
   END IF  

!JQI   IF(KONT == 'STA')THEN
!JQI     L = LSTA
!JQI   ELSE  
!JQI     ISCAN = SCAN_FILE(INPFIL,NAAM,LVAL = LTMP)
!JQI     IF(ISCAN == 0)THEN
!JQI       L = LTMP
!JQI     ELSE
!JQI       IF(KONT /= 'UNC')THEN
!JQI         WRITE(PRINTF,*)'ERROR READING ',NAAM,': ',ISCAN
!JQI         CALL PSTOP
!JQI       END IF
!JQI     END IF  
!JQI   END IF        

   RETURN
   END SUBROUTINE inlogc
!****************************************************************
!                                                               *
   SUBROUTINE incstr (NAAM, C, KONT, CSTA)
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
   USE ocpcomm3                                                        
   USE ocpcomm4 
   USE mod_utils                                                       
!
   IMPLICIT NONE
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!     FVCOM-SWAVE; a third generation wave model
!     Copyright (C) 2008-2009  University of Massachusetts Dartmouth
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     Jianhua Qi
!
!  1. UPDATES
!
!  2. PURPOSE
!
!     Reads a string in free format
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!     NAAM   : name of the variable according to the user manual
!     KONT   : What to do with the variable?
!              ='REQ'; error message if no value is found in the input file
!              ='UNC'; If no value, then variable will not be changed
!              ='STA'; If no value, then variable will get default value
!              ='RQI'; Variable may not have the value of CSTA
!              ='REP'  (repeat)
!              ='NSKP' (no skip) if data item is of different type,
!                      value is left unchanged.
!     C      : string that is to be read from input file
!     CSTA   : default value of the string
!
   CHARACTER NAAM *(*), KONT *(*), C *(*), CSTA *(*)
!
!  5. PARAMETER VARIABLES
!
!  6. LOCAL VARIABLES
!
!     INPFIL
!     ISCAN
!     INTMP
!
   CHARACTER(LEN=7) INPFIL
   INTEGER  ISCAN  
   CHARACTER(LEN=80) CHTMP
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
!   SAVE IENT
!   DATA  IENT /0/
!   CALL  STRACE ( IENT, 'INCSTR')
!
   inpfil = "./INPUT"
   iscan = scan_file2(inpfil,naam,cval = chtmp)
   IF(iscan == 0)THEN
     c = trim(chtmp)
   ELSE
     IF(kont == 'STA')THEN
       c = csta
     ELSE IF(kont == 'REQ')THEN  
       WRITE(printf,*)'ERROR READING ',naam,': ',iscan
       CALL pstop
     END IF
   END IF  

!JQI   IF(KONT == 'STA')THEN
!JQI     C = CSTA
!JQI   ELSE  
!JQI     ISCAN = SCAN_FILE(INPFIL,NAAM,CVAL = CHTMP)
!JQI     IF(ISCAN == 0)THEN
!JQI       C = TRIM(CHTMP)
!JQI     ELSE
!JQI       IF(KONT /= 'UNC')THEN
!JQI         WRITE(PRINTF,*)'ERROR READING ',NAAM,': ',ISCAN
!JQI         CALL PSTOP
!JQI       END IF
!JQI     END IF  
!JQI   END IF        
      
   RETURN
   END SUBROUTINE incstr
 
!****************************************************************
!                                                               *
   SUBROUTINE inctim (IOPTIM, NAAM, RV, KONT, RSTA)
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
   USE ocpcomm3                                                        
   USE ocpcomm4                                                        
   USE mod_utils                                                       
!
   IMPLICIT NONE
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!     FVCOM-SWAVE; a third generation wave model
!     Copyright (C) 2008-2009  University of Massachusetts Dartmouth
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     Jianhua Qi
!
!  1. UPDATES
!
!  2. PURPOSE
!
!     Reads and interprets a time string
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!     IOPTIM   int   inp   time reading option (see subr DTSTTI)
!
!
   INTEGER   IOPTIM
!
!     RV     : variable that is to be assigned a value
!     RSTA   : default value
!
   REAL      RV, RSTA
!
!     NAAM   : name of the variable according to the user manual
!     KONT   : What to do with the variable?
!              ='REQ'; error message if no value is found in the input file
!              ='UNC'; If no value, then variable will not be changed
!              ='STA'; If no value, then variable will get default value
!              ='RQI'; Variable may not have the value of RSTA
!              ='REP'  (repeat)
!              ='NSKP' (no skip) if data item is of different type,
!                      value is left unchanged.
!
   CHARACTER NAAM *(*), KONT *(*)
!
!  5. PARAMETER VARIABLES
!
!     PARAMETERS: SEE PROGRAM DOCUMENTATION.
!
!  6. LOCAL VARIABLES
!
!     IENT   : Number of entries into this subroutine
!     LENMN  : length of the string NAAM
!
!     INPFIL
!     ISCAN
!     INTMP
!
   CHARACTER(LEN=7) INPFIL
   INTEGER  ISCAN  
   REAL FNTMP
   CHARACTER(LEN=80) CHTMP
   CHARACTER(LEN=24) C
   REAL R
   INTEGER    IENT, LENNM,INTR
!
!     NAAM_L : local copy of NAAM                                         
!
   CHARACTER (LEN=40) :: NAAM_L                                        
!
!     EQREAL : logical function, True if arguments are equal
!
   LOGICAL    EQREAL                                                   
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
   SAVE ient
   DATA ient /0/
   CALL strace ( ient, 'INCTIM')
!
   inpfil = "./INPUT"
   iscan = scan_file2(inpfil,naam,cval = chtmp)
   IF(iscan == 0)THEN
     c = trim(chtmp)
   ELSE
!JQI     IF(KONT == 'STA')THEN
!JQI       RV = RSTA
!JQI     ELSE IF(KONT == 'REQ')THEN  
       WRITE(printf,*)'ERROR READING ',naam,': ',iscan
       CALL pstop
!JQI     END IF
   END IF  

!JQI   IF(KONT == 'STA')THEN
!JQI     RV = RSTA
!JQI   ELSE  
!JQI!     ISCAN = SCAN_FILE(INPFIL,NAAM,FSCAL = FNTMP)
!JQI     ISCAN = SCAN_FILE(INPFIL,NAAM,CVAL = CHTMP)
!JQI     IF(ISCAN == 0)THEN
!JQI!       R = FNTMP
!JQI!       INTR = INT(R)
!JQI!       WRITE(C,'(F24.6)') R     !R
!JQI       C = TRIM(CHTMP)
!JQI!       print*,'INTR=',INTR,R,'C=',c
!JQI!       print*,'C=',c
!JQI     ELSE
!JQI       IF(KONT /= 'UNC')THEN
!JQI         WRITE(PRINTF,*)'ERROR READING ',NAAM,': ',ISCAN
!JQI         CALL PSTOP
!JQI       END IF
!JQI     END IF  
!JQI   END IF        

!   CALL DTRETI (ELTEXT(1:LENCST), IOPTIM, RV)
   CALL dtreti (c, ioptim, rv)
!JQI     IF (.NOT.EQREAL(RV,RSTA)) CHGVAL = .TRUE.                        

   RETURN
   END SUBROUTINE inctim
 
!*******************************************************************
!                                                                  *
   SUBROUTINE inintv (NAME, RVAR, KONT, RSTA)                          
!                                                                  *
!*******************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
   USE ocpcomm3                                                        
   USE ocpcomm4                                                        
!
   IMPLICIT NONE
!
!
!   --|-----------------------------------------------------------|--
!     | Delft University of Technology                            |
!     | Faculty of Civil Engineering                              |
!     | Environmental Fluid Mechanics Section                     |
!     | P.O. Box 5048, 2600 GA  Delft, The Netherlands            |
!     |                                                           |
!     | Programmers: R.C. Ris, N. Booij,                          |
!     |              IJ.G. Haagsma, A.T.M.M. Kieftenburg,         |
!     |              M. Zijlema, E.E. Kriezi,                     |
!     |              R. Padilla-Hernandez, L.H. Holthuijsen       |
!   --|-----------------------------------------------------------|--
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     40.41: Marcel Zijlema
!
!  1. UPDATES
!
!     Dec 1995, ver 30.09 : new subroutine
!     40.41, Oct. 04: common blocks replaced by modules, include files removed
!
!  2. PURPOSE
!
!     Read a time interval in the form: number  DAY/HR/MIN/SEC
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!     NAAM   : name of the variable according to the user manual
!     KONT   : What to do with the variable?
!              ='REQ'; error message if no value is found in the input file
!              ='UNC'; If no value, then variable will not be changed
!              ='STA'; If no value, then variable will get default value
!              ='RQI'; Variable may not have the value of RSTA
!              ='REP'  (repeat)
!              ='NSKP' (no skip) if data item is of different type,
!                      value is left unchanged.
!
   CHARACTER NAME *(*), KONT *(*)
!
!     RSTA   : default value
!     RVAR   : variable that is to be assigned a value
!
   REAL      RSTA, RVAR
!
!  5. PARAMETER VARIABLES
!
!  6. LOCAL VARIABLES
!
!     IENT   : Number of entries into this subroutine
!
   INTEGER   IENT
!
!     FAC    : a factor, value depends on unit of time used
!     RI     : auxiliary variable
!
   REAL      FAC, RI
!
!     KEYWIS : logical function, True if keyword encountered is equal to
!              keyword in user manual
!
   LOGICAL   KEYWIS
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
!     -------------------------------------------------------------
!     Call INREAL to read number of time units
!     If a value was read
!     Then Read time unit
!          Case time unit is
!          DAY: Fac = 24*3600
!          HR:  Fac = 3600
!          MI:  Fac = 60
!          SEC: Fac = 1
!     Else Fac = 1
!     -------------------------------------------------------------
!     Interval in seconds = Fac * number of time units
!     -------------------------------------------------------------
!
! 13. SOURCE TEXT
!
   SAVE ient
   DATA ient /0/
   CALL strace (ient, 'ININTV')                                        
!
   CALL inreal (name, ri, kont, rsta)
   IF(chgval)THEN
     CALL inkeyw ('STA', 'S')
     IF(keywis('DA'))THEN
       fac = 24.*3600.
     ELSE IF(keywis('HR'))THEN
       fac = 3600.
     ELSE IF(keywis('MI'))THEN
       fac = 60.
     ELSE
       CALL ignore ('S')
       fac = 1.
     ENDIF
   ELSE
     fac = 1.
   ENDIF
   rvar = fac * ri
   RETURN
   END SUBROUTINE inintv
 
!****************************************************************
!                                                               *
   SUBROUTINE leesel
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
!   USE OCPCOMM3                                                        
   USE ocpcomm4                                                        
!
   IMPLICIT NONE
!
!
!   --|-----------------------------------------------------------|--
!     | Delft University of Technology                            |
!     | Faculty of Civil Engineering                              |
!     | Environmental Fluid Mechanics Section                     |
!     | P.O. Box 5048, 2600 GA  Delft, The Netherlands            |
!     |                                                           |
!     | Programmers: R.C. Ris, N. Booij,                          |
!     |              IJ.G. Haagsma, A.T.M.M. Kieftenburg,         |
!     |              M. Zijlema, E.E. Kriezi,                     |
!     |              R. Padilla-Hernandez, L.H. Holthuijsen       |
!   --|-----------------------------------------------------------|--
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     40.13: Nico Booij
!     40.41: Marcel Zijlema
!
!  1. UPDATES
!
!     Jan. 1994, mod. 20.05: ELREAL is made double precision
!     40.13, Jan. 01: ! is now added as comment sign
!     40.41, Oct. 04: common blocks replaced by modules, include files removed
!
!  2. PURPOSE
!
!     reads a new data item from the string 'KAART'.
!     type of the item is determined, and the contents appears
!     in ELTEXT, ELINT, or ELREAL, as the case may be.
!     the following types are distinguished:
!     'KEY'   keyword
!     'INT'   integer or real number
!     'REAL'  real number
!     'CHAR'  character string enclosed in quotes
!     'EMPT'  empty data field
!     'OTHR'  non-empty data item not recognized as real, int or char,
!             possibly a time string
!     'EOF'   end of input file
!
!     'EOR'   end of repeat, or end of record
!     'ERR'   error
!     'USED'  used, item last read is processed already.
!
!  3. METHOD
!
!     difference between comment signs $ and !:                           40.13
!     everything on an input line behind a ! is ignored
!     text between two $-signs (on one line) is intepreted as comment
!     text behind two $-signs is intepreted as valid input
!
!  4. ARGUMENT VARIABLES
!
!  5. PARAMETER VARIABLES
!
!  6. LOCAL VARIABLES
!
!     IENT   : Number of entries into this subroutine
!     IRK    : auxiliary value used to detect errors
!     ISIGN1 : sign of mantissa part
!     ISIGN2 : sign of exponent part
!     ISTATE : state of the number reading process
!     J      : counter
!     JJ     : counter
!     JKAR   : counts the number of characters in the data field
!     NREP   : repetition number
!     NUM1   : value of integer part of mantissa
!     NUM2   : exponent value
!
   INTEGER   IENT, IRK, ISIGN1, ISIGN2, ISTATE, J, JJ, JKAR, NREP,     &
             NUM1, NUM2
!
!     RMANT  : real mantissa value
!
   DOUBLE PRECISION RMANT
!
!     QUOTE  : the quote character
!
   CHARACTER QUOTE *1
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
   SAVE  ient, quote, nrep                                             
   DATA  quote/''''/ , ient/0/, nrep/1/
   CALL  strace ( ient, 'LEESEL')
!
   IF(nrep > 1)THEN
     nrep = nrep - 1
     GOTO 190
   ENDIF
!
!  initialisations
!
2  nrep = 1
   DO j=1,lineln,4                                                  
     eltext(j:j+3) = '    '
   END DO  
   jkar = 1
   elint=0
   elreal=0.
!
!  start processing data item
!
   IF(karnr == 0) GOTO 12
!  process a new character
10 IF(kar == '!' .OR. karnr > lineln)THEN                           
!    end of the line is reached, if repetition factor is >1
!    the data item is assumed to be empty
     IF(nrep > 1) GOTO 28
!    end of the line is reached, if no repetition factor appears
!    the data item is assumed to be of type 'EOR'
     eltype='EOR'
     IF(kar == '!') karnr = lineln+1                                  
     GOTO 190
   ENDIF
!  skip leading blanks or Tab characters
11 IF(kar /= ' ' .AND. kar /= tabc) GOTO 20
  
!      print*,'before getkar 1'
12 CALL getkar
!      print*,'after getkar 1'
!     end of input file was reached
   IF(eltype == 'EOF')THEN
!       generate keyword STOP
     eltext='STOP'
     GOTO 190
   ENDIF
   GOTO 10
!  if character is comma, empty data field
20 IF(kar /= ',') GOTO 30
!      print*,'before getkar 2'
   CALL getkar
!      print*,'after getkar 2'
28 eltype='EMPT'
   GOTO 190
!  Notice: jump to label 28 (empty data field)
!  if after repetition a comment, a keyword, end of record etc. is found.
!  --------------------------------------------------------
!  see whether end of repeat (; or /) is marked
30 IF(index(';/',kar) > 0)THEN                                      
     IF(nrep > 1) GOTO 28
     eltype='EOR'
!      print*,'before getkar 3'
     CALL getkar
!      print*,'after getkar 3'
     GOTO 190
   ENDIF
!  ( marks the beginning of a data item group; is ignored
38 IF(kar == '(') GOTO 12
!  --------------------------------------------------------
!  comment; data enclosed in comment identifiers is interpreted as comment
!   print*,'KAR=',KAR,'COMID=',COMID,NREP
40 IF(kar == comid)THEN
     IF(nrep > 1) GOTO 28
!      print*,'before getkar 4'
41   CALL  getkar
!      print*,'after getkar 4'
     IF(karnr > lineln) GOTO 10                                      
     IF(kar /= comid) GOTO 41
     GOTO 12
   ENDIF
!  -------------------------------------------------------
!  if item is a number, read this integer or real number
!
!  integer number:  SIGN1]NUM1
!  real:            SIGN1]NUM1].]MANT]E]SIGN2]NUM2
!     ISTATE =    10     9    8 7    6 5     4    3
!  SIGN1, SIGN2:     + OR -
!  NUM1, NUM2, MANT: series of digits
!     -------------------------------------------------------
50 IF(index('+-.0123456789',kar) == 0) GOTO 80
   num1=0
   num2=0
   isign1=1
   isign2=1
   istate=10
   irk=0
   rmant=0.
   eltype='INT'
   IF(index('+-',kar) == 0) GOTO 52
   istate=9
   IF(kar == '-') isign1=-1
   CALL putkar (eltext, kar, jkar)
!      print*,'before getkar 5'
   CALL getkar
!      print*,'after getkar 5'
!     ****  part before decimal point  ****
52 IF(index('0123456789',kar) == 0) GOTO 54
   irk=1
   istate=8
   num1=10*num1+index('123456789',kar)
   CALL putkar (eltext, kar, jkar)
!      print*,'before getkar 6'
   CALL getkar
!      print*,'after getkar 6'
   GOTO 52
54 IF(kar /= '.') GOTO 56
   istate=7
   eltype='REAL'
   CALL putkar (eltext, kar, jkar)
!      print*,'before getkar 7'
   CALL getkar
!      print*,'after getkar 7'
56 jj=-1
!     ****  part after decimal point  ****
57 IF(index('0123456789',kar) == 0) GOTO 58
   irk=1
   istate=6
   rmant = rmant + dble(index('123456789',kar))*1.d1**jj               
   jj=jj-1
   CALL putkar (eltext, kar, jkar)
!      print*,'before getkar 8'
   CALL getkar
!      print*,'after getkar 8'
   GOTO 57
58 IF(istate >= 9 .OR. irk == 0) GOTO 120
!     ****  exponent part  ****
   IF(index('DdEe^',kar) == 0) GOTO 66
   istate=5
   irk=0
   IF(eltype == 'INT') eltype='REAL'
   CALL putkar (eltext, kar, jkar)
!      print*,'before getkar 9'
   CALL getkar
!      print*,'after getkar 9'
   IF(index('+-',kar) == 0) GOTO 62
   IF(kar == '-') isign2=-1
   istate=4
   CALL putkar (eltext, kar, jkar)
!      print*,'before getkar 10'
   CALL getkar
!      print*,'after getkar 10'
62 IF(index('0123456789',kar) == 0) GOTO 66
   irk=1
   istate=3
   num2=10*num2+index('123456789',kar)
   CALL putkar (eltext, kar, jkar)
!      print*,'before getkar 11'
   CALL getkar
!      print*,'after getkar 11'
   GOTO 62
!     ****  a number is put together  ****
66 IF(irk == 0) GOTO 120
   IF(index('+-.',kar) >= 1) eltype='OTHR'
   istate=2
   IF(itest >= 330) WRITE (printf,699) eltype, isign1, num1,            &
                                       rmant, isign2, num2
699 FORMAT (1x, a4, 2i6, f12.9, 2i6)
   IF(eltype == 'REAL') elreal =                                        &
             isign1*(dble(num1)+rmant) * 1.d1**(isign2*num2)            
   IF(eltype == 'INT') elint = isign1*num1
   lencst = jkar - 1                                                   
!     skip trailing blanks
67 IF(kar /= ' ' .AND. kar /= tabc) GOTO 68
   istate=1
!      print*,'before getkar 12'
   CALL getkar
!      print*,'after getkar 12'
   GOTO 67
!     If a * is encountered now, it is interpreted as a repetition factor.
68 IF(kar == '*')THEN
     IF(eltype == 'INT' .AND. elint > 0)THEN
       nrep = elint
       elint = 0
!      print*,'before getkar 13'
       CALL getkar
!      print*,'after getkar 13'
       GOTO 10
     ELSE
       CALL msgerr (2, 'Wrong repetition factor')
!      print*,'before getkar 14'
       CALL getkar
!       print*,'after getkar 14'
       GOTO 190
     ENDIF
   ENDIF
69 IF(kar == ',')THEN
!      print*,'before getkar 15'
     CALL getkar
!       print*,'after getkar 15'
     GOTO 190
   ENDIF
   IF(istate == 1) GOTO 190
   IF(index(' ;',kar) /= 0 .OR. kar == tabc)THEN
     GOTO 190
   ENDIF
!     number is not followed by , blank or tab; type is made OTHR:
   GOTO 120
!     ----------------------------------------------------------
!     a character string is read; it start and ends with a quote
!     ----------------------------------------------------------
80 IF(kar == quote)THEN                                              
     eltype='CHAR'
     lencst = 0                                                          
     jj=1
!      print*,'before getkar 16'
82   CALL getkar
!       print*,'after getkar 16'
!       end of the string: end of record or closing quote
     IF(karnr > lineln) GOTO 190                                     
     IF(kar == quote)THEN
!      print*,'before getkar 17'
       CALL getkar
!      print*,'after getkar 17'
!         new character is not a quote; end of the string
       IF(kar /= quote) GOTO 88
!         double quote is read as a single quote; continue
     ENDIF
!       put the character into ELTEXT
84   eltext(jj:jj) = kar
     lencst = jj
     jj=jj+1
     GOTO 82
!       process characters behind the string
!      print*,'before getkar 18'
87   CALL getkar
!      print*,'after getkar 18'
!       skip trailing blanks
88   IF(kar == ' ' .OR. kar == tabc) GOTO 87
     IF(kar /= ',') GOTO 190
!      print*,'before getkar 19'
     CALL getkar
!      print*,'after getkar 19'
     GOTO 190
   ENDIF
!     -------------------------------------------------------
!     a keyword is read
!     a keyword starts with a letter (upper or lower case)
!     -------------------------------------------------------
90 CALL upcase (kar)
!   print*,'KAR= ',KAR,'QUOTE= ',QUOTE
   IF(index('ABCDEFGHIJKLMNOPQRSTUVWXYZ',kar) > 0)THEN              
     IF(nrep > 1) GOTO 28
     eltype='KEY'
     istate=2
     jj=1
92   eltext(jj:jj) = kar
     lencst = jj                                                       
!      print*,'before getkar 20'
     CALL getkar
!      print*,'after getkar 20'
     CALL upcase (kar)
     jj=jj+1
!       next characters: letters, digits or - _ .
     IF(index('ABCDEFGHIJKLMNOPQRSTUVWXYZ',kar) >= 1) GOTO 92
     IF(index('0123456789-_.',kar) >= 1) GOTO 92
!       keyword is read
     keywrd = eltext(1:8)
!     print*,'KEYWRD= ',KEYWRD
!       trailing blanks or tab char are skipped
94   IF(kar /= ' ' .AND. kar /= tabc) GOTO  96
!      print*,'before getkar 21'
     CALL getkar
!      print*,'after getkar 21'
     GOTO 94
!       closure character  : or = is processed
96   IF(index('=:',kar) == 0) GOTO 190
!      print*,'before getkar 22'
     CALL getkar
!      print*,'after getkar 22'
     GOTO 190
   ENDIF
!     --------------------------------------------------
!     continuation symbol is read
!     --------------------------------------------------
100 IF(index('_&',kar) == 0) GOTO 120
   IF(nrep > 1) GOTO 28
110 karnr=0
   GOTO 12
!     --------------------------------------------------
!     other type of data
!     --------------------------------------------------
120 eltype='OTHR'
122 eltext(jkar:jkar) = kar                                             
   lencst = jkar                                                       
   jkar=jkar+1
!      print*,'before getkar 23'
   CALL getkar
!       print*,'after getkar 23'
   IF(index(' ,;', kar) >= 1 .OR. kar == tabc) GOTO 126
   GOTO 122
!      print*,'before getkar 24'
126 CALL getkar
!       print*,'after getkar 24'
! 127  CALL MSGERR (3, 'Read error in: ')
!      WRITE (PRINTF,129) ELTEXT
! 129  FORMAT (A)                                                         
!      RETURN
!     --------------------------------------------------
!     test output and return to calling program
!     --------------------------------------------------
190 IF(itest >= 120) WRITE (prtest, 199) kar, karnr, eltype, elreal,   &
                                         elint, nrep, eltext(1:lencst)
199 FORMAT (' test LEESEL: ', a1, 1x, i4, 1x, a4, d12.4, 2i6, 2x, a)    
   RETURN
   END SUBROUTINE leesel

!****************************************************************
!                                                               *
   SUBROUTINE getkar
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
!   USE OCPCOMM3                                                        
   USE ocpcomm4                                                        
!
   IMPLICIT NONE
!
!
!   --|-----------------------------------------------------------|--
!     | Delft University of Technology                            |
!     | Faculty of Civil Engineering                              |
!     | Environmental Fluid Mechanics Section                     |
!     | P.O. Box 5048, 2600 GA  Delft, The Netherlands            |
!     |                                                           |
!     | Programmers: R.C. Ris, N. Booij,                          |
!     |              IJ.G. Haagsma, A.T.M.M. Kieftenburg,         |
!     |              M. Zijlema, E.E. Kriezi,                     |
!     |              R. Padilla-Hernandez, L.H. Holthuijsen       |
!   --|-----------------------------------------------------------|--
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     40.13: Nico Booij
!     40.41: Marcel Zijlema
!
!  1. UPDATES
!
!     40.13, Jan. 2001: TRIM used to limit output
!     40.41, Oct. 04: common blocks replaced by modules, include files removed
!
!  2. PURPOSE
!
!     This procedure reads a next character (KAR) from the string KAART.
!     The position of this character in KAART is indicated by KARNR.
!     If needed, a new input line is read.
!     At the end of the input file ELTYPE is made 'EOF'.
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!  5. PARAMETER VARIABLES
!
!  6. LOCAL VARIABLES
!
!     IENT   : Number of entries into this subroutine
!
   INTEGER   IENT
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
   SAVE ient
   DATA  ient /0/
   CALL strace (ient, 'GETKAR')
   
   IF(karnr == 0)THEN
     READ(inputf, '(A)', end=20) kaart
     
!     print*,'KAART=',trim(KAART),lineln
     IF(itest >= -10) WRITE (printf, '(1X,A)') trim(kaart)                   
     karnr=1
   ENDIF
   IF(karnr > lineln)THEN                                           
     kar=';'
     GOTO 90
   ENDIF
   kar = kaart(karnr:karnr)
!   print*,'KAR=',trim(KAR)
   karnr=karnr+1
   GOTO 90
!     end of file is encountered
20 eltype='EOF'
   kar='@'
90 IF(itest >= 320) WRITE (printf, '(" Test GETKAR", 2X, A4, 2X, A1, I4)')  &
                    eltype, kar, karnr

   RETURN
   END SUBROUTINE getkar
 
!****************************************************************
!                                                               *
   SUBROUTINE putkar (LTEXT, KARR, JKAR)
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
!   USE OCPCOMM3                                                        
   USE ocpcomm4                                                        
!
   IMPLICIT NONE
!
!
!   --|-----------------------------------------------------------|--
!     | Delft University of Technology                            |
!     | Faculty of Civil Engineering                              |
!     | Environmental Fluid Mechanics Section                     |
!     | P.O. Box 5048, 2600 GA  Delft, The Netherlands            |
!     |                                                           |
!     | Programmers: R.C. Ris, N. Booij,                          |
!     |              IJ.G. Haagsma, A.T.M.M. Kieftenburg,         |
!     |              M. Zijlema, E.E. Kriezi,                     |
!     |              R. Padilla-Hernandez, L.H. Holthuijsen       |
!   --|-----------------------------------------------------------|--
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     40.41: Marcel Zijlema
!
!  1. UPDATES
!
!     40.41, Oct. 04: common blocks replaced by modules, include files removed
!
!  2. PURPOSE
!
!     this procedure inserts a character (KARR) usually read by GETKAR
!     into the string LTEXT, usually equal to ELTEXT, in the place
!     JKAR. After this JKAR is increased by 1.
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!     JKAR   : counts the number of characters in a data field
!
   INTEGER  JKAR
!
!     LTEXT  : a character string; after a number of calls it should
!              contain the character representation of a data field
!     KARR   : character to be inserted into LTEXT
!
   CHARACTER LTEXT *(*), KARR *1
!
!  5. PARAMETER VARIABLES
!
!  6. LOCAL VARIABLES
!
!     IENT   : Number of entries into this subroutine
!
   INTEGER   IENT
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
   SAVE ient
   DATA ient /0/
   CALL strace (ient, 'PUTKAR')
   
   IF(jkar > len(ltext)) CALL msgerr (2, 'PUTKAR, string too long')
   ltext(jkar:jkar) = karr
   lencst = jkar
   jkar = jkar + 1
   RETURN
   END SUBROUTINE putkar

!****************************************************************
!                                                               *
   SUBROUTINE upcase (CHARST)
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
!   USE OCPCOMM3                                                        
   USE ocpcomm4                                                        
!
   IMPLICIT NONE
!
!
!   --|-----------------------------------------------------------|--
!     | Delft University of Technology                            |
!     | Faculty of Civil Engineering                              |
!     | Environmental Fluid Mechanics Section                     |
!     | P.O. Box 5048, 2600 GA  Delft, The Netherlands            |
!     |                                                           |
!     | Programmers: R.C. Ris, N. Booij,                          |
!     |              IJ.G. Haagsma, A.T.M.M. Kieftenburg,         |
!     |              M. Zijlema, E.E. Kriezi,                     |
!     |              R. Padilla-Hernandez, L.H. Holthuijsen       |
!   --|-----------------------------------------------------------|--
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     40.41: Marcel Zijlema
!
!  1. UPDATES
!
!     40.41, Oct. 04: common blocks replaced by modules, include files removed
!
!  2. PURPOSE
!
!     changes all characters of the string CHARST from lower to
!     upper case
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!     CHARST : a character string
!
   CHARACTER*(*) CHARST                                                
!
!  5. PARAMETER VARIABLES
!
!  6. LOCAL VARIABLES
!
!     IC     : sequence number of a character in the string CHARST
!     IENT   : Number of entries into this subroutine
!     KK     : position of a character in a given string
!     LLCC   : length of the given character string
!
   INTEGER   IC, IENT, KK, LLCC
!
!     ABCUP  : A to Z upper case characters
!     ABCLO  : a to z lower case characters
!     CC     : a character
!
   CHARACTER ABCUP *26, ABCLO *26, CC *1
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
   SAVE ient
   DATA  ient /0/
   DATA  abcup /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
   DATA  abclo /'abcdefghijklmnopqrstuvwxyz'/
   CALL strace (ient, 'UPCASE')
!
   llcc = len(charst)
   DO ic = 1, llcc
     cc = charst(ic:ic)
     kk = index(abclo, cc)
     IF(kk /= 0) charst(ic:ic) = abcup(kk:kk)
   END DO  
   RETURN
   END SUBROUTINE upcase
 
!****************************************************************
!                                                               *
   LOGICAL FUNCTION keywis (STRING)
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
   USE ocpcomm3                                                        
   USE ocpcomm4                                                        
!
   IMPLICIT NONE
!
!
!   --|-----------------------------------------------------------|--
!     | Delft University of Technology                            |
!     | Faculty of Civil Engineering                              |
!     | Environmental Fluid Mechanics Section                     |
!     | P.O. Box 5048, 2600 GA  Delft, The Netherlands            |
!     |                                                           |
!     | Programmers: R.C. Ris, N. Booij,                          |
!     |              IJ.G. Haagsma, A.T.M.M. Kieftenburg,         |
!     |              M. Zijlema, E.E. Kriezi,                     |
!     |              R. Padilla-Hernandez, L.H. Holthuijsen       |
!   --|-----------------------------------------------------------|--
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     40.41: Marcel Zijlema
!
!  1. UPDATES
!
!     40.00, July
!     40.41, Oct. 04: common blocks replaced by modules, include files removed
!
!  2. PURPOSE
!
!     This procedure tests whether a keyword given by the user
!     coincides with a keyword known in the program (i.e. string).
!     if so, keywis is made .True., otherwise it is .False.
!     also ELTYPE is made 'USED', so that next element can be read.
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!     STRING : a keyword which is compared with a keyword found in the input file
!
   CHARACTER string *(*)
!
!  5. PARAMETER VARIABLES
!
!  6. LOCAL VARIABLES
!
!     IENT   : Number of entries into this subroutine
!     J      : counter
!     LENSS  : length of the keyword STRING
!
   INTEGER   ient, j, lenss
!
!     KAR1   : a character of the keyword appearing in the input file
!     KAR2   : corresponding character in the STRING
!
   CHARACTER kar1 *1, kar2 *1
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
   SAVE ient
   DATA ient /0/
   CALL strace (ient, 'KEYWIS')
!
   keywis = .false.
   IF(eltype == 'USED') GOTO 30
!
   keywis=.true.
   lenss = len(string)
   DO  j=1, lenss
     kar1 = keywrd(j:j)
     kar2 = string(j:j)
     IF(kar1 /= kar2 .AND. kar2 /= ' ')THEN                          
       keywis=.false.
       GOTO 30
     ENDIF
   END DO
   IF(eltype == 'KEY') eltype = 'USED'
30 RETURN
   END FUNCTION keywis

!****************************************************************
!                                                               *
   SUBROUTINE  wrnkey
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
   USE ocpcomm3                                                        
   USE ocpcomm4                                                        
!
   IMPLICIT NONE
!
!
!   --|-----------------------------------------------------------|--
!     | Delft University of Technology                            |
!     | Faculty of Civil Engineering                              |
!     | Environmental Fluid Mechanics Section                     |
!     | P.O. Box 5048, 2600 GA  Delft, The Netherlands            |
!     |                                                           |
!     | Programmers: R.C. Ris, N. Booij,                          |
!     |              IJ.G. Haagsma, A.T.M.M. Kieftenburg,         |
!     |              M. Zijlema, E.E. Kriezi,                     |
!     |              R. Padilla-Hernandez, L.H. Holthuijsen       |
!   --|-----------------------------------------------------------|--
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     40.41: Marcel Zijlema
!
!  1. UPDATES
!
!     40.41, Oct. 04: common blocks replaced by modules, include files removed
!
!  2. PURPOSE
!
!     THIS PROCEDURE PRODUCES AN ERROR MESSAGE
!     IT IS CALLED IF AN ILLEGAL KEYWORD IS FOUND IN THE
!     USER'S INPUT. IT MAKES ELTYPE = 'USED'
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!  5. PARAMETER VARIABLES
!
!  6. LOCAL VARIABLES
!
!     IENT   : Number of entries into this subroutine
!
   INTEGER   IENT
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
   SAVE ient
   DATA ient /0/
   CALL strace (ient, 'WRNKEY')
!
   CALL msgerr (2, 'Illegal keyword: '//keywrd)
   eltype = 'USED'
   RETURN
   END SUBROUTINE wrnkey
 
!****************************************************************
!                                                               *
   SUBROUTINE ignore (STRING)
!                                                               *
!****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
   USE ocpcomm3                                                        
   USE ocpcomm4                                                        
!
   IMPLICIT NONE
!
!
!   --|-----------------------------------------------------------|--
!     | Delft University of Technology                            |
!     | Faculty of Civil Engineering                              |
!     | Environmental Fluid Mechanics Section                     |
!     | P.O. Box 5048, 2600 GA  Delft, The Netherlands            |
!     |                                                           |
!     | Programmers: R.C. Ris, N. Booij,                          |
!     |              IJ.G. Haagsma, A.T.M.M. Kieftenburg,         |
!     |              M. Zijlema, E.E. Kriezi,                     |
!     |              R. Padilla-Hernandez, L.H. Holthuijsen       |
!   --|-----------------------------------------------------------|--
!
!
!     SWAN (Simulating WAves Nearshore); a third generation wave model
!     Copyright (C) 2004-2005  Delft University of Technology
!
!     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; either version 2 of
!     the License, or (at your option) any later version.
!
!     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.
!
!     A copy of the GNU General Public License is available at
!     http://www.gnu.org/copyleft/gpl.html#SEC3
!     or by writing to the Free Software Foundation, Inc.,
!     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!
!  0. AUTHORS
!
!     40.41: Marcel Zijlema
!
!  1. UPDATES
!
!     40.41, Oct. 04: common blocks replaced by modules, include files removed
!
!  2. PURPOSE
!
!     This procedure calls subroutine INKEYW to read a keyword.
!     if this keyword is equal to string, eltype is made 'USED'.
!     it is used if a keyword can occur in the input which
!     does not lead to any action.
!
!  3. METHOD
!
!  4. ARGUMENT VARIABLES
!
!     STRING : keyword (if appearing in input file) that can be ignored
!
   CHARACTER STRING *(*)
!
!  5. PARAMETER VARIABLES
!
!  6. LOCAL VARIABLES
!
!     IENT   : Number of entries into this subroutine
!
   INTEGER   IENT
!
!     KEYWIS : logical function
!
   LOGICAL   KEYWIS
!
!  8. SUBROUTINE USED
!
!  9. SUBROUTINES CALLING
!
! 10. ERROR MESSAGES
!
! 11. REMARKS
!
! 12. STRUCTURE
!
! 13. SOURCE TEXT
!
   SAVE ient
   DATA ient /0/
   CALL strace (ient, 'IGNORE')
!
   CALL inkeyw ('STA', 'XXXX')
   IF(keywis(string)) RETURN
   IF(keywis('XXXX')) RETURN
   IF(itest >= 60) WRITE (printf, 5) keywrd, eltype
5  FORMAT (' NOT IGNORED: ', a, 2x, a)
   RETURN
   END SUBROUTINE ignore