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