1 : C INIPRO SOURCE FANDEUR 13/01/16 21:15:20 7666 2 : 3 : SUBROUTINE INIPRO (cnompr,mbloT) 4 : IMPLICIT INTEGER(I-N) 5 : -INC CCOPTIO 6 : -INC SMBLOC 7 : -INC CCNOYAU 8 : -INC CCASSIS 9 : CHARACTER*8 MOBLO,ichp,cnompr 10 : LOGICAL IPREM,IDEU 11 : SEGMENT ITTRAM 12 : INTEGER IJTRAM(NHU) 13 : ENDSEGMENT 14 : DATA MOBLO/'BLOC '/ 15 : 16 : if(iimpi.eq.1754) then 17 : write(ioimp,*) ' initialisation de la procedur ', cnompr 18 : endif 19 : if(nbesc.ne.0) segact ipiloc 20 : NHU=IPCHAR(/1) 21 : SEGINI ITTRAM 22 : IDE1 = 1 23 : * IDE2 = MFIOBJ +1 24 : IFI1 = MDEOBJ-1 25 : * IFI2 = INOOB1(/1) 26 : IPREM =.TRUE. 27 : IF(MDEOBJ.EQ.1) IPREM=.FALSE. 28 : * IDEU=.TRUE. 29 : * IF(MFIOBJ.EQ.IFI2) IDEU = .FALSE. 30 : * IF(IDEU) THEN 31 : * DO 3 J=IDE2,IFI2 32 : * INO=INOOB1(J) 33 : * IF (INO.NE.0) IJTRAM(INO)= J 34 : * 3 CONTINUE 35 : * ENDIF 36 : IF( IPREM) THEN 37 : DO 2 J=IDE1,IFI1 38 : INO=INOOB1(J) 39 : IJTRAM(INO)= J 40 : 2 CONTINUE 41 : ENDIF 42 : DO 1 I=MDEOBJ,MFIOBJ 43 : INO= INOOB1(I) 44 : IDEBCH=IPCHAR(INO) 45 : IFINCH=IPCHAR(INO+1)-1 46 : IF ( ICHARA(IDEBCH:IDEBCH).EQ.'!') THEN 47 : INOOB2(I)='ANNULE' 48 : GO TO 1 49 : ENDIF 50 : IF ( ICHARA(IDEBCH:IFINCH).EQ.' ') GO TO 1 51 : * if( ICHARA(IDEBCH:IFINCH).EQ.cnompr) then 52 : * inoob2(i)='PROCEDUR' 53 : * iouep2(i)= 54 : * go to 1 55 : * endif 56 : IF(INOOB2(I).EQ.MOBLO) GO TO 1 57 : if(inoob2(i).eq.'PROCEDUR') go to 1 58 : IF(IJTRAM(INO).NE.0) THEN 59 : J=IJTRAM(INO) 60 : ichp=INOOB2(I) 61 : INOOB2(I)=INOOB2(J) 62 : IOUEP2(I)=IOUEP2(J) 63 : if (iimpi.eq.1754) then 64 : write(ioimp,*)'initialisation ',ICHARA(IDEBCH:IFINCH),' ', 65 : $ INOOB2(I),' ',ichp,iouep2(i) 66 : endif 67 : ENDIF 68 : 1 CONTINUE 69 : if(nbesc.ne.0) segdes ipiloc 70 : SEGSUP ITTRAM 71 : RETURN 72 : END 73 : 74 :
© Cast3M 2003 - All rights reserved.
Disclaimer