1 : C INFOPN SOURCE CHAT 05/01/13 00:36:39 5004 2 : SUBROUTINE INFOPN(IAREA,IRET) 3 : IMPLICIT INTEGER(I-N) 4 : SAVE LINDEX,SINDEX,NINDEX,ISTAT,IULENO,IUTINO 5 : CHARACTER*4 IRET 6 : CHARACTER*(*) IAREA 7 : SEGMENT SINDEX 8 : CHARACTER*8 CINDEX((IND2-IND1+1)*5) 9 : INTEGER INDEX((IND2-IND1+1)*5) 10 : ENDSEGMENT 11 : ISTAT=1 12 : READ(33,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2 13 : if (iostat.ne.0) goto 1000 14 : ISTAT=0 15 : SEGINI SINDEX 16 : J=1 17 : DO 1 I=IND1,IND2 18 : READ(33,REC=I,FMT=101,IOSTAT=IOSTAT) 19 : * (CINDEX(J+K-1),INDEX(J+K-1),K=1,5) 20 : if (iostat.ne.0) goto 1000 21 : J=J+5 22 : 1 CONTINUE 23 : NINDEX=J-1 24 : IUTINO=NINDEX 25 : IRET='9999' 26 : READ(37,REC=1,FMT=100,IOSTAT=IOSTAT)IND11,IND21 27 : if (iostat.ne.0) goto 1000 28 : IND2=IND2 + IND21+1 29 : IND1 = IND1 + IND11 30 : SEGADJ SINDEX 31 : DO 18 I=IND11,IND21 32 : READ(37,REC=I,FMT=101,IOSTAT=IOSTAT) 33 : * (CINDEX(J+K-1),INDEX(J+K-1),K=1,5) 34 : if (iostat.ne.0) goto 1000 35 : J=J+5 36 : 18 CONTINUE 37 : NINDEX=J-1 38 : 1000 RETURN 39 : ENTRY INFOPO(IAREA,IRET) 40 : IRET='0' 41 : IF (ISTAT.NE.0)RETURN 42 : IF (IAREA(1:8).EQ.' ') GOTO 11 43 : DO 10 I=NINDEX,1,-1 44 : IF(CINDEX(I).EQ.IAREA(1:8))GO TO 15 45 : 10 CONTINUE 46 : 11 CONTINUE 47 : IRET='9999' 48 : RETURN 49 : 15 CONTINUE 50 : IF(I.LE.IUTINO) THEN 51 : IULENO=33 52 : ELSE 53 : IULENO=37 54 : ENDIF 55 : LINDEX=INDEX(I)+1 56 : RETURN 57 : ENTRY INFOLI(IAREA,IRET) 58 : IRET='9999' 59 : IF (ISTAT.NE.0) RETURN 60 : IRET='0' 61 : READ(IULENO,REC=LINDEX,FMT=102,IOSTAT=IOSTAT) IAREA 62 : if (iostat.ne.0) goto 1000 63 : IF(IAREA(1:4).EQ.'$$$$') IRET='9999' 64 : LINDEX=LINDEX+1 65 : RETURN 66 : 100 FORMAT (2I6) 67 : 101 FORMAT(5(A8,I6)) 68 : 102 FORMAT(A72) 69 : END 70 : 71 :
© Cast3M 2003 - All rights reserved.
Disclaimer