C
```C Subroutine file 'forms.for' to facilitate writing and reading data.
C
C Version: 7.40
C Date: 2017, May 21
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
C Input SEP parameter:
C     UNDEF=real... Real number to be used for undefined value.
C             Default: UNDEF=-3.4E+38
C
C Date: 2017, May 3
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C Subroutines and external functions required:
EXTERNAL RSEP3R
C     RSEP3R... File sep.for.
C
C  Parameters:
REAL UNDEF
C-----------------------------------------------------------------------
C
CALL RSEP3R('UNDEF',UNDEF,-3.4E+38)
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
C               written by list-directed output (free format).
C               Example: 124 null values are written as '    124*'.
C             Unformatted output:
C               The values of UNDEF are written
C               in place of the null 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     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     UNDEF=real... Real number to be used for undefined value.
C             Default: UNDEF=value used in subroutine UARRAY
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
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     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
END IF
END IF
11     CONTINUE
ELSE
END IF
12     CONTINUE
END IF
OUTMAX=0.
IF(LMAX) THEN
VMAXA=VMAX
END IF
END IF
13     CONTINUE
ELSE
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
C       Beginning of the loop
20   CONTINUE
C
C         Trade off (searching for undefined elements):
IF(LMIN) THEN
IF(LMAX) THEN
GO TO 29
END IF
21         CONTINUE
ELSE
GO TO 29
END IF
22         CONTINUE
END IF
ELSE
IF(LMAX) THEN
GO TO 29
END IF
23         CONTINUE
ELSE
END IF
END IF
29     CONTINUE
C         IADR is the first undefined element.
C
C         Writing the array (defined elements):
WRITE(LU,FORMAT) OUT
GO TO 90
ELSE
GO TO 90
END IF
END IF
C
C         Searching for the next defined elements:
IF(LMIN) THEN
IF(LMAX) THEN
GO TO 39
END IF
31         CONTINUE
ELSE
GO TO 39
END IF
32         CONTINUE
END IF
ELSE
IF(LMAX) THEN
GO TO 39
END IF
33         CONTINUE
ELSE
END IF
END IF
39     CONTINUE
C         IADR is the first defined element.
C
C         Writing the array (undefined elements):
GO TO 90
END IF
C
GO TO 20
ELSE
C
C       Null values:
IF(LMIN) THEN
VMINA=VMIN
IF(LMAX) THEN
VMAXA=VMAX
END IF
51       CONTINUE
ELSE
END IF
52       CONTINUE
END IF
ELSE
IF(LMAX) THEN
VMAXA=VMAX
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     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     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
C     FORMAT..String containing the output format, e.g. like (10I08).
C     IMIN... Loop lower bound, locally also 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
END IF
END IF
11     CONTINUE
ELSE
END IF
12     CONTINUE
END IF
MAXOUT=0
IF(LMAX) THEN
IVMAXA=IVMAX
END IF
END IF
13     CONTINUE
ELSE
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
IMIN=IMIN/10
IF(IMIN.LT.1) THEN
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
C       Beginning of the loop
20   CONTINUE
C
C         Trade off (searching for undefined elements):
IF(LMIN) THEN
IF(LMAX) THEN
GO TO 29
END IF
21         CONTINUE
ELSE
GO TO 29
END IF
22         CONTINUE
END IF
ELSE
IF(LMAX) THEN
GO TO 29
END IF
23         CONTINUE
ELSE
END IF
END IF
29     CONTINUE
C         IADR is the first undefined element.
C
C         Writing the array (defined elements):
WRITE(LU,FORMAT) IOUT
GO TO 90
ELSE
GO TO 90
END IF
END IF
C
C         Searching for the next defined elements:
IF(LMIN) THEN
IF(LMAX) THEN
GO TO 39
END IF
31         CONTINUE
ELSE
GO TO 39
END IF
32         CONTINUE
END IF
ELSE
IF(LMAX) THEN
GO TO 39
END IF
33         CONTINUE
ELSE
END IF
END IF
39     CONTINUE
C         IADR is the first defined element.
C
C         Writing the array (undefined elements):
GO TO 90
END IF
C
GO TO 20
ELSE
C
C       Null values:
IF(LMIN) THEN
IVMINA=IVMIN
IF(LMAX) THEN
IVMAXA=IVMAX
END IF
51       CONTINUE
ELSE
END IF
52       CONTINUE
END IF
ELSE
IF(LMAX) THEN
IVMAXA=IVMAX
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 input 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 Input SEP parameter:
C     UNDEF=real... Real number to be used for undefined value.
C             Default: UNDEF=value used in subroutine UARRAY
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('' ''))')
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
ELSE
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 input 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
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('' ''))')
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
ELSE
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('' ''))')
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('' ''))')
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 'E11.5,A,'.
C             The width of the defined string is 8 characters.
C             It has the form of 'E00.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             If the number of digits (without leading zeros) is smaller
C             than MINDIG, format Fnn.d with nn=MAXDIG+1 is changed to
C             Emm.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 E, see the description of FORMAT above.
C             MINDIG should be less than MAXDIG.
C             Default: MINDIG=4
C
C Date: 2014, April 2
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
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                                                                 ```
{"ft_lang_label":"__label__en","ft_lang_prob":0.5751858,"math_prob":0.9369957,"size":24918,"snap":"2023-14-2023-23","text_gpt3_token_len":7350,"char_repetition_ratio":0.21405636,"word_repetition_ratio":0.54423594,"special_character_ratio":0.35773337,"punctuation_ratio":0.278487,"nsfw_num_words":0,"has_unicode_error":false,"math_prob_llama3":0.9571811,"pos_list":[0],"im_url_duplicate_count":[null],"WARC_HEADER":"{\"WARC-Type\":\"response\",\"WARC-Date\":\"2023-03-28T23:57:15Z\",\"WARC-Record-ID\":\"<urn:uuid:4186598d-35f7-4af8-a145-4dc4249df2d9>\",\"Content-Length\":\"33809\",\"Content-Type\":\"application/http; msgtype=response\",\"WARC-Warcinfo-ID\":\"<urn:uuid:cfce5fd4-6b18-4d54-8437-087a20fafc7f>\",\"WARC-Concurrent-To\":\"<urn:uuid:b18672c8-1d6a-431b-a477-b5d2117eabb7>\",\"WARC-IP-Address\":\"195.113.33.22\",\"WARC-Target-URI\":\"http://sw3d.mff.cuni.cz/software/sw3dcd24/forms/forms.for\",\"WARC-Payload-Digest\":\"sha1:CND6X3GAOBXVKVS2HQRNFJQZN7REW57N\",\"WARC-Block-Digest\":\"sha1:2GFIMC7O7NIE5UTF2OUJ66DIEKTUQ4D7\",\"WARC-Identified-Payload-Type\":\"text/html\",\"warc_filename\":\"/cc_download/warc_2023/CC-MAIN-2023-14/CC-MAIN-2023-14_segments_1679296948900.50_warc_CC-MAIN-20230328232645-20230329022645-00699.warc.gz\"}"}