ocpids.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	ocpini (INIFIL, LREAD, INERR)
subroutine	ocdtim (PRCTIM)
subroutine	dtstti (IOPT, TIMSTR, DTTIME)
subroutine	dttist (IOPT, TIMSTR, DTTIME)

Function/Subroutine Documentation

dtstti()

subroutine dtstti	(	integer	IOPT,
		character	TIMSTR,
		integer, dimension(6)	DTTIME
	)

Definition at line 436 of file ocpids.f90.

!                                                                *
!*****************************************************************
!
!   --|-----------------------------------------------------------|--
!     | 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
!
!
!     Updates
!
!       ver 30.70, Sep 1997 by N.Booij: adaptation in view year 2000
!
!     Function:
!
!       transform time string into integer time array
!
!     Argument list:
!
!       IOPT    input  int   option number
!                            1: ISO notation   19870530.153000
!                            2: (HP compiler): 30-May-87 15:30:00
!                            3: (old Lahey)    05/30/87 15:30:00          
!                            4:                         15:30:00
!                            5:                87/05/30 15:30:00
!                            6: WAM            8705301530
!
!       TIMSTR  input  char  time string
!       DTTIME  outp   int   time array: elements: year, month, day,
!                            hour, minute, second
!
!    Remarks:
!     Options can be added by the user
!     existing options should not be changed
!
!     Source:
!
   INTEGER    IOPT, DTTIME(6)
   CHARACTER  TIMSTR *24, MONC(12) *3, MONCI *3
   DATA monc /'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', 'JUL',       &
              'AUG', 'SEP', 'OCT', 'NOV', 'DEC'/
!
   IF(iopt == 1)THEN
     READ (timstr, '(I4,I2,I2,1X,3I2)', err=98) (dttime(ii), ii=1,6)
    
     print*,timstr,dttime,'ppppppppppppppppppppppp'
    
   ELSE IF(iopt == 2)THEN
     READ (timstr, '(I2,1X,A3,1X,I2,3(1X,I2))', err=98)              &
       dttime(3), monci, dttime(1), (dttime(ii), ii=4,6)
     IF(dttime(1) < 10)THEN                                         
       dttime(1) = 2000 + dttime(1)                                    
     ELSE
       dttime(1) = 1900 + dttime(1)
     ENDIF
     dttime(2) = 0
     DO 20 imm = 1, 12                                                 
       CALL upcase (monci)
       IF (monci.NE.monc(imm)) GOTO 20
       dttime(2) = imm
       GOTO 90
20   CONTINUE
     CALL msgerr (2, 'incorrect month string: '//monci)                
   ELSE IF(iopt == 3)THEN
     READ (timstr, '(I2,5(1X,I2))', err=98)                          &
       dttime(2), dttime(3), dttime(1), (dttime(ii), ii=4,6)
     IF(dttime(1) < 10)THEN                                         
       dttime(1) = 2000 + dttime(1)                                    
     ELSE
       dttime(1) = 1900 + dttime(1)
     ENDIF
   ELSE IF(iopt == 4)THEN
     READ (timstr, '(I2,2(1X,I2))', err=98) (dttime(ii), ii=4,6)
     DO ii = 1, 3
       dttime(ii) = 0
     END DO
   ELSE IF(iopt == 5)THEN                                            
     READ (timstr, '(I2,5(1X,I2))', err=98) (dttime(ii), ii=1,6)       
     IF(dttime(1) < 10)THEN                                         
       dttime(1) = 2000 + dttime(1)                                    
     ELSE
       dttime(1) = 1900 + dttime(1)
     ENDIF
   ELSE IF(iopt == 6)THEN                                            
     READ (timstr, '(5I2)', err=98) (dttime(ii), ii=1,5)
     dttime(6) = 0.
     IF(dttime(1) < 10)THEN                                         
       dttime(1) = 2000 + dttime(1)                                    
     ELSE
       dttime(1) = 1900 + dttime(1)
     ENDIF
   ELSE
     CALL msgerr (2, 'wrong time coding option in subroutine DTSTTI')
   ENDIF
90 RETURN
98 CALL msgerr (2, 'time string unreadable: '//timstr)
   RETURN

Here is the call graph for this function:

Here is the caller graph for this function:

dttist()

subroutine dttist	(	integer	IOPT,
		character	TIMSTR,
		integer, dimension(6)	DTTIME
	)

Definition at line 564 of file ocpids.f90.

!                                                                *
!*****************************************************************
!
!   --|-----------------------------------------------------------|--
!     | 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
!
!
!     Updates
!
!       ver 30.70, Sep 1997 by N.Booij: adaptation in view year 2000
!
!     Function:
!
!       transform integer time array into time string
!
!     Argument list:
!
!       IOPT    input  int   option number (see subr. DTSTTI)
!       TIMSTR  outp   char  time string
!       DTTIME  input  int   time array: elements: year, month, day,
!                            hour, minute, second
!
!     Source:
!
   INTEGER    IOPT, DTTIME(6)
   CHARACTER  TIMSTR *24, MONC(12) *3
   DATA monc /'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul',      &
              'Aug', 'Sep', 'Oct', 'Nov', 'Dec'/
!
   timstr = '    '
   IF(iopt == 1)THEN
     WRITE (timstr, 12) (dttime(ii), ii=1,6)
12   FORMAT (i4,i2,i2,'.',3i2)
     lts = 15
   ELSE IF(iopt == 2)THEN
     IF(dttime(1) >= 2000)THEN                                       
       dttime(1) = dttime(1) - 2000                                    
     ELSE
       dttime(1) = dttime(1) - 1900                                    
     ENDIF
     WRITE (timstr, 22) dttime(3), monc(dttime(2)), dttime(1),         &
                       (dttime(ii), ii=4,6)
22   FORMAT (i2,'-',a3,'-',i2,'.',i2,':',i2,':',i2)
     lts = 18
   ELSE IF(iopt == 3)THEN
     IF(dttime(1) >= 2000)THEN                                       
       dttime(1) = dttime(1) - 2000                                    
     ELSE
       dttime(1) = dttime(1) - 1900                                    
     ENDIF
     WRITE (timstr, 32) dttime(2), dttime(3), dttime(1), (dttime(ii), ii=4,6)
32   FORMAT (i2,'/',i2,'/',i2,'.',i2,':',i2,':',i2)
     lts = 17
   ELSE IF(iopt == 4)THEN
     WRITE (timstr, 42) (dttime(ii), ii=4,6)
42   FORMAT (i2,':',i2,':',i2)
     lts = 8
   ELSE IF(iopt == 5)THEN                                            
     IF(dttime(1) >= 2000)THEN                                       
       dttime(1) = dttime(1) - 2000                                    
     ELSE
       dttime(1) = dttime(1) - 1900                                    
     ENDIF
     WRITE (timstr, 52) (dttime(ii), ii= 1,6)                          
52   FORMAT (i2,'/',i2,'/',i2,'.',i2,':',i2,':',i2)
     lts = 17
   ELSE IF(iopt == 6)THEN                                            
     IF(dttime(1) >= 2000)THEN                                       
       dttime(1) = dttime(1) - 2000                                    
     ELSE
       dttime(1) = dttime(1) - 1900                                    
     ENDIF
     WRITE (timstr, 62) (dttime(ii), ii=1,5)                           
62   FORMAT (5i2)
     lts = 10
   ELSE
     CALL msgerr (2, 'wrong time coding option in subroutine DTTIST')
   ENDIF
!
   DO ic = 1, lts
     IF (timstr(ic:ic).EQ.' ') timstr(ic:ic) = '0'
   END DO  
!
   RETURN

Here is the call graph for this function:

Here is the caller graph for this function:

ocdtim()

subroutine ocdtim

(

integer, dimension(6)

PRCTIM

)

Definition at line 333 of file ocpids.f90.

!                                                                *
!*****************************************************************
!
!   --|-----------------------------------------------------------|--
!     | 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.07
!     30.70: Nico Booij
!     30.82: IJsbrand Haagsma
!     40.02: IJsbrand Haagsma
!
!  1. Updates
!
!     30.07, Oct. 95: option DEC added
!     30.70, Sep. 97: adaptation in view of year 2000
!     30.82, Mar. 99: Adapted to Fortran 90 standard
!     40.02, Sep. 00: Removed all platform dependent Fortran 77 statements
!
!  2. PURPOSE
!
!       get time of processing, using processor dependent routines
!
!  3. PARAMETER LIST
!
!       PRCTIM  outp   int   time array: elements: year, month, day,
!                            hour, minute, second
!
!  4. SUBROUTINES USED
!
!       GETDAT, GETTIM or other
!
!  5. ERROR MESSAGES
!
!       ----
!
!  6. REMARKS
!
!       This function uses a processor dependent subroutines (GETDAT,
!       GETTIM), therefore adaptations are necessary when compiled
!       at a different computer system environment.
!
!  7. STRUCTURE
!
!       ---------------------------------------------------------
!       Call DATE and TIME routines (system dependent)
!       decode YEAR, MONTH and DAY
!       assemble DATE string
!       decode HOUR, MINUTE, SECOND
!       assemble TIME string
!       ---------------------------------------------------------
!
!  8. SOURCE TEXT
!
   INTEGER PRCTIM(6)
!
!     Call DATE and TIME routines
!
!     --------Fortran 90 date-time routines --------
!
   CHARACTER TIMSTR *24, CDUMMY *5                                     
   INTEGER   IDUMMY(8)                                                 
!
   CALL date_and_time (timstr(1:8), timstr(10:20), cdummy, idummy)     
   CALL dtstti (1, timstr, prctim)                                     

   RETURN

Here is the call graph for this function:

Here is the caller graph for this function:

ocpini()

subroutine ocpini	(	character, dimension(*)	INIFIL,
		logical	LREAD,
		integer	INERR
	)

Definition at line 19 of file ocpids.f90.

!                                                                *
!*****************************************************************
!
   USE ocpcomm1                                                        
   USE ocpcomm2                                                        
   USE ocpcomm3                                                        
   USE ocpcomm4                                                        
   USE m_parall                                                        

!
!
!   --|-----------------------------------------------------------|--
!     | 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)
!     30.82: IJsbrand Haagsma
!     34.01: IJsbrand Haagsma
!     40.00, 40.03: Nico Booij
!     40.30: Marcel Zijlema
!     40.31: Marcel Zijlema
!     40.41: Marcel Zijlema
!
!  1. Updates
!
!     10.02, July 94: New argument INIFIL
!                     Check on validity period now uses OCDTIM
!     30.74, Nov. 97: Prepared for version with INCLUDE statements
!     30.82, Nov. 98: Introduced recordlength of 1000 for file PRINT to
!                     avoid error-messages on the Cray-J90 and SGI Origin 200
!     34.01, Feb. 99: Changed STOP statements for MSGERR(4,'message')
!                     calls
!     34.01, Feb. 99: Opens a file 'screen' when unitnr in swaninit<>6
!     40.00, Feb. 99: Directory separation characters included in init file
!                     these characters are used in subr FOR
!     40.03, May  00: backslash replaced by CHAR(92) because of problems on Linux
!     40.30, Jan. 03: introduction distributed-memory approach using MPI
!     40.31, Nov. 03: removing HPGL-functionality
!     40.41, Sep. 04: includes speed processors in initialisation file
!     40.41, Oct. 04: common blocks replaced by modules, include files removed
!
!  2. Purpose
!
!     subroutine initialises a number of common variables
!     opens standard input and output files, if necessary
!
!  4. Argument variables
!
!     INERR : output     Number of the initialisation error
!
   INTEGER INERR
!
!     INIFIL  inp  char  name of initialisation file
!     LREAD   inp  log   if True: command input file must be opened
!                        and command reading must be initialised
!
   LOGICAL    LREAD, FILEXI
   CHARACTER  INPFIL *40, OUTFIL *40, INIFIL *(*), TSTFIL *40,       &
              PLTOPT *4, TIMSTR *24,                                 &
          OUTFO *40, TSTFO *40, TXT*120
   INTEGER    PRCTIM(6), INIVER, INIVEF
   INTEGER    PFROPT                                                   
   REAL       PLPARM(10)                                               
   INTEGER    NUMM(10)                                                 
   LOGICAL    STPNOW
   DATA prctim /0,0,0,0,0,0/
!
!  version of initialisation file                                      
   iniver = 4                                                         
   inivef = -1                                                         
   inerr  = 0                                                          
!
!  see whether initialisation file exists
!
   INQUIRE (file=inifil, exist=filexi)
   IF(filexi)THEN
!
!    read initialisation file
!
     OPEN (11, file=inifil, status='OLD',                         &     
!CVIS             SHARED,                                        &     
                err=950)                                              
     READ (11, *, err=930, end=930) inivef 
     IF(inivef > iniver .OR. inivef <= 0) GOTO 935                   
     READ (11, 120, err=930, end=930) inst
     READ (11, *,   err=930, end=930) inputf
     READ (11, 120, err=930, end=930) inpfil
     READ (11, *,   err=930, end=930) printf
     READ (11, 120, err=930, end=930) outfil
     READ (11, *,   err=930, end=930) prtest
     READ (11, 120, err=930, end=930) tstfil
     READ (11, *,   err=930, end=930) screen
     READ (11, *,   err=930, end=930) iunmax
     READ (11, 130, err=930, end=930) comid
     READ (11, 130, err=930, end=930) tabc
     IF(inivef >= 2)THEN                                             
       READ (11, 130, err=930, end=930) dirch1
       READ (11, 130, err=930, end=930) dirch2
     ELSE
!DOS          DIRCH1 = CHAR(47)                                               
!DOS          DIRCH2 = CHAR(92)                                               
!UNIX          DIRCH1 = CHAR(92)                                               
!UNIX          DIRCH2 = CHAR(47)                                               
          dirch1 = char(92)                                               
          dirch2 = char(47)                                               
     ENDIF
     IF(inivef < 3)THEN
       READ (11, 140, err=930, end=930) pltopt
       READ (11, *,   err=930, end=930) nplp
       READ (11, *,   err=930, end=930) (plparm(ii),ii=1,nplp)
       READ (11, *,   err=930, end=930) pfropt
     END IF
     READ (11, *,   err=930, end=930) itmopt
!JQI     IF(INIVEF > 3)THEN
!JQI       IF(PARLL)THEN
!JQI         DO JJ = 1, NPROC
!JQI           READ (11, 145, ERR=150, END=150) IW, TXT
!JQI           CALL TXPBLA(TXT,IF,IL)
!JQI           IPOS = 0
!JQI           DO II = IF, IL
!JQI             K = ICHAR(TXT(II:II))
!JQI             IF(K >= 48 .AND. K <= 57)THEN
!JQI               IPOS = IPOS + 1
!JQI               NUMM(IPOS) = K - 48
!JQI             END IF
!JQI           END DO
!JQI           J = 0
!JQI           DO II = 1, IPOS
!JQI             J = J + NUMM(II)*10**(IPOS-II)
!JQI           END DO
!JQI           IWEIG(J) = IW
!JQI         END DO
!JQI       END IF
!JQI     END IF
120  FORMAT (a40)
130  FORMAT (a1)
140  FORMAT (a4)
145  FORMAT (i5,a)
150  CLOSE (11)
   ELSE
!
!    REFERENCE NUMBERS AND NAMES OF STANDARD FILES
!
     inputf = 3
     inpfil = 'INPUT'
     printf = 4
     outfil = 'PRINT'
!    unit ref. numbers for output to screen and to separate
!    test print file:
     prtest = printf
     tstfil = '    '
     screen = 6
     iunmax = 99
!    TABC is the Tab character (interpreted as blank in command reading)
!DOS        TABC   = '  '
!UNIX        TABC   = ' '
!    COMID is the comment identifier (usually $)
     comid  = '$'
!    DIRCH1 is directory separation character as appears in input file
!    DIRCH2 is directory separation character replacing DIRCH1         
!DOS        DIRCH1 =  CHAR(47)                                                
!DOS        DIRCH2 =  CHAR(92)                                                
!UNIX        DIRCH1 =  CHAR(92)                                                
!UNIX        DIRCH2 =  CHAR(47)                                                
!    INST = name of institute, max. 40 characters
     inst = 'Delft University of Technology'
     itmopt = 1
!
   ENDIF
   outfo = outfil                                                      
   tstfo = tstfil                                                      

!  --- append node number to OUTFIL and TSTFIL                         
!      in case of parallel computing                                   

!JQI   IF(PARLL)THEN                                                     
!JQI     ILPOS = INDEX ( OUTFIL, ' ' )-1
!JQI     IF(ILPOS > 0)THEN
!JQI       WRITE(OUTFIL(ILPOS+1:ILPOS+4),180) INODE
!JQI     ELSE
!JQI       GOTO 920
!JQI     END IF
!JQI     ILPOS = INDEX ( TSTFIL, ' ' )-1
!JQI     IF(ILPOS > 0)THEN
!JQI       WRITE(TSTFIL(ILPOS+1:ILPOS+4),180) INODE
!JQI     END IF
!JQI180  FORMAT('-',I3.3)
!JQI     CALL SWSYNC
!JQI     IF(STPNOW()) RETURN
!JQI   END IF

   IF(inivef < iniver)THEN
!
!    write initialisation file
!
     OPEN  (12, file=inifil, status='UNKNOWN', form='FORMATTED', err=950)
     WRITE (12, 210) iniver, 'version of initialisation file'          
     WRITE (12, 220) inst,   'name of institute'
     WRITE (12, 210) inputf, 'command file ref. number'
     WRITE (12, 220) inpfil, 'command file name'
     WRITE (12, 210) printf, 'print file ref. number'
     WRITE (12, 220) outfo,  'print file name'                         
     WRITE (12, 210) prtest, 'test file ref. number'
     WRITE (12, 220) tstfo,  'test file name'                          
     WRITE (12, 210) screen, 'screen ref. number'
     WRITE (12, 210) iunmax, 'highest file ref. number'
     WRITE (12, 230) comid,  'comment identifier'
     WRITE (12, 230) tabc,   'TAB character'
     WRITE (12, 230) dirch1, 'dir sep char in input file'
     WRITE (12, 230) dirch2, 'dir sep char replacing previous one'     
     WRITE (12, 210) itmopt, 'default time coding option'
!JQI     IF(PARLL)THEN
!JQI       DO II = 1, NPROC
!JQI         WRITE (12, 240) IWEIG(II), 'speed of processor ',II
!JQI       END DO
!JQI     END IF
     CLOSE (12)
210  FORMAT (i5, t41, a)
220  FORMAT (a40, a)
230  FORMAT (a1, t41, a)
240  FORMAT (i5, t41, a19, i3)
   ENDIF
!
   iunmin = 0
   funlo = 21
   funhi = iunmax
!
   CALL ocdtim (prctim)
!
!  initialise command reader
!
   IF(outfil /= '    ')THEN
!    WRITE (*,*) ' Open print file ', PRINTF, OUTFIL
     OPEN (unit=printf, file=outfil, status='UNKNOWN', form='FORMATTED', &
!/Cray         RECL=2000,                                                &
!/SGI          RECL=2000,                                                & 
           err=920)                                     
!    WRITE (*,*) ' Print file opened ', PRINTF, OUTFIL
     CALL dttist (itmopt, timstr, prctim)
     WRITE (printf, 12) timstr
12   FORMAT ('1',//,20x, 'Execution started at ',a, //)
   ENDIF
   IF(prtest /= printf) OPEN (unit=prtest, file=tstfil, err=922)
   IF(screen /= 6) OPEN(unit=screen, file='screen',err=960)           
   IF(lread)THEN
     IF (inpfil /= '    ') OPEN (unit=inputf, file=inpfil, status='OLD', &
!CVIS           SHARED,                                                  &
                err=910)                                               
     CALL rdinit
     IF (inpfil /= '    ') CLOSE (unit=inputf) !conflict with open statement in function SCAN_FILE2, so close it.
   ENDIF
!
   RETURN
!
910 CALL msgerr(4,'Input file missing')                                 
   RETURN                                                              
!
920 inerr=920                                                           
   IF (inode == master ) WRITE(*,*) 'Cannot open PRINT file '     
   RETURN                                                             
!
922 CALL msgerr(4,'Cannot open test file: '//tstfil)                    
   RETURN
!
930 inerr=930                                                           
   IF(inode == master) WRITE(*,*) 'Error reading initialisation file '  
   RETURN                                                              
!
935 inerr=935                                                           
   IF(inode == master ) WRITE(*,*) 'Incorrect version of initialisation file '
   RETURN                                                              
!
950 inerr=950                                                           
   IF(inode == master) WRITE(*,*) 'Error opening initialisation file ' 
   RETURN                                                              
!
960 CALL msgerr(4,'Error opening output file: screen')                  
   RETURN                                                              
!

Here is the call graph for this function: