1 : C PROCPN SOURCE CHAT 11/05/04 21:17:53 6963 2 : SUBROUTINE PROCPN(IAREA,IRET) 3 : IMPLICIT INTEGER(I-N) 4 : -INC CCOPTIO 5 : SAVE LINDEX,ISTAT,IULEPR,ISTAT2 6 : CHARACTER*(*) IAREA,IRET 7 : DIMENSION INDEX (6) 8 : DIMENSION NAME(2) 9 : CHARACTER*8 INDIX (6) 10 : SEGMENT MUTIL 11 : CHARACTER*8 MNOM(LLON),MDOUB(LLON) 12 : ENDSEGMENT 13 : MUTIL=0 14 : IJKL=0 15 : IDEJA=0 16 : ISTAT=1 17 : READ(34,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2 18 : if (iostat.ne.0) goto 1000 19 : LLON=(IND2-IND1+1 )*5 20 : SEGINI MUTIL 21 : ISTAT=0 22 : DO 1 I=IND1,IND2 23 : READ(34,REC=I,FMT=101,IOSTAT=IOSTAT)(INDIX(K),INDEX(K),K=1,5) 24 : if (iostat.ne.0) goto 9998 25 : DO 2 K=1,5 26 : IJKL=IJKL+1 27 : MNOM(IJKL)=INDIX(K) 28 : if(indix(k).ne.' ')then 28 : CALL NOMOBJ('PROCEDUR',INDIX(K),-INDEX(K)) 29 : * write(6,*) ' nomobj 1 de la procedur ' , indix(k) 30 : endif 31 : 2 CONTINUE 32 : 1 CONTINUE 33 : ISTAT2=1 34 : READ(36,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2 35 : if (iostat.ne.0) goto 9998 36 : ISTAT2=0 37 : DO 3 I=IND1,IND2 38 : READ(36,REC=I,FMT=101,IOSTAT=IOSTAT)(INDIX(K),INDEX(K),K=1,5) 39 : if (iostat.ne.0) goto 9998 40 : DO 4 K=1,5 41 : IF(INDIX(K).EQ.' ' ) GO TO 4 42 : DO 40 LIOP=1,IJKL 43 : IF(MNOM(LIOP).EQ.INDIX(K)) THEN 44 : IDEJA=IDEJA+1 45 : MDOUB(IDEJA)=INDIX(K) 46 : GO TO 41 47 : ENDIF 48 : 40 CONTINUE 49 : 41 CONTINUE 50 : IQQ = -(INDEX(K)+1000000) 51 : if( indix(k).ne.' ') then 52 : * write(6,*) ' nomobj 2 de la procedur ' , indix(k) 52 : CALL NOMOBJ('PROCEDUR',INDIX(K),IQQ) 53 : endif 54 : 4 CONTINUE 55 : 3 CONTINUE 56 : IF(IDEJA.NE.0) THEN 56 : CALL ERREUR (-302) 57 : DO 42 IKL = 1,IDEJA,4 58 : MOTERR=' ' 59 : IFI=MIN(IKL+3,IDEJA)-IKL +1 60 : DO 43 ILK=1,IFI 61 : MOTERR((ILK-1)*9+2:ILK*9)=MDOUB(IKL-1+ILK) 62 : 43 CONTINUE 63 : WRITE(IOIMP,*) MOTERR(1:40) 64 : 42 CONTINUE 65 : ENDIF 66 : IRET='9999' 67 : 9998 CONTINUE 68 : IF(MUTIL.NE.0) SEGSUP MUTIL 69 : 1000 RETURN 70 : ENTRY PROCPO(JINDEX,IRET) 71 : IRET='0' 72 : IF (ISTAT*ISTAT2.EQ.1) RETURN 73 : IULEPR=34 74 : LINDEX=JINDEX+1 75 : IF(JINDEX.GT.1000000) THEN 76 : IULEPR=36 77 : LINDEX=JINDEX+1 -1000000 78 : ENDIF 79 : IRET='9999' 80 : RETURN 81 : ENTRY PROCLI(IAREA,IRET) 82 : IRET='9999' 83 : IF (ISTAT*ISTAT2.EQ.1) RETURN 84 : IRET='0' 85 : READ(IULEPR,REC=LINDEX,FMT=102,IOSTAT=IOSTAT)IAREA 86 : if (iostat.ne.0) goto 1000 87 : IF(IAREA(1:4).EQ.'$$$$')IRET='9999' 88 : LINDEX=LINDEX+1 89 : RETURN 90 : ENTRY PROCL2(IAREA,IRET) 91 : IRET='0' 92 : IF(ISTAT2.NE.0) go to 12 93 : READ(36,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2 94 : if (iostat.ne.0) goto 1000 95 : DO 110 I=IND1,IND2 96 : READ(36,REC=I,FMT=101,IOSTAT=IOSTAT)(INDIX(K),INDEX(K),K=1,5) 97 : if (iostat.ne.0) goto 1000 98 : DO 220 K=1,5 99 : IF(INDIX(K).EQ.IAREA(1:8)) THEN 100 : IRET='9998' 101 : LINDEX=INDEX(K)+1 102 : IULEPR=36 103 : GO TO 10 104 : ENDIF 105 : 220 CONTINUE 106 : 110 CONTINUE 107 : 12 CONTINUE 108 : IF (ISTAT.NE.0) return 109 : READ(34,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2 110 : if (iostat.ne.0) goto 1000 111 : DO 11 I=IND1,IND2 112 : READ(34,REC=I,FMT=101,IOSTAT=IOSTAT)(INDIX(K),INDEX(K),K=1,5) 113 : if (iostat.ne.0) goto 1000 114 : DO 22 K=1,5 115 : IF(INDIX(K).EQ.IAREA(1:8)) THEN 116 : IRET='9999' 117 : LINDEX=INDEX(K)+1 118 : IULEPR=34 119 : GO TO 10 120 : ENDIF 121 : 22 CONTINUE 122 : 11 CONTINUE 123 : 10 RETURN 124 : 100 FORMAT (2I6) 125 : 101 FORMAT(5(A8,I6)) 126 : 102 FORMAT(A72) 127 : END 128 : 129 : 130 : 131 : 132 : 133 : 134 : 135 :
© Cast3M 2003 - All rights reserved.
Disclaimer