1 : C TRBAC SOURCE CHAT 12/06/07 21:16:11 7388 2 : SUBROUTINE TRBAC 3 : IMPLICIT INTEGER(I-N) 4 : -INC CCOPTIO 5 : -INC SMBLOC 6 : -INC CCNOYAU 7 : SEGMENT MTTE 8 : CHARACTER*600 PHRA 9 : CHARACTER*72 TRA 10 : CHARACTER*8 NOM 11 : INTEGER INDI 12 : ENDSEGMENT 13 : POINTEUR MTT1.MTTE 14 : CHARACTER*8 FORM 15 : SEGINI MTTE 15 : CALL TRBAC1(MTTE) 16 : MBCOAN= MBCOUR 17 : 1 CONTINUE 18 : IXE=0 19 : IYE=0 20 : IF(MBLSUP.NE.0) THEN 21 : DO 105 I=1,INDI 22 : IF ( PHRA (I:I).NE.'#') GO TO 105 23 : DO 106 K=I+1,INDI 24 : IF(PHRA(K:K).EQ. ' ') GO TO 107 25 : J=K 26 : 106 CONTINUE 27 : 107 J1=J-I 28 : TRA=' ' 29 : TRA(1:2)='(I' 30 : WRITE(TRA(3:5),FMT='(I3)')J1 31 : TRA(6:6)=')' 32 : READ(PHRA(I+1:J),FMT=TRA) IYA 33 : IF(IYA.LT.IYE) GO TO 105 34 : IXE=I 35 : IXF=J 36 : IYE=IYA 37 : 105 CONTINUE 38 : IF(IXE.NE.0) THEN 39 : SEGINI MTT1 40 : MTXBLC=MTXBL 41 : if(mbcour.eq.0) mbcour = ninstv 42 : MBCOUR=MBCOUR-1 43 : NBNOMM=LMTXBM(MBCOUR+1)- LMTXBM(MBCOUR) 44 : IPVINT=MTXBA(MBCOUR+1)-MTXBA(MBCOUR) 45 : IDEF= LMTXBM(MBCOUR) 46 : DO 103 I=1,NBNOMM 47 : if( mtxblb(i+idef). ge . 0) then 48 : ITANO1(I)=MTXBLB(I+IDEF) +mdeobj -1 49 : else 50 : ITANO1(I)=MTXBLB(I+IDEF)/(-100) 51 : endif 52 : ITANOM(I)=MTXBLM(I+IDEF) 53 : C ITANO1(I)=MTXBLB(I) 54 : C ITANOM(I)=MTXBLM(I) 55 : 103 CONTINUE 56 : IDEF=MTXBA(MBCOUR) 57 : DO 104 I=1,IPVINT 58 : if( mtxbla(i+idef).gt.0) then 59 : ITINTE(I)=MTXBLA(I+IDEF) +mdeobj -1 60 : elseif(mtxbla(i+idef).lt.-99) then 61 : ITINTE(I)=MTXBLA(I+IDEF)/(-100) 62 : else 63 : ITINTE(I)=MTXBLA(I+IDEF) 64 : endif 65 : C ITINTE(I)=MTXBLA(I) 66 : 104 CONTINUE 67 : C SEGDES MTXBLL 67 : CALL TRBAC1(MTT1) 68 : PHRA(IXE:IXE)='(' 69 : ILO = INDI-IXF 70 : IDD= IXE + MTT1.INDI+1 71 : IF(ILO.NE.0) THEN 72 : DO 108 K=ILO,1,-1 73 : PHRA(IDD+K:IDD+K)=PHRA(IXF+K:IXF+K) 74 : 108 CONTINUE 75 : ENDIF 76 : IND1=MTT1.INDI 77 : PHRA(IXE+1:IDD-1)= MTT1.PHRA(1:IND1) 78 : PHRA(IDD:IDD)=')' 79 : INDI=IDD+ILO+1 80 : SEGSUP MTT1 81 : GO TO 1 82 : ENDIF 83 : ENDIF 84 : MBCOUR=MBCOAN 85 : FORM = '(1X,A' 86 : IIA = MIN(INDI,72) 87 : WRITE(FORM(6:7),FMT='(I2)')IIA 88 : FORM(8:8)=')' 89 : WRITE(IOIMP,FMT=FORM) PHRA(1:INDI) 90 : SEGSUP MTTE 91 : RETURN 92 : END 93 : 94 : 95 :
© Cast3M 2003 - All rights reserved.
Disclaimer