C
C Subroutine file 'forms.for' to facilitate writing and reading data.
C
C Version: 6.20
C Date: 2008, January 18
C
C Coded by: Ludek Klimes
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     http://sw3d.cz/staff/klimes.htm
C
C.......................................................................
C
C This file consists of the following external procedures:
C     UARRAY..Function returning the undefined value used in the
C             unformatted files with real arrays.
C             UARRAY
C     WARRAY..Subroutine designed to write a given real array into the
C             given formatted or unformatted file.
C             WARRAY
C     WARRAI..Subroutine designed to write a given integer array into
C             the given formatted or unformatted file.
C             WARRAI
C     RARRAY..Subroutine designed to read the real array from the given
C             formatted or unformatted file.
C             RARRAY
C     RARRAI..Subroutine designed to read the integer array from the
C             given formatted or unformatted file.
C             RARRAI
C     WARAY...Subroutine calling WARRAY for N4 individual time levels.
C             WARAY
C     WARAI...Subroutine calling WARRAI for N4 individual time levels.
C             WARAI
C     RARAY...Subroutine calling RARRAY for N4 individual time levels.
C             RARAY
C     RARAI...Subroutine calling RARRAI for N4 individual time levels.
C             RARAI
C     FORM1...Subroutine designed to determine the best output format
C             for reals.
C             FORM1
C     FORM2...Subroutine designed to determine the best output format
C             for multiples of real numbers.
C             FORM2
C
C=======================================================================
C
C     
C
      REAL FUNCTION UARRAY()
C
C Function returning the undefined value used in the unformatted files
C with real-valued arrays.
C
C No input.
C
C Output:
C     UARRAY..The value used as "undefined value" in the unformatted
C             files with real-valued arrays by subroutines WARRAY and
C             RARRAY.
C
C Date: 2005, June 18
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Parameters:
      REAL UNDEF
      PARAMETER (UNDEF=-3.4E+38)
C
      UARRAY=UNDEF
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE WARRAY(LU,FILE,FORM,LMIN,VMIN,LMAX,VMAX,NOUT,OUT)
      CHARACTER*(*) FILE,FORM
      LOGICAL LMIN,LMAX
      INTEGER LU,NOUT
      REAL VMIN,VMAX,OUT(NOUT)
C
C Subroutine designed to write a given real array into the file.
C
C Input:
C     LU...   Logical unit number to be used for the output.
C     FILE... Destination filename.  If not blank, the file will be
C             opened and closed.  If blank, the file is assumed to be
C             already open, and will not be closed in this subroutine.
C     FORM... Form of the output file: either 'FORMATTED' or
C             'UNFORMATTED'.
C     LMIN... TRUE if the null values are to be written in place of
C             array elements less than or equal to VMIN, otherwise
C             FALSE.
C             Formatted output:
C               The null values are treated as default values when read
C               by list-directed input (free format).
C               Example: 124 null values are written as '    124*'.
C             Unformatted output:
C               The values of -999999999 are written in place of the
C               null values.
C     VMIN... Trade-off limit.
C     LMAX... TRUE if the null values are to be written in place of
C             array elements greater than or equal to VMAX, otherwise
C             FALSE.
C     VMAX... Trade-off limit.
C     NOUT... Dimension of the array OUT.
C     OUT...  Array to be written.
C
C No output.
C
C                                                  
C Input SEP parameter:
C     NUMLIN=positive integer... Number of the numbers to be written
C             to each line of the output file.
C             NUMLIN must be less than 100 (99 at most).
C             Default: NUMLIN=10
C
C Date: 2007, January 18
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Parameters:
      EXTERNAL UARRAY
      REAL     UARRAY
      REAL     UNDEF
C
C     Local storage locations:
      CHARACTER*11 FORML
      CHARACTER*14 FORMAT
      INTEGER IMIN,IADR
      REAL OUTMIN,OUTMAX,VMINA,VMAXA
C     FORMAT..String containing the output format, e.g. like (10F8.3).
C     IMIN... Loop lower bound, locally also loop variable.
C     IADR... Loop variable.
C     OUTMIN,OUTMAX... Minimum and maximum defined element to determine
C             the best format for printing.
C     VMINA,VMAXA... Local storage locations for VMIN, VMAX.
C
      INTEGER NUMLIN
      SAVE NUMLIN
      DATA NUMLIN/-1/
C
C.......................................................................
C
      UNDEF=UARRAY()
C
      IF(FILE.NE.' ') THEN
        WRITE(*,'(''+'',79('' ''))')
        WRITE(*,'(2A)') '+Writing: ',FILE(1:MIN0(LEN(FILE),70))
        OPEN(LU,FILE=FILE,FORM=FORM)
      END IF
C
C     Formatted or unformatted output:
      FORML=FORM
      CALL LOWER(FORML)
      IF(FORML.EQ.'formatted') THEN
C
C       Minimum and maximum elements:
        OUTMIN=0.
        IF(LMIN) THEN
          VMINA=VMIN
          DO 11 IADR=1,NOUT
            IF(OUTMIN.GT.OUT(IADR)) THEN
              IF(OUT(IADR).GT.VMINA) THEN
                OUTMIN=OUT(IADR)
              END IF
            END IF
   11     CONTINUE
        ELSE
          DO 12 IADR=1,NOUT
            IF(OUTMIN.GT.OUT(IADR)) THEN
              OUTMIN=OUT(IADR)
            END IF
   12     CONTINUE
        END IF
        OUTMAX=0.
        IF(LMAX) THEN
          VMAXA=VMAX
          DO 13 IADR=1,NOUT
            IF(OUTMAX.LT.OUT(IADR)) THEN
              IF(OUT(IADR).LT.VMAXA) THEN
                OUTMAX=OUT(IADR)
              END IF
            END IF
   13     CONTINUE
        ELSE
          DO 14 IADR=1,NOUT
            IF(OUTMAX.LT.OUT(IADR)) THEN
              OUTMAX=OUT(IADR)
            END IF
   14     CONTINUE
        END IF
C
C       Setting output format for the array:
        IF (NUMLIN.EQ.-1) THEN
          CALL RSEP3I('NUMLIN',NUMLIN,10)
        ENDIF
        FORMAT='(00(F00.0,1X))'
        FORMAT(3:3)=CHAR(ICHAR('0')+MOD(NUMLIN,10))
        FORMAT(2:2)=CHAR(ICHAR('0')+    NUMLIN/10 )
        CALL FORM1(OUTMIN,OUTMAX,FORMAT(5:12))
        FORMAT(11:14)=   '1X))'
C       Output format is set.
C
C       Printing loop:
C       Initial value of the first element to print
        IADR=1
C       Beginning of the loop
   20   CONTINUE
C
C         Trade off (searching for undefined elements):
          IMIN=IADR
          IF(LMIN) THEN
            IF(LMAX) THEN
              DO 21 IADR=IMIN,NOUT
                IF(OUT(IADR).LE.VMINA.OR.OUT(IADR).GE.VMAXA) THEN
                  GO TO 29
                END IF
   21         CONTINUE
            ELSE
              DO 22 IADR=IMIN,NOUT
                IF(OUT(IADR).LE.VMINA) THEN
                  GO TO 29
                END IF
   22         CONTINUE
            END IF
          ELSE
            IF(LMAX) THEN
              DO 23 IADR=IMIN,NOUT
                IF(OUT(IADR).GE.VMAXA) THEN
                  GO TO 29
                END IF
   23         CONTINUE
            ELSE
              IADR=NOUT+1
            END IF
          END IF
   29     CONTINUE
C         IADR is the first undefined element.
C
C         Writing the array (defined elements):
          IF(IMIN.EQ.1.AND.IADR.GT.NOUT) THEN
            WRITE(LU,FORMAT) OUT
            GO TO 90
          ELSE
            WRITE(LU,FORMAT) (OUT(IMIN),IMIN=IMIN,IADR-1)
            IF(IADR.GT.NOUT) THEN
              GO TO 90
            END IF
          END IF
C
C         Searching for the next defined elements:
          IMIN=IADR
          IF(LMIN) THEN
            IF(LMAX) THEN
              DO 31 IADR=IADR,NOUT
                IF(OUT(IADR).GT.VMINA.AND.OUT(IADR).LT.VMAXA) THEN
                  GO TO 39
                END IF
   31         CONTINUE
            ELSE
              DO 32 IADR=IADR,NOUT
                IF(OUT(IADR).GT.VMINA) THEN
                  GO TO 39
                END IF
   32         CONTINUE
            END IF
          ELSE
            IF(LMAX) THEN
              DO 33 IADR=IADR,NOUT
                IF(OUT(IADR).LT.VMAXA) THEN
                  GO TO 39
                END IF
   33         CONTINUE
            ELSE
              IADR=NOUT+1
            END IF
          END IF
   39     CONTINUE
C         IADR is the first defined element.
C
C         Writing the array (undefined elements):
          WRITE(LU,'(I7,A)') IADR-IMIN,'*'
          IF(NOUT.LT.IADR) THEN
            GO TO 90
          END IF
C
        GO TO 20
      ELSE
C
C       Null values:
        IF(LMIN) THEN
          VMINA=VMIN
          IF(LMAX) THEN
            VMAXA=VMAX
            DO 51 IADR=1,NOUT
              IF(OUT(IADR).LE.VMINA.OR.VMAXA.LE.OUT(IADR)) THEN
                OUT(IADR)=UNDEF
              END IF
   51       CONTINUE
          ELSE
            DO 52 IADR=1,NOUT
              IF(OUT(IADR).LE.VMINA) THEN
                OUT(IADR)=UNDEF
              END IF
   52       CONTINUE
          END IF
        ELSE
          IF(LMAX) THEN
            VMAXA=VMAX
            DO 53 IADR=1,NOUT
              IF(VMAXA.LE.OUT(IADR)) THEN
                OUT(IADR)=UNDEF
              END IF
   53       CONTINUE
          END IF
        END IF
C
C       Writing the array:
        WRITE(LU) OUT
C
      END IF
   90 CONTINUE
      IF(FILE.NE.' ') THEN
        CLOSE(LU)
      END IF
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE WARRAI(LU,FILE,FORM,LMIN,IVMIN,LMAX,IVMAX,NOUT,IOUT)
      CHARACTER*(*) FILE,FORM
      LOGICAL LMIN,LMAX
      INTEGER LU,NOUT,IVMIN,IVMAX,IOUT(NOUT)
C
C Subroutine designed to write a given integer array into the file.
C
C Input:
C     LU...   Logical unit number to be used for the output.
C     FILE... Destination filename.  If not blank, the file will be
C             opened and closed.  If blank, the file is assumed to be
C             already open, and will not be closed in this subroutine.
C     FORM... Form of the output file: either 'FORMATTED' or
C             'UNFORMATTED'.
C     LMIN... TRUE if the null values are to be written in place of
C             array elements less than or equal to IVMIN, otherwise
C             FALSE.
C             Formatted output:
C               The null values are treated as default values when read
C               by list-directed input (free format).
C               Example: 124 null values are written as '    124*'.
C             Unformatted output:
C               The values of -999999999 are written in place of the
C               null values.
C     IVMIN . Trade-off limit.
C     LMAX... TRUE if the null values are to be written in place of
C             array elements greater than or equal to IVMAX, otherwise
C             FALSE.
C     IVMAX...Trade-off limit.
C     NOUT... Dimension of the array IOUT.
C     IOUT... Array to be written.
C
C No output.
C
C Input SEP parameter:
C     NUMLIN=positive integer... Number of the numbers to be written
C             to each line of the output file.
C             NUMLIN must be less than 100 (99 at most).
C             Default: NUMLIN=10
C
C Date: 2007, January 18
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Parameters:
      INTEGER IUNDEF
      PARAMETER (IUNDEF=-999999999)
C
C     Local storage locations:
      CHARACTER*11 FORML
      CHARACTER*12 FORMAT
      INTEGER IMIN,IADR,MINOUT,MAXOUT,IVMINA,IVMAXA
C     FORMAT..String containing the output format, e.g. like (10I08).
C     IMIN... Loop lower bound, locally also loop variable.
C     IADR... Loop variable.
C     MINOUT,MAXOUT... Minimum and maximum defined element to determine
C             the best format for printing.
C     IVMINA,IVMAXA... Local storage locations for IVMIN, IVMAX.
C
      INTEGER NUMLIN
      SAVE NUMLIN
      DATA NUMLIN/-1/
C
C.......................................................................
C
      IF(FILE.NE.' ') THEN
        WRITE(*,'(''+'',79('' ''))')
        WRITE(*,'(2A)') '+Writing: ',FILE(1:MIN0(LEN(FILE),70))
        OPEN(LU,FILE=FILE,FORM=FORM)
      END IF
C
C     Formatted or unformatted output:
      FORML=FORM
      CALL LOWER(FORML)
      IF(FORML.EQ.'formatted') THEN
