SUBROUTINE READG(IRD,ICOL1,ICOL2,X,N) C C PURPOSE--THIS SUBROUTINE PERFORMS A FORMAT-FREE READ C OF DATA FROM INPUT UNIT = IRD. C ONLY THE CARD COLUMNS BETWEEN ICOL1 AND ICOL2 C (INCLUSIVELY) ARE SCANNED FOR THE READ. C THIS SUBROUTINE IS IDENTICAL TO THE READ SUBROUTINE C EXCEPT THAT THE READ SUBROUTINE ASSUMES INPUT UNIT 5, C WHEREAS THIS READG SUBROUTINE ALLOWS THE ANALYST C TO SPECIFY THE INPUT UNIT. C THIS SUBROUTINE GIVES THE DATA ANALYST THE ABILITY C TO GET DATA INTO THE MACHINE C FROM A VARIETY OF INPUT SOURCES C (CARD, TAPE, DISC, ETC.) C WITHOUT HAVING C TO WORRY ABOUT AND SPECIFY FORMATS. C THE DATA CARD IMAGES MAY BE MADE C WITHOUT REGARD TO ANY PARTICULAR FORMAT C AND MAY BE ENTERED INTO THE MACHINE C WITHOUT DEFINING ANY FORMATS. C INPUT ARGUMENTS--IRD = THE INTEGER VALUE SPECIFYING C THE INPUT UNIT FROM WHICH C THE CARD IMAGES WILL COME. C --ICOL1 = THE INTEGER CARD COLUMN NUMBER C WHICH DEFINES THE LOWER BOUND C (INCLUSIVELY) OF THE INTERVAL C ON EACH CARD IMAGE TO BE SCANNED C FOR THE READ. C --ICOL2 = THE INTEGER CARD COLUMN NUMBER C WHICH DEFINES THE UPPER BOUND C (INCLUSIVELY) OF THE INTERVAL C ON EACH CARD IMAGE TO BE SCANNED C FOR THE READ. C OUTPUT ARGUMENTS--X = THE SINGLE PRECISION VECTOR C INTO WHICH THE READ DATA VALUES C WILL BE SEQUENTIALLY PLACED. C --N = THE INTEGER VALUE C WHICH WILL EQUAL THE NUMBER OF DATA C VALUES WHICH WERE READ. C OUTPUT--THE SINGLE PRECISION VECTOR X WHICH C WILL CONTAIN THE READ C DATA VALUES, AND C THE INTEGER VALUE N WHICH WILL C EQUAL THE NUMBER OF DATA VALUES C READ INTO X. C ALSO, 7 LINES OF SUMMARY INFORMATION C WILL BE GENERATED-- C REGARDING WHAT WAS IN FACT READ INTO THE MACHINE-- C 1) THE VALUES OF ICOL1 AND ICOL2; C 2) THE (ENTIRE) FIRST DATA CARD READ; C 3) THE (ENTIRE) LAST DATA CARD READ; C 4) THE TOTAL NUMBER OF DATA CARDS READ; C 5) THE TOTAL NUMBER OF DATA VALUES READ. C PRINTING--YES. C RESTRICTIONS--ICOL1 AND ICOL2 MUST BE BETWEEN 1 AND 80, C INCLUSIVELY. C OTHER DATAPAC SUBROUTINES NEEDED--NONE. C FORTRAN LIBRARY SUBROUTINES NEEDED--NONE. C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. C LANGUAGE--ANSI FORTRAN. C COMMENT--ADJACENT DATA VALUES ON THE SAME CARD C MUST BE SEPARATED BY AT LEAST 1 BLANK C OR 1 ALPHABETIC CHARACTER, OR BY ANY C COMBINATION OF BLANKS AND ALPHABETIC C CHARACTERS. IN THIS CONTEXT, AN C ALPHABETIC CHARACTER IS ANY CHARACTER C OTHER THAN 0, 1, 2, ..., 9, +, -, OR .. C IN EFFECT, THEREFORE, ALL ALPHABETIC INFORMATION C IN THE INTERVAL DEFINED BY ICOL1 AND ICOL2 C (INCLUSIVELY) IS IGNORED FOR READING PURPOSES. C ALL INFORMATION (BOTH NUMERIC AND ALPHABETIC) C OUTSIDE THE DEFINED INTERVAL IS ALSO IGNORED C FOR READING PURPOSES. C COMMENT--THE DATA VALUES ON THE CARDS ARE FREE-FORMAT. C THEY MAY BE EITHER INTEGER OR FLOATING POINT C (THAT IS, WITHOUT OR WITH THE DECIMAL POINTS). C EXPONENTIAL FLOATING POINT FORMAT (E FORMAT) C IS NOT PERMITTED. C ALL DATA, WHETHER WITHOUT OR WITH THE DECIMAL POINT C ON THE CARDS, WILL BE READ INTO THE MACHINE C INTO THE X VECTOR AND WILL RESIDE THERE AS FLOATING C POINT NUMBERS. C COMMENT--ANY PARTICULAR DATA VALUE MUST START AND END C ON THE SAME DATA CARD; DATA VALUES MAY NOT C START ON ONE CARD AND FINISH ON THE NEXT. C VARIOUS ILLEGAL COMBINATIONS (SUCH AS C MULTIPLE DECIMAL POINTS, MULTIPLE PLUSSES OR C MINUSES, INCOMPLETE VALUES CONSISTING ONLY C OF A DECIMAL POINT, OR ONLY OF A SIGN AND A DECIMAL C POINT, ETC. ARE NOT ACCEPTED AND THE C DATA ANALYST WILL BE INFORMED OF THE EXISTENCE OF C SUCH BY AN ERROR DIAGNOSTIC. C IN THE EVENT OF SUCH AN ILLEGAL COMBINATION, C THAT 'NUMBER' AND ALL REMAINING NUMBERS ON THAT CARD WILL C WILL BE IGNORED (NOT READ INTO THE MACHINE) C AND THE NEXT DATA CARD WILL THEN C BE READ. C COMMENT--THIS SUBROUTINE WILL CONTINUOUSLY AND C SEQUENTIALLY READ CARDS UNTIL A CARD WITH C THE WORD END (SOMEWHERE BETWEEN C COLUMNS ICOL1 AND ICOL2 (INCLUSIVELY) C IS ENCOUNTERED. C TO TERMINATE A DATA SET, THE ANALYST SHOULD C APPEND SUCH A CARD WHICH HAS THE WORD C END SOMEWHERE IN THE INTERVAL C DEFINED BY ICOL1 AND ICOL2. C FOR EXAMPLE, IF ICOL1 = 1 AND ICOL2 = 20, C THEN A SEPARATE CARD WITH END C IN COLUMNS 1, 2, AND 3, OR C IN COLUMNS 10, 11, AND 12, ETC. C WOULD TERMINATE THE READ. C IT IS IMPORTANT TO APPEND SUCH A CARD-- C FAILURE TO DO SO WILL RESULT IN AN INCOMPLETE C DATA SET OR (ON SOME COMPUTERS) AN C UNPREDICTABLE RUN TERMINATION. C REFERENCES--NONE. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING LABORATORY (205.03) C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-2315 C ORIGINAL VERSION--DECEMBER 1972. C UPDATED --AUGUST 1974. C UPDATED --NOVEMBER 1975. C UPDATED --OCTOBER 1976. C C--------------------------------------------------------------------- C CHARACTER*4 PLUS,MINUS,POINT,BLANK CHARACTER*4 ALPHAE,ALPHAN,ALPHAD CHARACTER*4 IC CHARACTER*4 IA CHARACTER*4 ICHAR CHARACTER*4 ISTOR1 CHARACTER*4 ISTOR2 C DIMENSION X(1) DIMENSION IA(80),ICHAR(41),IC(10) DIMENSION ISTOR1(80),ISTOR2(80) C DATA PLUS,MINUS,POINT,BLANK /'+','-','.',' '/ DATA ALPHAE,ALPHAN,ALPHAD /'E','N','D'/ DATA IC(1),IC(2),IC(3),IC(4),IC(5),IC(6),IC(7),IC(8),IC(9),IC(10) 1/'0','1','2','3','4','5','6','7','8','9'/ C N=0 IPR=6 C C CHECK THE INPUT ARGUMENTS FOR ERRORS C MINCOL=ICOL1 MAXCOL=ICOL2 IF(ICOL2.LT.ICOL1)MINCOL=ICOL2 IF(ICOL2.LT.ICOL1)MAXCOL=ICOL1 IF(MINCOL.LT.1.OR.MAXCOL.GT.80)GOTO51 GOTO90 51 WRITE(IPR,41) WRITE(IPR,42) WRITE(IPR,43)ICOL1,ICOL2 RETURN 90 CONTINUE 41 FORMAT(1H ,103H***** FATAL ERROR--THE FIRST OR SECOND (OR BOTH) IN 1PUT ARGUMENT TO THE READG SUBROUTINE IS OUTSIDE THE) 42 FORMAT(1H , 37H ALLOWABLE (1,80) INTERVAL *****) 43 FORMAT(1H , 41H***** THE VALUE OF THE FIRST ARGUMENT IS ,I7, 42H 1AND THE VALUE OF THE SECOND ARGUMENT IS ,I7,6H *****) C C-----START POINT----------------------------------------------------- C C NUMCRD=0 120 READ(IRD,2031,END=1950)(IA(I),I=1,80) DO101J=1,78 IF(IA(J).NE.ALPHAE)GOTO101 JP1=J+1 IF(IA(JP1).NE.ALPHAN)GOTO101 JP2=J+2 IF(IA(JP2).NE.ALPHAD)GOTO101 GOTO1950 101 CONTINUE 102 NUMCRD=NUMCRD+1 IF(NUMCRD.EQ.1)GOTO103 DO104J=1,80 ISTOR2(J)=IA(J) 104 CONTINUE GOTO105 103 DO106J=1,80 ISTOR1(J)=IA(J) ISTOR2(J)=IA(J) 106 CONTINUE 105 I=MINCOL C 150 DO100J=1,41 ICHAR(J)=BLANK 100 CONTINUE NC=0 NDP=0 160 DO200J=1,10 IF(IA(I).EQ.IC(J))GOTO250 200 CONTINUE IF(IA(I).EQ.PLUS)GOTO350 IF(IA(I).EQ.MINUS)GOTO450 IF(IA(I).EQ.POINT)GOTO550 IF(NC.EQ.0)GOTO650 IF(NC.EQ.1)GOTO750 IF(NC.EQ.2)GOTO850 IEND=0 GOTO1050 C 250 IF(NC.EQ.0)GOTO260 GOTO270 260 NC=1 ICHAR(NC)=PLUS 270 NC=NC+1 ICHAR(NC)=IA(I) I=I+1 IF(I.LE.MAXCOL)GOTO160 IEND=1 GOTO1050 C 350 IF(NC.EQ.0)GOTO360 WRITE(IPR,999) WRITE(IPR,2001) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 360 NC=1 ICHAR(NC)=IA(I) I=I+1 IF(I.LE.MAXCOL)GOTO160 WRITE(IPR,999) WRITE(IPR,2002) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C 450 IF(NC.EQ.0)GOTO460 WRITE(IPR,999) WRITE(IPR,2003) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 460 NC=1 ICHAR(NC)=IA(I) I=I+1 IF(I.LE.MAXCOL)GOTO160 WRITE(IPR,999) WRITE(IPR,2004) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C 550 IF(NC.EQ.0)GOTO560 IF(NC.EQ.1)GOTO570 IF(NDP.EQ.0)GOTO580 WRITE(IPR,999) WRITE(IPR,2005) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 580 NC=NC+1 ICHAR(NC)=IA(I) NDP=NDP+1 I=I+1 IF(I.LE.MAXCOL)GOTO160 IEND=1 GOTO1050 570 NC=2 ICHAR(NC)=IA(I) NDP=NDP+1 I=I+1 IF(I.LE.MAXCOL)GOTO160 WRITE(IPR,999) WRITE(IPR,2006) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 560 NC=1 ICHAR(NC)=PLUS NC=2 ICHAR(NC)=IA(I) NDP=NDP+1 I=I+1 IF(I.LE.MAXCOL)GOTO160 WRITE(IPR,999) WRITE(IPR,2007) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C 650 I=I+1 IF(I.LE.MAXCOL)GOTO160 GOTO120 C 750 WRITE(IPR,999) WRITE(IPR,2008) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C 850 IF(ICHAR(1).EQ.PLUS.AND.ICHAR(2).EQ.POINT)GOTO860 IF(ICHAR(1).EQ.MINUS.AND.ICHAR(2).EQ.POINT)GOTO870 IEND=0 GOTO1050 860 WRITE(IPR,999) WRITE(IPR,2009) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 870 WRITE(IPR,999) WRITE(IPR,2010) WRITE(IPR,2021) WRITE(IPR,2022)NUMCRD WRITE(IPR,2023)(IA(J),J=1,80) WRITE(IPR,999) GOTO120 C C C 1050 DO1100J=2,NC IF(ICHAR(J).EQ.POINT)GOTO1150 1100 CONTINUE J=NC+1 NCP1=NC+1 ICHAR(NCP1)=POINT NC=NCP1 C 1150 LOCPT=J NUMINT=J-2 NUMDEC=NC-J SUM=0.0 IF(NUMINT.EQ.0)GOTO1450 ISTART=2 ISTOP=NUMINT+1 IPOWER=-1 DO1200J=ISTART,ISTOP JREV=ISTOP-J+2 DO1300K=1,10 IF(ICHAR(JREV).EQ.IC(K))GOTO1350 1300 CONTINUE WRITE(IPR,999) WRITE(IPR,2024) WRITE(IPR,2025)(ICHAR(L),L=1,41) WRITE(IPR,2023)(IA(L),L=1,80) WRITE(IPR,2022)NUMCRD WRITE(IPR,999) RETURN C 1350 Y=K-1 IPOWER=IPOWER+1 SUM=SUM+Y*(10.0**IPOWER) 1200 CONTINUE C 1450 IF(NUMDEC.EQ.0)GOTO1750 ISTART=LOCPT+1 ISTOP=NC IPOWER=0 DO1500J=ISTART,ISTOP DO1600K=1,10 IF(ICHAR(J).EQ.IC(K))GOTO1650 1600 CONTINUE WRITE(IPR,999) WRITE(IPR,2026) WRITE(IPR,2025)(ICHAR(L),L=1,41) WRITE(IPR,2023)(IA(L),L=1,80) WRITE(IPR,2022)NUMCRD WRITE(IPR,999) RETURN C 1650 Y=K-1 IPOWER=IPOWER+1 SUM=SUM+Y/(10.0**IPOWER) 1500 CONTINUE C 1750 IF(ICHAR(1).EQ.MINUS)SUM=-SUM N=N+1 X(N)=SUM IF(IEND.EQ.1)GOTO120 I=I+1 IF(I.LE.MAXCOL)GOTO150 GOTO120 1950 WRITE(IPR,999) IF(NUMCRD.EQ.0)GOTO1960 WRITE(IPR,2300) WRITE(IPR,2301)IRD WRITE(IPR,2302)MINCOL,MAXCOL WRITE(IPR,2303)(ISTOR1(J),J=1,80) WRITE(IPR,2304)(ISTOR2(J),J=1,80) 1960 WRITE(IPR,2305)NUMCRD WRITE(IPR,2306)N WRITE(IPR,999) WRITE(IPR,999) RETURN C 999 FORMAT(1H ) 2001 FORMAT(1H ,103H***** INPUT DATA ERROR--A PLUS HAS OCCURRED IN T 1HE MIDDLE OF SOME DATA VALUE ON THE CARD BELOW *****) 2002 FORMAT(1H , 94H***** INPUT DATA ERROR--THE LAST DATA VALUE ON T 1HE CARD BELOW CONSISTS OF ONLY A PLUS *****) 2003 FORMAT(1H ,104H***** INPUT DATA ERROR--A MINUS HAS OCCURRED IN 1THE MIDDLE OF SOME DATA VALUE ON THE CARD BELOW *****) 2004 FORMAT(1H , 95H***** INPUT DATA ERROR--THE LAST DATA VALUE ON T 1HE CARD BELOW CONSISTS OF ONLY A MINUS *****) 2005 FORMAT(1H , 94H***** INPUT DATA ERROR--SOME DATA VALUE ON THE C 1ARD BELOW HAS MULTIPLE DECIMAL POINTS *****) 2006 FORMAT(1H ,125H***** INPUT DATA ERROR--THE LAST DATA VALUE ON T 1HE CARD BELOW CONSISTS OF ONLY A +. OR OF ONLY A -. 1 *****) 2007 FORMAT(1H ,103H***** INPUT DATA ERROR--THE LAST DATA VALUE ON T 1HE CARD BELOW CONSISTS OF ONLY A DECIMAL POINT *****) 2008 FORMAT(1H ,109H***** INPUT DATA ERROR--SOME DATA VALUE ON THE C 1ARD BELOW CONSISTS OF ONLY A PLUS OR OF ONLY A MINUS *****) 2009 FORMAT(1H , 97H***** INPUT DATA ERROR--SOME DATA VALUE ON THE C 1ARD BELOW CONSISTS OF ONLY A +. *****) 2010 FORMAT(1H , 97H***** INPUT DATA ERROR--SOME DATA VALUE ON THE C 1ARD BELOW CONSISTS OF ONLY A -. *****) 2021 FORMAT(1H ,104H THIS ILLEGAL DATA VALUE AND ALL SUBSEQUENT DA 1TA VALUES ON THIS CARD IMAGE (ONLY) HAVE BEEN DELETED) 2022 FORMAT(1H , 30H THIS CARD IMAGE WAS THE ,I7,33H-TH DATA CARD 1IMAGE THAT WAS READ) 2023 FORMAT(1H , 39H THE CARD IMAGE IS AS FOLLOWS-- ,80A1) 2024 FORMAT(1H ,121H***** PROGRAMMING ERROR IN THE READG SUBROUTINE-- 1A NON-NUMERIC CHARACTER WAS ENCOUNTERED IN CONVERTING THE INTEGER 1PART) 2025 FORMAT(1H , 38H OF THE FOLLOWING DATA VALUE-- ,41A1) 2026 FORMAT(1H ,121H***** PROGRAMMING ERROR IN THE READG SUBROUTINE-- 1A NON-NUMERIC CHARACTER WAS ENCOUNTERED IN CONVERTING THE DECIMAL 1PART) 2031 FORMAT(80A1) 2300 FORMAT(1H , 35HOUTPUT FROM THE READG SUBROUTINE--) 2301 FORMAT(1H , 31HTHE INPUT UNIT DEVICE NUMBER = ,I7) 2302 FORMAT(1H , 59HTHE SCANNING INTERVAL FOR EACH DATA CARD IMAGE WAS 1COLUMN ,I3, 17H THROUGH COLUMN ,I3, 12H (INCLUSIVE)) 2303 FORMAT(1H , 47HTHE (ENTIRE) FIRST DATA CARD IMAGE READ WAS , 180A1) 2304 FORMAT(1H , 47HTHE (ENTIRE) LAST DATA CARD IMAGE READ WAS , 180A1) 2305 FORMAT(1H , 47HTHE TOTAL NUMBER OF DATA CARD IMAGES READ WAS , ) 1I7) 2306 FORMAT(1H , 47HTHE TOTAL NUMBER (= N) OF DATA VALUES READ WAS ,I7) C END