ocpcre.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	rdinit
subroutine	nwline
subroutine	inkeyw (KONT, CSTA)
subroutine	inreal (NAAM, R, KONT, RSTA)
subroutine	inintg (NAAM, IV, KONT, ISTA)
subroutine	inlogc (NAAM, L, KONT, LSTA)
subroutine	incstr (NAAM, C, KONT, CSTA)
subroutine	inctim (IOPTIM, NAAM, RV, KONT, RSTA)
subroutine	inintv (NAME, RVAR, KONT, RSTA)
subroutine	leesel
subroutine	getkar
subroutine	putkar (LTEXT, KARR, JKAR)
subroutine	upcase (CHARST)
logical function	keywis (STRING)
subroutine	wrnkey
subroutine	ignore (STRING)

Function/Subroutine Documentation

getkar()

subroutine getkar

(

)

Definition at line 1643 of file ocpcre.f90.

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

Here is the call graph for this function:

Here is the caller graph for this function:

ignore()

subroutine ignore

(

character, dimension(*)

STRING

)

Definition at line 2185 of file ocpcre.f90.

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

Here is the call graph for this function:

Here is the caller graph for this function:

incstr()

subroutine incstr	(	character, dimension(*)	NAAM,
		character, dimension(*)	C,
		character, dimension(*)	KONT,
		character, dimension(*)	CSTA
	)

Definition at line 777 of file ocpcre.f90.

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

Here is the call graph for this function:

inctim()

subroutine inctim	(	integer	IOPTIM,
		character, dimension(*)	NAAM,
		real	RV,
		character, dimension(*)	KONT,
		real	RSTA
	)

Definition at line 899 of file ocpcre.f90.

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

Here is the call graph for this function:

inintg()

subroutine inintg	(	character, dimension(*)	NAAM,
		integer	IV,
		character, dimension(*)	KONT,
		integer	ISTA
	)

Definition at line 525 of file ocpcre.f90.

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

Here is the call graph for this function:

inintv()

subroutine inintv	(	character, dimension(*)	NAME,
		real	RVAR,
		character, dimension(*)	KONT,
		real	RSTA
	)

Definition at line 1056 of file ocpcre.f90.

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

Here is the call graph for this function:

inkeyw()

subroutine inkeyw	(	character, dimension(*)	KONT,
		character, dimension(*)	CSTA
	)

Definition at line 243 of file ocpcre.f90.

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

Here is the call graph for this function:

Here is the caller graph for this function:

inlogc()

subroutine inlogc	(	character, dimension(*)	NAAM,
		logical	L,
		character, dimension(*)	KONT,
		logical	LSTA
	)

Definition at line 653 of file ocpcre.f90.

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

Here is the call graph for this function:

inreal()

subroutine inreal	(	character, dimension(*)	NAAM,
		real	R,
		character, dimension(*)	KONT,
		real	RSTA
	)

Definition at line 396 of file ocpcre.f90.

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

Here is the call graph for this function:

Here is the caller graph for this function:

keywis()

logical function keywis

(

character, dimension(*)

STRING

)

Definition at line 1974 of file ocpcre.f90.

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

Here is the call graph for this function:

leesel()

subroutine leesel

(

)

Definition at line 1204 of file ocpcre.f90.

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

Here is the call graph for this function:

Here is the caller graph for this function:

nwline()

subroutine nwline

(

)

Definition at line 128 of file ocpcre.f90.

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

Here is the call graph for this function:

putkar()

subroutine putkar	(	character, dimension(*)	LTEXT,
		character	KARR,
		integer	JKAR
	)

Definition at line 1758 of file ocpcre.f90.

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

Here is the call graph for this function:

Here is the caller graph for this function:

rdinit()

subroutine rdinit

(

)

Definition at line 36 of file ocpcre.f90.

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

Here is the call graph for this function:

Here is the caller graph for this function:

upcase()

subroutine upcase

(

character*(*)

CHARST

)

Definition at line 1863 of file ocpcre.f90.

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

Here is the call graph for this function:

Here is the caller graph for this function:

wrnkey()

subroutine wrnkey

(

)

Definition at line 2092 of file ocpcre.f90.

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

Here is the call graph for this function: