FVCOMin/doxygen/ocpmix_8f90_source.html

 !     Ocean Pack miscellaneous routines
 !
 !     real function DTTIME
 !     subroutine    DTINTI
 !     subroutine    DTRETI
 !     char function DTTIWR
 !     REPARM
 !     INAR2D
 !     STRACE
 !     MSGERR
 !     TABHED
 !     FOR
 !     logical function EQREAL
 !     LSPLIT
 !     BUGFIX
 !     COPYCH (copied from file OCPDPN)
 !
 !*******************************************************************
 !                                                                  *
       REAL FUNCTION DTTIME (INTTIM)
 !                                                                  *
 !*******************************************************************
 !
       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
 !
 !     30.74: IJsbrand Haagsma (Include version)
 !     40.41: Marcel Zijlema
 !
 !  1. Updates
 !
 !      9705, May  97: month number is checked
 !     30.74, Nov. 97: Prepared for version with INCLUDE statements
 !     40.41, Oct. 04: common blocks replaced by modules, include files removed
 !
 !  2. Purpose
 !
 !     DTTIME gives time in seconds from a reference day
 !            it also initialises the reference day
 !
 !  3. Method
 !
 !     every fourth year is a leap-year, but not the century-years, however
 !     also leap-years are: year 0, 1000, 2000 etc.
 !     1 jan of year 0 is daynumber 1.
 !
 !  4. Argument variables
 !
 !     INTTIM(1): year
 !           (2): month
 !           (3): day
 !           (4): hour
 !           (5): minute
 !           (6): second
 !
       INTEGER inttim(6)
 !
 !  5. PARAMETER VARIABLES
 !
 !  6. LOCAL VARIABLES
 !
 !     IDYMON : number of days of each month (February counts as 28 days)
 !     IYEAR  : number of years after substacking the centuries
 !     IYRM1  : ??
 !     IDNOW  : ??
 !     I      : ??
 !     II     : ??
 !
       INTEGER idymon(12), iyear, iyrm1, idnow, i, ii
 !
 !     LEAPYR : Whether year in INTTIM(1) is a leapyear
 !     LOGREF : ??
 !
       LOGICAL leapyr, logref
 !
 !     REFDAY  day number of the reference day; the reference time is 0:00
 !            of the reference day; the first day entered is used as
 !             reference day.
 !
 !
 !  8. SUBROUTINE USED
 !
 !  9. SUBROUTINES CALLING
 !
 ! 10. ERROR MESSAGES
 !
 ! 11. REMARKS
 !
 ! 12. STRUCTURE
 !
 ! 13. SOURCE TEXT
 !
       SAVE logref, idymon
       DATA idymon /31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/
       DATA logref /.false./
 !
       iyear = inttim(1)
       iyrm1 = iyear-1
       leapyr=(mod(iyear,4) == 0 .AND. mod(iyear,100) /= 0) .OR.     &
               mod(iyear,1000) == 0
       idnow=0
       IF(inttim(2) > 12)THEN
         WRITE (printf, 8) inttim(2), (inttim(ii), ii=1,6)
    8    FORMAT (' erroneous month ', i2, ' in date/time ', 6i4)
       ELSE IF(inttim(2) > 1)THEN
         DO 10 i = 1,inttim(2)-1
           idnow=idnow+idymon(i)
   10    CONTINUE
       ENDIF
       idnow=idnow+inttim(3)
       IF(leapyr .AND. inttim(2) > 2) idnow=idnow+1
       idnow = idnow + iyear*365 + iyrm1/4 - iyrm1/100 + iyrm1/1000 + 1
       IF(iyear == 0) idnow=idnow-1
       IF(.NOT.logref)THEN
         refday = idnow
         logref = .true.
         dttime = 0.
       ELSE
         dttime = real(idnow-refday) * 24.*3600.
       ENDIF
       dttime = dttime + 3600.*real(inttim(4)) + 60.*real(inttim(5)) +     &
                REAL(inttim(6))
       RETURN
       END FUNCTION dttime
 !*****************************************************************
 !                                                                *
    SUBROUTINE inar2d (ARR, MGA,                                  &
                       NDSL,                                      &
               NDSD, IDFM, RFORM,                         &
                       IDLA, VFAC,                                &
               NHED, NHEDF)
 !                                                                *
 !*****************************************************************
 !
    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
 !
 !     30.72: IJsbrand Haagsma
 !     30.74: IJsbrand Haagsma (Include version)
 !     30.82: IJsbrand Haagsma
 !     34.01: Jeroen Adema
 !     40.00: Nico Booij
 !     40.02: IJsbrand Haagsma
 !     40.03: Nico Booij
 !     40.08: Erick Rogers
 !     40.13: Nico Booij
 !     40.41: Marcel Zijlema
 !
 !  1. Updates
 !
 !     01.05, Feb. 90: Before reading values in the array are divided by VFAC,
 !                     in order to retain correct values for points where no
 !                     value was given
 !     01.06, Apr. 91: i/o status is printed if read error occurs
 !     30.72, Sept 97: Changed DO-block with one CONTINUE to DO-block with
 !                     two CONTINUE's
 !     30.72, Sept 97: Corrected reading of heading lines for SERIES of files
 !                     in dynamic mode
 !     30.74, Nov. 97: Prepared for version with INCLUDE statements
 !     40.00, July 98: SWAN specific statements modified
 !                     unformatted read: heading lines also read unformatted
 !                     distinction between NDSD (data file) and NDSL (file list)
 !     30.82, Sep. 98: Added INQUIRE statement to produce correct file name in
 !                     case of a read error
 !     34.01, Feb. 99: Introducing STPNOW
 !     40.02, Sep. 00: Replaced computed GOTO with CASE construct
 !     40.02, Sep. 00: Replaced reserved words IOSTAT with IOERR and STATUS with IERR
 !     40.03, Jul. 00: END= added to READ statement for correct reading of series
 !                     of files
 !     40.03, Jul. 00: TRIM used to improve readability of message
 !     40.13, Apr. 01: END=930 added in READ statement; corresponding error message added
 !     40.08, Mar. 03: Changed an INQUIRE statement so that it does not produce
 !                     misleading results.
 !     40.41, Oct. 04: common blocks replaced by modules, include files removed
 !
 !  2. Purpose
 !
 !     Reads a 2d array from dataset
 !     is used to read e.g. bathymetry, one component of wind velocity
 !
 !  3. METHOD
 !
 !  4. ARGUMENT VARIABLES
 !
 !     IDFM   : input    format index
 !     IDLAM  : input    lay-out indicator
 !     MXA    : input    number of points along x-side of grid
 !     MYA    : input    number of points along y-side of grid
 !     NDSD   : input    unit number of the file from which to read the dataset
 !     NDSL   : input    unit number of the file containing the list of filenames
 !     NHEDF  : input    number of heading lines in the file (first lines).
 !     NHEDL  : input    number of heading lines in the file
 !                       before each array
 !
    INTEGER   IDFM, IDLA, MGA, NDSD, NDSL, NHED, NHEDF
 !
 !     ARR    : input    results appear in this array
 !     RFORM  : input    format used in reading data (char. string)
 !     VFAC   : input    factor by which data must be multiplied.
 !
    REAL      ARR(MGA), VFAC
 !
    CHARACTER RFORM *(*)
 !
 !  5. PARAMETER VARIABLES
 !
 !  6. LOCAL VARIABLES
 !
 !     IERR   : ??
 !     IENT   : number of entries into this subroutine
 !     IOERR  : input   0 : Full messages printed
 !                      -1: Only error messages printed
 !                      -2: No messages printed
 !              output  error indicator
 !     IH     : ??
 !     IX     : ??
 !     IY     : ??
 !     NUMFIL : ??
 !
    INTEGER   IERR, IENT, IOERR, IH, IX, IY, NUMFIL
 !
 !     HEDLIN : Content of a header line
 !
    CHARACTER HEDLIN *80
 !
 !  8. SUBROUTINE USED
 !
    LOGICAL STPNOW
 !
 !  9. SUBROUTINES CALLING
 !
 ! 10. ERROR MESSAGES
 !
 ! 11. REMARKS
 !
 ! 12. STRUCTURE
 !
 ! 13. SOURCE TEXT
 !
    INTEGER IG
    SAVE IENT
    DATA IENT /0/
    CALL STRACE (IENT, 'INAR2D')
 !
 999  IF(ndsd < 0) RETURN
 !     no reading from file due to open error
 !
 !     *** NUMFIL is the number of that is open in one time step  **
       numfil = 0
 !      IF(ITEST >= 100)THEN
 !        WRITE (PRINTF, 12) MXA, MYA, NDSD, IDFM, RFORM,                   40.00
 !     &  IDLA, VFAC, NHED
 !  12    FORMAT (' * TEST INAR2D *', 4I4, 1X, A16, I3, 1X, E12.4, I3)
 !      ENDIF
 !
 !     Read heading lines, and print the same:
 !
   11  IF (nhed.GT.0) THEN
         IF (idfm.LT.0) THEN
           IF (itest.GE.30)                                      &
                   WRITE (printf, '(I3,A)') nhed, ' Heading lines'
           DO 28 ih=1, nhed
             READ (ndsd, end=910)
   28      CONTINUE
         ELSE
           DO 30 ih=1, nhed
             READ (ndsd, '(A80)', end=910) hedlin
             IF (ih.EQ.1) WRITE (printf, '(A)') ' **  Heading lines  **'
             WRITE (printf, '(A4,A80)') ' -> ', hedlin
   30      CONTINUE
         ENDIF
       ENDIF
 !
 !     divide existing values in the array by VFAC
 !
       DO ig = 1, mga
         arr(ig) = arr(ig) / vfac
       END DO
 !
 !     start reading of 2D-array
 !
       READ(ndsd, end=910, err=920, iostat=ierr) (arr(ig), ig=1,mga)
       GOTO 900
 !
 !     *** End of data file, in case SERIES next file is opened
 !     *** unit = NDSD is closed before the next one is opened
 !
  910  CONTINUE
       CLOSE(ndsd)
       numfil = numfil + 1
       IF (numfil .GE. 2) GO TO 911
       IF (ndsl.GT.0) THEN
         READ (ndsl, '(A)', end=930) filenm
         IF (idfm.NE.-1) THEN
           ioerr = 0
           CALL for (ndsd, filenm, 'OF', ioerr)
           IF (stpnow()) RETURN
         ELSE
           ioerr = 0
           CALL for (ndsd, filenm, 'OU', ioerr)
           IF (stpnow()) RETURN
         ENDIF
 !
 !       Read heading lines, and print these:
 !
   2     IF (nhedf.GT.0) THEN
           IF (idfm.LT.0) THEN
             IF (itest.GE.30) WRITE (printf, '(I3,A,A)') nhedf,      &
                  ' Heading lines at begin of file ', trim(filenm)
             DO 828 ih=1, nhedf
               READ (ndsd)
  828        CONTINUE
           ELSE
             WRITE (printf, '(A,A,A)') ' **  Heading lines file ',   &
            trim(filenm), ' **'
             DO 830 ih=1, nhedf
               READ (ndsd, '(A80)') hedlin
               WRITE (printf, '(A4,A80)') ' -> ', hedlin
  830        CONTINUE
           ENDIF
         ENDIF
         GO TO 11
       ENDIF
 !
 !     error message when end of file is encountered
 !
 !     --- initialize FILENM so that previous value is not used            40.08
 !         in case unit NDSD does not exist                                40.08
  911  filenm='DUMMY'
 !     --------------------------------------------------------------------40.08
 !     THIS INQUIRE STATEMENT IS PROBLEMATIC, SINCE (AT LEAST              40.08
 !     SOMETIMES) NDSD HAS ALREADY BEEN CLOSED, SO THE INQUIRE             40.08
 !     STATEMENT SHOULD NOT WORK.                                          40.08
 !     --------------------------------------------------------------------40.08
       INQUIRE (unit=ndsd, name=filenm)
       CALL msgerr (2, 'Unexpected end of file while reading '//       &
                       trim(filenm))
       ndsd = 0
       idla = -1
 !     Value of IDLA=-1 signals end of file to calling program
 !
       GOTO 900
 !
 !     --- initialize FILENM
  920  filenm='DUMMY'
       INQUIRE (unit=ndsd, name=filenm)
       CALL msgerr (2, 'Error while reading file '//trim(filenm))
       WRITE (printf, 922) ierr
  922  FORMAT (' i/o status ', i6)
       idla = -2
 !     Value of IDLA=-2 signals read error to calling program
 !
 !     Multiply all values in the array by VFAC
 !
  900  DO ig = 1, mga
         arr(ig) = arr(ig) * vfac
       END DO
 !
  990  IF (itest.GE.100 .OR. idla.LT.0) THEN
 !        DO 996 IY=MYA, 1, -1
 !          WRITE (PRINTF, 994) (ARR(IX,IY), IX=1,MXA)
 ! 994      FORMAT ((1X, 10E12.4))
 ! 996    CONTINUE
       ENDIF
       RETURN

 !     No more files in NDSL:
 !     --- initialize FILENM
  930  filenm='DUMMY'
       INQUIRE (unit=ndsl, name=filenm)
       CALL msgerr (2, 'Series of input files ended in '//trim(filenm))
       RETURN

       END SUBROUTINE inar2d
 !
 !*****************************************************************
 !                                                                *
    SUBROUTINE strace (IENT, SUBNAM)
 !                                                                *
 !*****************************************************************
 !
    USE ocpcomm1
    USE ocpcomm2
    USE ocpcomm3
    USE ocpcomm4
    USE m_parall
 !
    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 subroutine produces depending on the value of 'ITRACE'
 !     a message containing the name 'SUBNAM'. the purpose of this
 !     action is to detect the entry of a subroutine.
 !
 !  3. METHOD
 !
 !     the first executable statement of subroutine 'AAA' has to
 !     be : CALL STRACE(IENT,'AAA')
 !     further is necessary : DATA IENT/0/
 !     IF ITRACE=0, no message
 !     IF ITRACE>0, a message is printed up to ITRACE times
 !
 !  4. ARGUMENT VARIABLES
 !
 !     IENT   :  i/o    Number of entries into the calling subroutine
 !
    INTEGER IENT
 !
 !     SUBNAM :  inp    name of the calling subroutine.
 !
    CHARACTER SUBNAM *(*)
 !
 !  5. PARAMETER VARIABLES
 !
 !  6. LOCAL VARIABLES
 !                                                                         40.31
 !$    LOGICAL,EXTERNAL :: OMP_IN_PARALLEL                                 40.31
 !
 !  8. SUBROUTINE USED
 !
 !  9. SUBROUTINES CALLING
 !
 ! 10. ERROR MESSAGES
 !
 ! 11. REMARKS
 !
 ! 12. STRUCTURE
 !
 ! 13. SOURCE TEXT
 !
    IF(itrace == 0) RETURN
    IF(ient > itrace) RETURN
 !$ IF(OMP_IN_PARALLEL())THEN
 !$OMP MASTER
 !$   IENT=IENT+1
 !$   WRITE (PRTEST, 10) SUBNAM
 !$   IF(SCREEN /= PRINTF) WRITE (SCREEN, 10) SUBNAM
 !$OMP END MASTER
 !$ ELSE
      ient=ient+1
      WRITE (prtest, 10) subnam
      IF(screen /= printf .AND. inode == master) WRITE (screen, 10) subnam
 !$ ENDIF
 10 FORMAT (' ++ trace subr: ',a)
    RETURN
    END SUBROUTINE strace

 !*****************************************************************
 !                                                                *
    SUBROUTINE msgerr (LEV,STRING)
 !                                                                *
 !*****************************************************************
 !
    USE ocpcomm1
    USE ocpcomm2
    USE ocpcomm3
    USE ocpcomm4
    USE m_parall
 !
    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.02: IJsbrand Haagsma
 !     40.03, 40.13: Nico Booij
 !     40.30: Marcel Zijlema
 !     40.41: Marcel Zijlema
 !
 !  1. UPDATES
 !
 !     40.03, Aug. 00: variable ERRFNM introduced in order to get correct
 !                     message on UNIX system
 !     40.02, Sep. 00: Removed STOP statement
 !     40.13, Nov. 01: OPEN statement instead of CALL FOR
 !                     to prevent recursive subroutines calling
 !     40.30, Jan. 03: introduction distributed-memory approach using MPI
 !     40.41, Oct. 04: common blocks replaced by modules, include files removed
 !
 !  2. PURPOSE
 !
 !     Error messages are produced by subroutine MSGERR. if necessary
 !     the value of LEVERR is increased.
 !     In case of a high error level an error message file is opened
 !
 !  3. METHOD
 !
 !  4. ARGUMENT VARIABLES
 !
 !     LEV    : indicates how severe the present error is
 !     STRING : contents of the present error message
 !
    INTEGER   LEV
 !
    CHARACTER STRING*(*)
 !
 !  5. PARAMETER VARIABLES
 !
 !  6. LOCAL VARIABLES
 !
 !     IERR   : if non-zero error message file was already opened unsuccessfully
 !     IERRF  : unit reference number of the error message file
 !     ILPOS  : actual length of error message filename
 !
    INTEGER, SAVE :: IERR=0, ierrf=0
    INTEGER ILPOS
 !
 !     ERRM   : error message prefix
 !
    CHARACTER (LEN=17) :: ERRM
 !
 !     ERRFNM : name of error message file
 !
    CHARACTER (LEN=LENFNM), SAVE :: ERRFNM = 'Errfile'
 !
 !  8. SUBROUTINE USED
 !
 !     ---
 !
 !  9. SUBROUTINES CALLING
 !
 ! 10. ERROR MESSAGES
 !
 ! 11. REMARKS
 !
 ! 12. STRUCTURE
 !
 ! 13. SOURCE TEXT
 !
 !
    IF(lev > leverr) leverr=lev
    IF(lev == 0)THEN
      errm = 'Message          '
    ELSE IF(lev == 1)THEN
      errm = 'Warning          '
    ELSE IF(lev == 2)THEN
      errm = 'Error            '
    ELSE IF(lev == 3)THEN
      errm = 'Severe error     '
    ELSE
      errm = 'Terminating error'
    ENDIF
    WRITE (printf,12) errm, string
 12 FORMAT (' ** ', a, ': ',a)
    IF(lev > maxerr)THEN
      IF(ierrf == 0)THEN
        IF(ierr /= 0) RETURN
 !
 !      append node number to ERRFNM in case of
 !      parallel computing
 !
        IF(parll)THEN
          ilpos = index( errfnm, ' ' )-1
          WRITE(errfnm(ilpos+1:ilpos+4),13) inode
 13       FORMAT('-',i3.3)
        END IF
 !
        ierrf = 17
        OPEN (unit=ierrf, file=errfnm, form='FORMATTED')
      ENDIF
      WRITE (ierrf,14) errm, string
 14   FORMAT (a, ': ',a)
    ENDIF
 !
    RETURN
 !
    END SUBROUTINE msgerr

 !
 !*****************************************************************
 !                                                                *
    LOGICAL FUNCTION stpnow()
 !                                                                *
 !*****************************************************************
 !
    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
 !
 !     30.82, Feb. 99: IJsbrand Haagsma
 !     40.41: Marcel Zijlema
 !
 !  1. Updates
 !
 !     30.82: New function
 !     40.41, Oct. 04: common blocks replaced by modules, include files removed
 !
 !  2. Purpose
 !
 !     Function determines wheter the SWAN program should be stopped
 !     due to a terminating error
 !
 !  3. Method
 !
 !     Compares two common variables (the maximum allowable error-level,
 !     MAXERR and the actual error-level: LEVERR).
 !
 !  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,'STPNOW')
 !
    IF(leverr >= 4)THEN
      stpnow = .true.
    ELSE
      stpnow = .false.
    END IF
    IF(maxerr == -1) stpnow = .false.
 !
    RETURN
    END FUNCTION stpnow

 !*****************************************************************
 !                                                                *
    SUBROUTINE for (IUNIT, DDNAME, SF, IOSTAT)
 !                                                                *
 !*****************************************************************
 !
    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
 !
 !     30.13: Nico Booij
 !     30.70: Nico Booij
 !     30.82: IJsbrand Haagsma
 !     34.01: IJsbrand Haagsma
 !     40.00, 40.03: Nico Booij
 !     40.41: Marcel Zijlema
 !
 !  1. Updates
 !
 !     30.13, Jan. 96: new structure
 !     30.70, Feb. 98: terminating error if input file does not exist
 !     30.82, Nov. 98: Introduced recordlength of 1000 for new files to
 !                     avoid errors on the Cray-J90
 !     34.01, Feb. 99: STOP statement removed
 !     40.00, Feb. 99: DIRCH2 replaces DIRCH1 in filenames
 !     40.03, May  00: modification for Linux: local copy of filename
 !     40.41, Oct. 04: common blocks replaced by modules, include files removed
 !
 !  1. PURPOSE
 !
 !     General open file routine.
 !
 !  2. METHOD
 !
 !     FORTRAN 77 OPEN option.
 !                INQUIRE
 !
 !  3. METHOD
 !
 !  4. ARGUMENT VARIABLES
 !
 !       IUNIT   int     input   =0 : get free unit number
 !                               >0 : fixed unit number
 !                       output  allocated unit number
 !       DDNAME  char    input   ddname/filename string (empty if IUNIT>0)
 !       SF      char*2  input   file qualifiers
 !                               1st char: O(ld),N(ew),S(cratch),U(nknown)
 !                               2nd char: F(ormatted),U(nformatted)
 !       IOSTAT  int     input   0 : Full messages printed
 !                               -1: Only error messages printed
 !                               -2: No messages printed
 !                       output  error indicator
 !
    INTEGER   IUNIT, IOSTAT
    CHARACTER DDNAME*(LENFNM), SF*2
 !
 !  5. PARAMETER VAR. (CONSTANTS)
 !
 !     Error codes:
 !
 !       IOSTAT = IESUCC No errors
 !       IOSTAT > 0      I/O error
 !       IOSTAT = IENUNF No free unit number found
 !       IOSTAT = IEUNBD Specified unit number out of bounds
 !       IOSTAT = IENODD No filename supplied with IUNIT=0
 !       IOSTAT = IEDDNM Incorrect filename supplied with IUNIT>0
 !       IOSTAT = IEEXST Specified unit number does not exist
 !       IOSTAT = IEOPEN Specified unit number already opened
 !       IOSTAT = IESTAT Error in file qualifiers
 !       IOSTAT = IENSCR Named scratch file
 !       IOSTAT = IENSIO No specified I/O error
 !
    INTEGER  IESUCC, IENUNF, IEUNBD, IENODD,                     &
             IEDDNM, IEEXST, IEOPEN, IESTAT, IENSCR
    PARAMETER (IESUCC=  0,ienunf= -1,ieunbd= -2,ienodd= -3,      &
               ieddnm= -4,ieexst= -5,ieopen= -6,iestat= -7,      &
           ienscr=-12)
 !
 !  EMPTY    blank string
 !
    CHARACTER  EMPTY*(*)
    PARAMETER (EMPTY= '        ')
 !
 !  6. LOCAL VARIABLES
 !
 !     IENT      number of entries into this subroutine
 !     IFO       format index
 !     IFUN      free unit number
 !     II        counter
 !     IOSTTM    aux. error index
 !     IS        file status index
 !     IUTTM     aux. unit number
 !
    INTEGER   IENT, IFO, IFUN, II, IOSTTM, IS, IUTTM
 !
 !     EXIST     if true, file exists
 !     OPENED    if true, file is opened
 !
    LOGICAL   EXIST, OPENED
 !
 !     S
 !     F
 !     FILTTM   auxiliary
 !     FISTAT   file status, values: OLD, NEW, UNKNOWN
 !     FORM     formatting, values: FORMATTED, UNFORMATTED
 !     DDNAME_L local copy of DDNAME
 !
    CHARACTER S, F, FILTTM *(LENFNM), DDNAME_L *(LENFNM)
    CHARACTER *11 FISTAT(4),FORM(2)
 !
 !  4. SUBROUTINES USED
 !
 !
 !  5. ERROR MESSAGES
 !
 !       and error messages added using MSGERR
 !
 !
 !  6. REMARKS
 !
 !       Free unit number search interval: FUNLO<=IUNIT<=FUNHI
 !       FUNLO, FUNHI, IUNMIN and IUNMAX were initialized by OCPINI,
 !       they are transmitted via module OCPCOMM4
 !
 !  7. STRUCTURE
 !
 !       ----------------------------------------------------------------
 !       Check file qualifiers
 !       ----------------------------------------------------------------
 !       If IUNIT = 0
 !       Then If DDNAME = ' '
 !            Then error message
 !            Else Inquire to find if file exists and is opened,
 !                 and if so, to find correct unit number
 !                 If file is not opened
 !                 Then get a free unit number, assign value to IUNIT
 !                      open the file
 !                 Else assign correct unit number to IUNIT
 !       Else Inquire to find if file exists and is opened,
 !                   and if so, to find correct filename
 !            If file with unit nr IUNIT is already open
 !            Then If filename does not correspond to DDNAME
 !                 Then Close file with old filename and unit IUNIT
 !                      Open file with new filename DDNAME and unit IUNIT
 !            Else If DDNAME is not empty
 !                 Then Open file with new filename DDNAME and unit IUNIT
 !                 Else Open file with unit IUNIT
 !       ----------------------------------------------------------------
 !
 !  8. SOURCE TEXT
 !
    SAVE      ient, ifun
 !
    DATA fistat(1),fistat(2) / 'OLD','NEW'/                            &
         fistat(3),fistat(4) / 'SCRATCH','UNKNOWN'/                    &
     form(1),form(2) / 'FORMATTED','UNFORMATTED'/
 !
    DATA ient /0/, ifun /0/
    CALL strace (ient, 'FOR')
 !
    IF(itest >= 80) WRITE (prtest, 2) iunit, ddname, sf, iostat
 2  FORMAT (' Entry FOR: ', i3, 1x, a36, a2, i7)
    ddname_l = ddname
 !
 !     check file qualifiers
 !
    IF((iunit /= 0) .AND. ((iunit < iunmin) .OR. (iunit > iunmax)))THEN
      IF(iostat > -2) CALL msgerr (3, 'Unit number out of range')
      iostat= ieunbd
      RETURN
    END IF
 !
    s   = sf(1:1)
    f   = sf(2:2)
    is  = index('ONSU',s)
    ifo = index('FU',f)
    IF((is == 0) .OR. (ifo == 0))THEN
      IF(iostat > -2) CALL msgerr (3,'Error in file qualifiers')
      iostat= iestat
      RETURN
    END IF
 !
    IF((s == 'S') .AND. (ddname /= empty))THEN
      IF(iostat > -2) CALL msgerr (3, 'Named scratch file')
      iostat= ienscr
      RETURN
    END IF
 !
    IF(ddname /= empty)THEN
 !       directory separation character is replaced in filenames
      DO ii = 1, len(ddname)
        IF(ddname(ii:ii) == dirch1) ddname(ii:ii) = dirch2
      ENDDO
    ENDIF
 !
    IF(iunit == 0)THEN
      IF(ddname == empty)THEN
        IF(iostat > -1) CALL msgerr (3, 'No filename given')
        iostat= ienodd
        RETURN
      ELSE
 !         Was the file opened already ?
        INQUIRE (file=ddname, iostat=iosttm, exist=exist,           &
             opened=opened, number=iuttm)
        IF(iosttm /= iesucc)THEN
          IF(iostat > -1)                                           &
        CALL msgerr (2,'Inquire failed, filename: '//ddname_l)
          iostat = iosttm
          RETURN
        ENDIF
 !         If file does not exist, print term. error
        IF(is == 1 .AND. .NOT. exist)THEN
          CALL msgerr (4,'File cannot be opened/does not exist: '//ddname_l)
          iostat = ieexst
        END IF
        IF(opened)THEN
          IF(iostat.GT.-1)                                          &
            CALL msgerr (2, 'File is already opened: '//ddname_l)
          iostat = ieopen
          iunit = iuttm
          RETURN
        ENDIF
 !         Assign free unit number
        IF(ifun == 0)THEN
          ifun = funlo
        ELSE
          ifun = ifun + 1
        ENDIF
        iunit = ifun
        IF(iunit > funhi)THEN
          IF(iostat > -2) CALL msgerr (3, 'All free units used')
          iostat= ienunf
        ENDIF
      END IF
      OPEN (unit=iunit,err=999,iostat=iosttm,file=ddname,              &
 !/Cray     RECL=1000,                                                 &
 !/SGI      RECL=1000,                                                 &
 !CVIS      SHARED,                                                    &
            status=fistat(is),access='SEQUENTIAL',form=form(ifo))
    ELSE
      INQUIRE (unit=iunit, name=filttm, iostat=iosttm,                 &
               exist=exist, opened=opened)
      IF(iosttm /= iesucc)THEN
        IF(iostat > -1)                                               &
          CALL msgerr (2,'Inquire failed, filename: '//filttm)
        iostat = iosttm
        RETURN
      ENDIF
      IF(opened)THEN
        IF(iostat > -1)THEN
          CALL msgerr (1,'File is already opened, filename: '//filttm)
        ENDIF
        IF(filttm /= ddname .AND. filttm /= empty)THEN
          IF(iostat > -2)THEN
            WRITE (printf, '(A, I4, 6A)') ' unit', iunit,              &
               ' filenames: ', filttm, ' and: ', ddname
            CALL msgerr (2, 'filename and unit number inconsistent')
          ENDIF
          iostat = ieddnm
 !          close old file and open new one with given filename
          CLOSE (iunit)
          OPEN (unit=iunit,err=999,iostat=iosttm,status=fistat(is),    &
 !/Cray         RECL=1000,                                             &
 !/SGI          RECL=1000,                                             &
 !CVIS          SHARED,                                                &
                file=ddname,access='SEQUENTIAL',form=form(ifo))
          IF(iosttm /= iesucc) iostat = iosttm
          GOTO 80
        ENDIF
        iostat = ieopen
        RETURN
      END IF
      IF(ddname /= empty)THEN
        OPEN (unit=iunit,err=999,iostat=iosttm,status=fistat(is),      &
 !/Cray       RECL=1000,                                               &
 !/SGI        RECL=1000,                                               &
 !CVIS        SHARED,                                                  &
              file=ddname,access='SEQUENTIAL',form=form(ifo))
      ELSE
        OPEN (unit=iunit,err=999,iostat=iosttm,status=fistat(is),      &
 !/Cray       RECL=1000,                                               &
 !/SGI        RECL=1000,                                               &
 !CVIS        SHARED,                                                  &
              access='SEQUENTIAL',form=form(ifo))
      END IF
    END IF
    hiopen = ifun
 80 IF(itest >= 30) WRITE (printf, 82) iunit, ddname, sf
 82 FORMAT (' File opened: ', i6, 2x, a36, 2x, a2)
    RETURN
 !
 !  in case file cannot be opened:
 !
 999 IF(iostat > -2)THEN
      CALL msgerr (3, 'File open failed, filename: '//ddname_l)
      WRITE (printf,15) ddname, iosttm, sf
 15   FORMAT (' File -> ', a36, 2x, ' IOSTAT=', i6, 4x, a2)
    ENDIF
    iunit = -1
    iostat= iosttm

    RETURN
    END SUBROUTINE for

 !***********************************************************************
 !                                                                      *
     LOGICAL FUNCTION eqreal (REAL1, REAL2 )
 !                                                                      *
 !***********************************************************************
 !
     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
 !
 !     30.72 IJsbrand Haagsma
 !     30.60 Nico Booij
 !     40.04 Annette Kieftenburg
 !     40.41: Marcel Zijlema
 !
 !  1. Updates
 !
 !     30.72, Oct. 97: Changed from EXCYES to make floating point point comparisons
 !     30.60, July 97: new subroutine (EXCYES)
 !     40.04, Aug. 00: introduced EPSILON and TINY
 !     40.41, Oct. 04: common blocks replaced by modules, include files removed
 !
 !  2. Purpose
 !
 !     to determine whether a value (usually a value read from file)
 !     is an exception value or not
 !     Later (30.72) used to make comparisons of floating points within reasonable bounds
 !
 !  3. Method (updated...)
 !
 !     Checks whether ABS(REAL1-REAL2) .LE. TINY(REAL1) or whether this        40.04
 !     difference is .LE. then EPS (= EPSILON(REAL1)*ABS(REAL1-REAL2) )        40.04
 !
 !  4. Argument variables
 !
 !     REAL1  : input    value that is to be tested
 !     REAL2  : input    given exception value
 !
     REAL      real1, real2
 !
 !  5. Parameter variables
 !
 !  6. Local variables
 !
 !     EPS    : Small number (related to REAL1 and its difference with REAL2)
 !     IENT   : Number of entries into this subroutine
 !
     REAL      eps
     INTEGER   ient
 !
 !  8. Subroutines used
 !
 !  9. Subroutines calling
 !
 !     SWREAD
 !     SWDIM
 !     SIRAY
 !     SWBOUN
 !     SWODDC
 !     SWOEXD
 !     SWOEXA
 !     SWOEXF
 !     SWPLOT
 !     SWSPEC
 !     ISOLIN
 !     SNYPT2
 !     INCTIM
 !     INDBLE
 !
 ! 10. Error messages
 !
 ! 11. Remarks
 !
 ! 12. Structure
 !
 ! 13. Source text
 !
     SAVE ient
     DATA ient/0/
     CALL strace(ient,'EQREAL')
     eqreal = .false.
 !
     eps = epsilon(real1)*abs(real1-real2)
     IF (eps ==0) eps = tiny(real1)
     IF (abs(real1-real2) .GT. tiny(real1)) THEN
       IF (abs(real1-real2) .LT. eps) eqreal = .true.
     ELSE
       eqreal = .true.
     ENDIF
     RETURN
     END FUNCTION eqreal
 !*****************************************************************
 !                                                                *
       SUBROUTINE dtreti (TSTRNG, IOPT, TIMESC)
 !                                                                *
 !*****************************************************************
 !
       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
 !
 !  1. UPDATES
 !
 !  2. PURPOSE
 !
 !  3. METHOD
 !
 !  4. ARGUMENT VARIABLES
 !
 !     IOPT   : input    option number
 !
       INTEGER IOPT
 !
 !     TIMESC : output   time in seconds from given reference day REFDAY
 !
       REAL    TIMESC
 !
 !     TSTRNG : input    time string
 !
       CHARACTER  TSTRNG *(*)
 !
 !  5. PARAMETER VARIABLES
 !
 !  6. LOCAL VARIABLES
 !
 !     ITIME  : ??
 !
       INTEGER ITIME(6)
 !
 !     DTTIME : Gives time in seconds from a reference day it also initialises the
 !              reference day
 !
       REAL    DTTIME
 !
 !  8. SUBROUTINE USED
 !
 !     DTSTTI   (installation dependent subroutines)
 !
 !  9. SUBROUTINES CALLING
 !
 ! 10. ERROR MESSAGES
 !
 ! 11. REMARKS
 !
 ! 12. STRUCTURE
 !
 ! 13. SOURCE TEXT
 !
       CALL dtstti (iopt, tstrng, itime)
       timesc = dttime(itime)
       RETURN
       END SUBROUTINE dtreti
ocpcomm4::funhi
integer funhi
Definition: swmod1.f90:515

ocpcomm2::filenm
character(len=lenfnm) filenm
Definition: swmod1.f90:280

strace
subroutine strace(IENT, SUBNAM)
Definition: ocpmix.f90:468

ocpcomm4::hiopen
integer hiopen
Definition: swmod1.f90:515

ocpcomm4::maxerr
integer maxerr
Definition: swmod1.f90:536

ocpcomm3
Definition: swmod1.f90:312

ocpcomm4::prtest
integer prtest
Definition: swmod1.f90:517

ocpcomm1::refday
integer refday
Definition: swmod1.f90:161

dttime
real function dttime(INTTIM)
Definition: ocpmix.f90:32

eqreal
logical function eqreal(REAL1, REAL2)
Definition: ocpmix.f90:1177

ocpcomm4::funlo
integer funlo
Definition: swmod1.f90:515

m_parall::inode
integer inode
Definition: swmod2.f90:881

ocpcomm2
Definition: swmod1.f90:187

ocpcomm4::screen
integer screen
Definition: swmod1.f90:517

ocpcomm4::printf
integer printf
Definition: swmod1.f90:517

stpnow
logical function stpnow()
Definition: ocpmix.f90:736

ocpcomm4::itest
integer itest
Definition: swmod1.f90:536

ocpcomm1
Definition: swmod1.f90:26

msgerr
subroutine msgerr(LEV, STRING)
Definition: ocpmix.f90:582

m_parall::parll
logical parll
Definition: swmod2.f90:884

for
subroutine for(IUNIT, DDNAME, SF, IOSTAT)
Definition: ocpmix.f90:835

ocpcomm4::iunmin
integer iunmin
Definition: swmod1.f90:517

dtstti
subroutine dtstti(IOPT, TIMSTR, DTTIME)
Definition: ocpids.f90:436

ocpcomm4::itrace
integer itrace
Definition: swmod1.f90:536

dtreti
subroutine dtreti(TSTRNG, IOPT, TIMESC)
Definition: ocpmix.f90:1306

ocpcomm4::leverr
integer leverr
Definition: swmod1.f90:536

ocpcomm4::iunmax
integer iunmax
Definition: swmod1.f90:516

ocpcomm2::dirch1
character(len=1) dirch1
Definition: swmod1.f90:279

ocpcomm2::dirch2
character(len=1) dirch2
Definition: swmod1.f90:279

inar2d
subroutine inar2d(ARR, MGA, NDSL, NDSD, IDFM, RFORM, IDLA, VFAC, NHED, NHEDF)
Definition: ocpmix.f90:182

ocpcomm4
Definition: swmod1.f90:418

m_parall
Definition: swmod2.f90:797

m_parall::master
integer master
Definition: swmod2.f90:864