C Subroutine file 'forms.for' to facilitate writing and reading data.
C
C Date: 1996, July 8
C By Ludek Klimes
C
C This file consists of the following external procedures:
C     WARRAY..Subroutine designed to write a given array into the given
C             formatted or unformatted file.
C     RARRAY..Subroutine designed to read the array from the given
C             formatted or unformatted file.
C     FORM1...Subroutine designed to determine the best output format
C             for reals.
C     FORM2...Subroutine designed to determine the best output format
C             for multiples of real numbers.
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 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 999999 are written in place of the null
C               values.
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     VMIN,VMAX... Trade-off limits.
C     NOUT... Dimension of the array OUT.
C     OUT...  Array to be written.
C
C No output.
C
C Date: 1995, August 17
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Local storage locations:
C
      CHARACTER*14 FORMAT
      INTEGER IMIN,IADR
      REAL OUTMIN,OUTMAX,VMINA,VMAXA
C
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
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:
      IF(FORM.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:
        FORMAT='(10(F00.0,1X))'
        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)=999999.
              END IF
   51       CONTINUE
          ELSE
            DO 52 IADR=1,NOUT
              IF(OUT(IADR).LE.VMINA) THEN
                OUT(IADR)=999999.
              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)=999999.
              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
      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 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: 1994, August 21
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
      INTEGER I
      REAL AUX
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
      IF(FORM.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.LT.899999.OR.1111110.LT.DEF) THEN
            AUX=DEF
            DO 20 I=1,N
              IF(999998.LT.ARRAY(I)) 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
      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 attempts to output
C             at least 6 digits (including all zeros after the decimal
C             point) of the largest positive number OUTMAX and 5 digits
C             of the most negative number if OUTMIN is negative, and to
C             adjust the width of the output field to 7 columns, if
C             possible.  The 8-th column is reserved for space or
C             another separator.  If OUTMIN=0 and OUTMAX=0, the width of
C             the output field is adjusted to 2 columns.
C
C Date: 1996, August 30
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C     Local storage locations:
      INTEGER IFORM1,IFORM2
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
C     Setting output format:
      IFORM1=MAX0(INT(ALOG10(AMAX1(OUTMAX,0.001))+1.001),0)
      IF(OUTMIN.LT.0.) THEN
        IFORM1=MAX0(INT(ALOG10(AMAX1(-OUTMIN,0.001))+2.001),1,IFORM1)
      END IF
C     Here, IFORM1 is the number of digits left to the decimal point.
      IFORM2=MAX0(6-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
        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
      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 if 8*NQ characters.  It has the above
C             form, where digits are replaced by reasonable values.
C             Note ')' at the end instead of ','.   The subroutine
C             attempts to output at least 6 digits (including all zeros
C             after the decimal point) of the largest positive number
C             OUTMAX and 5 digits of the most negative number if OUTMIN
C             is negative, and to adjust the width of the output field
C             to 8 columns including the space after the number, if
C             possible.
C
C Date: 1995, August 17
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