C
C       Minimum and maximum elements:
        MINOUT=0
        IF(LMIN) THEN
          IVMINA=IVMIN
          DO 11 IADR=1,NOUT
            IF(MINOUT.GT.IOUT(IADR)) THEN
              IF(IOUT(IADR).GT.IVMINA) THEN
                MINOUT=IOUT(IADR)
              END IF
            END IF
   11     CONTINUE
        ELSE
          DO 12 IADR=1,NOUT
            IF(MINOUT.GT.IOUT(IADR)) THEN
              MINOUT=IOUT(IADR)
            END IF
   12     CONTINUE
        END IF
        MAXOUT=0
        IF(LMAX) THEN
          IVMAXA=IVMAX
          DO 13 IADR=1,NOUT
            IF(MAXOUT.LT.IOUT(IADR)) THEN
              IF(IOUT(IADR).LT.IVMAXA) THEN
                MAXOUT=IOUT(IADR)
              END IF
            END IF
   13     CONTINUE
        ELSE
          DO 14 IADR=1,NOUT
            IF(MAXOUT.LT.IOUT(IADR)) THEN
              MAXOUT=IOUT(IADR)
            END IF
   14     CONTINUE
        END IF
C
C       Setting output format for the array:
        IF (NUMLIN.EQ.-1) THEN
          CALL RSEP3I('NUMLIN',NUMLIN,10)
        ENDIF
        FORMAT='(00(I00,1X))'
        FORMAT(3:3)=CHAR(ICHAR('0')+MOD(NUMLIN,10))
        FORMAT(2:2)=CHAR(ICHAR('0')+    NUMLIN/10 )
        IMIN=MAXOUT
        IF(MINOUT.LT.0.) THEN
          IMIN=MAX0(IMIN,-10*MINOUT)
        END IF
        DO 15 IADR=1,99
          IMIN=IMIN/10
          IF(IMIN.LT.1) THEN
            FORMAT(6:6)=CHAR(ICHAR('0')+IADR/10)
            FORMAT(7:7)=CHAR(ICHAR('0')+MOD(IADR,10))
            GO TO 16
          END IF
   15   CONTINUE
   16   CONTINUE
C       Output format is set.
C
C       Printing loop:
C       Initial value of the first element to print
        IADR=1
C       Beginning of the loop
   20   CONTINUE
C
C         Trade off (searching for undefined elements):
          IMIN=IADR
          IF(LMIN) THEN
            IF(LMAX) THEN
              DO 21 IADR=IMIN,NOUT
                IF(IOUT(IADR).LE.IVMINA.OR.IOUT(IADR).GE.IVMAXA) THEN
                  GO TO 29
                END IF
   21         CONTINUE
            ELSE
              DO 22 IADR=IMIN,NOUT
                IF(IOUT(IADR).LE.IVMINA) THEN
                  GO TO 29
                END IF
   22         CONTINUE
            END IF
          ELSE
            IF(LMAX) THEN
              DO 23 IADR=IMIN,NOUT
                IF(IOUT(IADR).GE.IVMAXA) THEN
                  GO TO 29
                END IF
   23         CONTINUE
            ELSE
              IADR=NOUT+1
            END IF
          END IF
   29     CONTINUE
C         IADR is the first undefined element.
C
C         Writing the array (defined elements):
          IF(IMIN.EQ.1.AND.IADR.GT.NOUT) THEN
            WRITE(LU,FORMAT) IOUT
            GO TO 90
          ELSE
            WRITE(LU,FORMAT) (IOUT(IMIN),IMIN=IMIN,IADR-1)
            IF(IADR.GT.NOUT) THEN
              GO TO 90
            END IF
          END IF
C
C         Searching for the next defined elements:
          IMIN=IADR
          IF(LMIN) THEN
            IF(LMAX) THEN
              DO 31 IADR=IADR,NOUT
                IF(IOUT(IADR).GT.IVMINA.AND.IOUT(IADR).LT.IVMAXA) THEN
                  GO TO 39
                END IF
   31         CONTINUE
            ELSE
              DO 32 IADR=IADR,NOUT
                IF(IOUT(IADR).GT.IVMINA) THEN
                  GO TO 39
                END IF
   32         CONTINUE
            END IF
          ELSE
            IF(LMAX) THEN
              DO 33 IADR=IADR,NOUT
                IF(IOUT(IADR).LT.IVMAXA) THEN
                  GO TO 39
                END IF
   33         CONTINUE
            ELSE
              IADR=NOUT+1
            END IF
          END IF
   39     CONTINUE
C         IADR is the first defined element.
C
C         Writing the array (undefined elements):
          WRITE(LU,'(I7,A)') IADR-IMIN,'*'
          IF(NOUT.LT.IADR) THEN
            GO TO 90
          END IF
C
        GO TO 20
      ELSE
C
C       Null values:
        IF(LMIN) THEN
          IVMINA=IVMIN
          IF(LMAX) THEN
            IVMAXA=IVMAX
            DO 51 IADR=1,NOUT
              IF(IOUT(IADR).LE.IVMINA.OR.IVMAXA.LE.IOUT(IADR)) THEN
                IOUT(IADR)=IUNDEF
              END IF
   51       CONTINUE
          ELSE
            DO 52 IADR=1,NOUT
              IF(IOUT(IADR).LE.IVMINA) THEN
                IOUT(IADR)=IUNDEF
              END IF
   52       CONTINUE
          END IF
        ELSE
          IF(LMAX) THEN
            IVMAXA=IVMAX
            DO 53 IADR=1,NOUT
              IF(IVMAXA.LE.IOUT(IADR)) THEN
                IOUT(IADR)=IUNDEF
              END IF
   53       CONTINUE
          END IF
        END IF
C
C       Writing the array:
        WRITE(LU) IOUT
C
      END IF
   90 CONTINUE
      IF(FILE.NE.' ') THEN
        CLOSE(LU)
      END IF
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE RARRAY(LU,FILE,FORM,LDEF,DEF,N,ARRAY)
      CHARACTER*(*) FILE,FORM
      LOGICAL LDEF
      INTEGER LU,N
      REAL DEF,ARRAY(N)
C
C Subroutine designed to read the real array from the disk.
C
C Input:
C     LU...   Logical unit number to be used.
C     FILE... Source filename.  If not blank, the file will be
C             opened and closed.  If blank, the file is assumed to be
C             already open, and will not be closed in this subroutine.
C     FORM... Form of the output file: either 'FORMATTED' or
C             'UNFORMATTED'.
C     LDEF... True if the null values are to be replaced by the given
C             default value DEF.
C             If FORM='FORMATTED' and LDEF=.FALSE., the array elements
C             corresponding to null values remain unchanged.
C     DEF...  Default value.
C     N...    Array dimension (number of elements to read).
C
C Output:
C     ARRAY.. Array having been read.
C
C Date: 2000, November 25
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Parameters:
      EXTERNAL UARRAY
      REAL     UARRAY
      REAL UNDEF
C
      CHARACTER*11 FORML
      INTEGER I
      REAL AUX
C
      UNDEF=UARRAY()
C
      IF(FILE.NE.' ') THEN
        WRITE(*,'(''+'',79('' ''))')
        WRITE(*,'(2A)') '+Reading: ',FILE(1:MIN0(LEN(FILE),70))
        OPEN(LU,FILE=FILE,FORM=FORM,STATUS='OLD')
      END IF
C
      FORML=FORM
      CALL LOWER(FORML)
      IF(FORML.EQ.'formatted') THEN
        IF(LDEF) THEN
          AUX=DEF
          DO 10 I=1,N
            ARRAY(I)=AUX
   10     CONTINUE
        END IF
        READ(LU,*) ARRAY
      ELSE
        READ(LU) ARRAY
        IF(LDEF) THEN
          IF(DEF.NE.UNDEF) THEN
            AUX=DEF
            DO 20 I=1,N
              IF(ARRAY(I).EQ.UNDEF) THEN
                ARRAY(I)=AUX
              END IF
   20       CONTINUE
          END IF
        END IF
      END IF
C
      IF(FILE.NE.' ') THEN
        CLOSE(LU)
      END IF
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE RARRAI(LU,FILE,FORM,LDEF,IDEF,N,IARRAY)
      CHARACTER*(*) FILE,FORM
      LOGICAL LDEF
      INTEGER LU,IDEF,N,IARRAY(N)
C
C Subroutine designed to read the integer array from the disk.
C
C Input:
C     LU...   Logical unit number to be used.
C     FILE... Source filename.  If not blank, the file will be
C             opened and closed.  If blank, the file is assumed to be
C             already open, and will not be closed in this subroutine.
C     FORM... Form of the output file: either 'FORMATTED' or
C             'UNFORMATTED'.
C     LDEF... True if the null values are to be replaced by the given
C             default value IDEF.
C             If FORM='FORMATTED' and LDEF=.FALSE., the array elements
C             corresponding to null values remain unchanged.
C     IDEF... Default value.
C     N...    Array dimension (number of elements to read).
C
C Output:
C     IARRAY..Array having been read.
C
C Date: 2000, November 25
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Parameters:
      INTEGER IUNDEF
      PARAMETER (IUNDEF=-999999999)
C
      CHARACTER*11 FORML
      INTEGER I,IAUX
C
      IF(FILE.NE.' ') THEN
        WRITE(*,'(''+'',79('' ''))')
        WRITE(*,'(2A)') '+Reading: ',FILE(1:MIN0(LEN(FILE),70))
        OPEN(LU,FILE=FILE,FORM=FORM,STATUS='OLD')
      END IF
C
      FORML=FORM
      CALL LOWER(FORML)
      IF(FORML.EQ.'formatted') THEN
        IF(LDEF) THEN
          IAUX=IDEF
          DO 10 I=1,N
            IARRAY(I)=IAUX
   10     CONTINUE
        END IF
        READ(LU,*) IARRAY
      ELSE
        READ(LU) IARRAY
        IF(LDEF) THEN
C         IF(IDEF.NE.IUNDEF) THEN
            IAUX=IDEF
            DO 20 I=1,N
              IF(IARRAY(I).EQ.IUNDEF) THEN
                IARRAY(I)=IAUX
              END IF
   20       CONTINUE
C         END IF
        END IF
      END IF
C
      IF(FILE.NE.' ') THEN
        CLOSE(LU)
      END IF
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE WARAY(LU,FILE,FORM,LMIN,VMIN,LMAX,VMAX,NOUT,N4,OUT)
      CHARACTER*(*) FILE,FORM
      LOGICAL LMIN,LMAX
      INTEGER LU,NOUT,N4
      REAL VMIN,VMAX,OUT(NOUT,N4)
C
C Subroutine designed to N4 times call subroutine WARRAY, for individual
C time levels.
C
C Input:
C     LU,FILE,FORM,LMIN,VMIN,LMAX,VMAX,NOUT... Refer to subroutine
C             WARRAY
C     N4...   Number of time levels.  NOUT values corresponding to each
C             level are written through an individual invocation of
C             subroutine WARRAY.
C     OUT...  Array of dimension NOUT*N4 to be written.
C
C No output.
C
C Date: 1998, March 21
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Local storage locations:
      INTEGER I4
C
C.......................................................................
C
      IF(FILE.NE.' ') THEN
        WRITE(*,'(''+'',79('' ''))')
        WRITE(*,'(2A)') '+Writing: ',FILE(1:MIN0(LEN(FILE),70))
        OPEN(LU,FILE=FILE,FORM=FORM)
      END IF
C
      DO 10 I4=1,N4
        CALL WARRAY(LU,' ',FORM,LMIN,VMIN,LMAX,VMAX,NOUT,OUT(1,I4))
   10 CONTINUE
C
      IF(FILE.NE.' ') THEN
        CLOSE(LU)
      END IF
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE WARAI(LU,FILE,FORM,LMIN,IVMIN,LMAX,IVMAX,NOUT,N4,IOUT)
      CHARACTER*(*) FILE,FORM
      LOGICAL LMIN,LMAX
      INTEGER LU,IVMIN,IVMAX,NOUT,N4,IOUT(NOUT,N4)
C
C Subroutine designed to N4 times call subroutine WARRAI, for individual
C time levels.
C
C Input:
C     LU,FILE,FORM,LMIN,IVMIN,LMAX,IVMAX,NOUT... Refer to subroutine
C             WARRAI
C     N4...   Number of time levels.  NOUT values corresponding to each
C             level are written through an individual invocation of
C             subroutine WARRAI.
C     IOUT... Array of dimension NOUT*N4 to be written.
C
C No output.
C
C Date: 1998, May 28
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Local storage locations:
      INTEGER I4
C
C.......................................................................
C
      IF(FILE.NE.' ') THEN
        WRITE(*,'(''+'',79('' ''))')
        WRITE(*,'(2A)') '+Writing: ',FILE(1:MIN0(LEN(FILE),70))
        OPEN(LU,FILE=FILE,FORM=FORM)
      END IF
C
      DO 10 I4=1,N4
        CALL WARRAI(LU,' ',FORM,LMIN,IVMIN,LMAX,IVMAX,NOUT,IOUT(1,I4))
   10 CONTINUE
C
      IF(FILE.NE.' ') THEN
        CLOSE(LU)
      END IF
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE RARAY(LU,FILE,FORM,LDEF,DEF,N,N4,ARRAY)
      CHARACTER*(*) FILE,FORM
      LOGICAL LDEF
      INTEGER LU,N,N4
      REAL DEF,ARRAY(N,N4)
C
C Subroutine designed to N4 times call subroutine RARRAY, for individual
C time levels.
C
C Input:
C     LU,FILE,FORM,LDEF,DEF,N... Refer to subroutine
C             RARRAY
C     N4...   Number of time levels.  N values corresponding to each
C             level are read by an individual invocation of subroutine
C             RARRAY.
C
C Output:
C     ARRAY...Array of dimension N*N4 having been read.
C
C Date: 2000, July 31
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Local storage locations:
      INTEGER I4
C
C.......................................................................
C
      IF(FILE.NE.' ') THEN
        WRITE(*,'(''+'',79('' ''))')
        WRITE(*,'(2A)') '+Reading: ',FILE(1:MIN0(LEN(FILE),70))
        OPEN(LU,FILE=FILE,FORM=FORM,STATUS='OLD')
      END IF
C
      DO 10 I4=1,N4
        CALL RARRAY(LU,' ',FORM,LDEF,DEF,N,ARRAY(1,I4))
   10 CONTINUE
C
      IF(FILE.NE.' ') THEN
        CLOSE(LU)
      END IF
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE RARAI(LU,FILE,FORM,LDEF,IDEF,N,N4,IARRAY)
      CHARACTER*(*) FILE,FORM
      LOGICAL LDEF
      INTEGER LU,N,IDEF,N4,IARRAY(N,N4)
C
C Subroutine designed to N4 times call subroutine RARRAI, for individual
C time levels.
C
C Input:
C     LU,FILE,FORM,LDEF,IDEF,N,N4... Refer to subroutine
C             RARRAI
C
C Output:
C     IARRAY..Array of dimension N*N4 having been read.
C
C Date: 2000, July 31
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Local storage locations:
      INTEGER I4
C
C.......................................................................
C
      IF(FILE.NE.' ') THEN
        WRITE(*,'(''+'',79('' ''))')
        WRITE(*,'(2A)') '+Reading: ',FILE(1:MIN0(LEN(FILE),70))
        OPEN(LU,FILE=FILE,FORM=FORM,STATUS='OLD')
      END IF
C
      DO 10 I4=1,N4
        CALL RARRAI(LU,' ',FORM,LDEF,IDEF,N,IARRAY(1,I4))
   10 CONTINUE
C
      IF(FILE.NE.' ') THEN
        CLOSE(LU)
      END IF
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE FORM1(OUTMIN,OUTMAX,FORMAT)
      REAL OUTMIN,OUTMAX
      CHARACTER*8 FORMAT
C
C Subroutine designed to determine the best output format for reals.
C
C Input:
C     OUTMIN,OUTMAX... Minimum and maximum real number to be written.
C
C Output:
C     FORMAT..String containing the output format e.g. like 'F07.3,A,'.
C             The width of the defined string is 8 characters.
C             It has the form of 'F00.0,A,', where zeros are replaced
C             by reasonable values.  The subroutine outputs
C             at least MAXDIG digits (including all zeros after the
C             decimal point) of the largest positive number OUTMAX or
C             MAXDIG-1 digits of the most negative number if OUTMIN is
C             negative, and adjusts the width of the output field to
C             MAXDIG+1 columns, if possible.  The (MAXDIG+2)th column is
C             reserved for a space or another separator.
C             If OUTMIN=0 and OUTMAX=0, the width of the output field is
C             adjusted to 2 columns.
C             If the number of digits (without leading zeros) is smaller
C             than MINDIG, format Fnn.d with nn=MAXDIG+1 is changed to
C             Gmm.d with mm=MAXDIG+5.  The (MAXDIG+6)th column is
C             reserved for a space or another separator.
C                                                  
C Input SEP parameters:
C     MAXDIG=positive integer... Minimum number of digits of the largest
C             positive number OUTMAX in the output format,
C             see the description of FORMAT above.
C             MAXDIG must be less than 10.
C             Default: MAXDIG=6
C     MINDIG=positive integer... Number of digits to change edition F
C             to edition G, see the description of FORMAT above.
C             MINDIG should be less than MAXDIG.
C             Default: MINDIG=4
C
C Date: 2008, January 18
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Local storage locations:
      INTEGER MAXDIG,MINDIG
      INTEGER IFORM1,IFORM2
      REAL SMALL
      SAVE MAXDIG,MINDIG
      DATA MAXDIG/-1/
C     IFORM1,IFORM2... Define format to write the travel times.
C             Limits: 0.LE.IFORM2.LE.9, IFORM2+1.LE.IFORM1.LE.99.
C
C.......................................................................
C
      IF (MAXDIG.EQ.-1) THEN
        CALL RSEP3I('MAXDIG',MAXDIG,6)
        CALL RSEP3I('MINDIG',MINDIG,4)
      ENDIF
C     Setting output format:
      IFORM1=MAX0(INT(ALOG10(AMAX1(OUTMAX,0.001))+0.3*0.1**MAXDIG+1.),0)
      IF(OUTMIN.LT.0.) THEN
        IFORM1=MAX0(INT(ALOG10(AMAX1(-OUTMIN,0.001))+3.0*0.1**MAXDIG+2.)
     *                                                        ,1,IFORM1)
      END IF
C     Here, IFORM1 is the number of digits left to the decimal point.
      IFORM2=MAX0(MAXDIG-IFORM1,0)
C     IFORM2 is the number of decimal places.
      IFORM1=IFORM1+IFORM2+1
C     IFORM1 is the width of the output field for one element.
      FORMAT='F02.0,A,'
      IF(OUTMIN.NE.0..OR.OUTMAX.NE.0.) THEN
        SMALL=10.**(MINDIG-IFORM2)-0.5*10.**(-IFORM2)
        IF(-SMALL.LE.OUTMIN.AND.OUTMAX.LE.SMALL) THEN
          FORMAT='E00.0,A,'
          IFORM1=MAXDIG+5
          IFORM2=MAXDIG
          IF(OUTMIN.LT.0.) THEN
            IFORM2=MAXDIG-1
          ELSE
            IFORM2=MAXDIG
          END IF
        ELSE IF(IFORM1.GT.MAXDIG+5) THEN
          FORMAT='E00.0,A,'
          IFORM1=MAXDIG+5
          IF(OUTMIN.LT.0.) THEN
            IFORM2=MAXDIG-1
          ELSE
            IFORM2=MAXDIG
          END IF
        END IF
        FORMAT(2:2)=CHAR(ICHAR('0')+IFORM1/10)
        FORMAT(3:3)=CHAR(ICHAR('0')+MOD(IFORM1,10))
        FORMAT(5:5)=CHAR(ICHAR('0')+IFORM2)
      END IF
C     Output format is set.
C
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE FORM2(NQ,OUTMIN,OUTMAX,FORMAT)
      INTEGER NQ
      REAL OUTMIN(NQ),OUTMAX(NQ)
      CHARACTER*(*) FORMAT
C
C Subroutine designed to determine the best output format for multiples
C of real numbers.
C
C Input:
C     NQ...   Number of reals in each output line.
C     OUTMIN,OUTMAX... Minimum and maximum real numbers to be written.
C     FORMAT..String of at least 8*NQ characters.
C
C Output:
C     FORMAT..String containing the output format, e.g. like
C             'F07.3,A,F07.3,A,F07.3,A,F07.6,A,F07.4,A)'.  The width of
C             the defined string is 8*NQ characters.  It has the above
C             form, where digits are replaced by reasonable values.
C             Note ')' at the end instead of ','.
C             The format is set using repeated invocation of subroutine
C             FORM1, see the description of its
C             parameters MAXDIG and MINDIG.
C
C Date: 2005, April 7
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Local storage locations:
      INTEGER I
C
C.......................................................................
C
      DO 10 I=1,NQ
        CALL FORM1(OUTMIN(I),OUTMAX(I),FORMAT(8*I-7:8*I))
   10 CONTINUE
      FORMAT(8*NQ:8*NQ)=')'
C
      RETURN
      END
C
C=======================================================================
C