1 : C EXCOC1 SOURCE PV 11/04/08 21:15:52 6936 2 : SUBROUTINE EXCOC1(IPCH1,MOT,IPCH2,MOT2,IVID) 3 : *----------------------------------------------------------------------- 4 : * EXTRACTION D UNE COMPOSANTE D UN NOUVEAU CHAMELEM 5 : * ROUTINE APPELLEE PAR L OPERATEUR EXCOMP 6 : * ENTREE 7 : * IPCH1= POINTEUR SUR UN CHAMELEM 8 : * MOT = NOM DE LA COMPOSANTE A EXTRAIRE 9 : * MOT2 = NOM DE LA COMPOSANTE 10 : * IVID = 1 SI ON A LU LE MOT 'NOID', 0 SINON 11 : * SORTIE 12 : * IPCH2= POINTEUR SUR LE CHPOINT CONTENANT UNIQUEMENT LA 13 : * COMPOSANTE MOT2 14 : *----------------------------------------------------------------------- 15 : IMPLICIT INTEGER(I-N) 16 : IMPLICIT REAL*8(A-H,O-Z) 17 : CHARACTER*4 MOT,MOT2 18 : CHARACTER*8 LEMOT 19 : -INC SMCHAML 20 : -INC CCOPTIO 21 : * 22 : SEGMENT MTRI 23 : INTEGER IPOI(n1l) 24 : ENDSEGMENT 25 : SEGMENT MTRA 26 : INTEGER LRAN(n1l) 27 : ENDSEGMENT 28 : SEGMENT MTRB 29 : CHARACTER*16 TYPT(n1l) 30 : ENDSEGMENT 31 : * 32 : MCHEL1=IPCH1 33 : SEGACT MCHEL1 34 : NZON1=MCHEL1.ICHAML(/1) 35 : * 36 : * INITIALISATION DES SEGMENTS DE TRAVAIL 37 : * 38 : n1=0 39 : n1l=500 40 : SEGINI MTRI,MTRA,MTRB 41 : * 42 : * BOUCLE SUR LES ZONES 43 : * 44 : DO 100 IA=1,NZON1 45 : MCHAM1=MCHEL1.ICHAML(IA) 46 : SEGACT MCHAM1 47 : NCP=MCHAM1.NOMCHE(/2) 48 : DO 110 IB=1,NCP 49 : LEMOT=MCHAM1.NOMCHE(IB) 50 : IF (MOT.EQ.LEMOT(1:4)) THEN 51 : IBCOM=IB 52 : GOTO 120 53 : ENDIF 54 : 110 CONTINUE 55 : *pv SEGDES MCHAM1 56 : GOTO 100 57 : * 58 : 120 CONTINUE 59 : MELVA1=MCHAM1.IELVAL(IBCOM) 60 : SEGACT MELVA1 61 : SEGINI,MELVAL=MELVA1 62 : *pv SEGDES MELVA1 63 : n1=n1+1 64 : if (n1.gt.n1l) then 65 : n1l=n1l+500 66 : segadj mtri,mtra,mtrb 67 : endif 68 : IPOI(n1)=MELVAL 69 : LRAN(n1)=IA 70 : TYPT(n1)=MCHAM1.TYPCHE(IBCOM) 71 : *pv SEGDES MELVAL,MCHAM1 72 : SEGDES MELVAL 73 : 100 CONTINUE 74 : * 75 : * ON REMPLIT LE CHAMELEM 76 : * 77 : L1=mchel1.titche(/1) 78 : *** N1=IPOI(/1) 79 : N3=MCHEL1.INFCHE(/2) 80 : N2=1 81 : * 82 : IF (N1.EQ.0) THEN 83 : IF (IVID.EQ.1) THEN 84 : SEGINI MCHELM 85 : IPCH2 = MCHELM 86 : TITCHE= mchel1.titche 87 : IFOCHE=MCHEL1.IFOCHE 88 : *pv SEGDES MCHELM 89 : SEGDES MCHELM 90 : ELSE 91 : MOTERR(1:4)=MOT 91 : CALL ERREUR(236) 92 : ENDIF 93 : GOTO 666 94 : ENDIF 95 : * 96 : * CREATION DU CHAPEAU DU CHAMELEM 97 : * 98 : SEGINI MCHELM 99 : IPCH2=MCHELM 100 : TITCHE=mchel1.titche 101 : IFOCHE=MCHEL1.IFOCHE 102 : * 103 : * BOUCLE SUR LES ZONES 104 : * 105 : DO 400 IA=1,N1 106 : IACON=LRAN(IA) 107 : DO 401 IAA=1,N3 108 : INFCHE(IA,IAA)=MCHEL1.INFCHE(IACON,IAA) 109 : 401 CONTINUE 110 : IMACHE(IA)=MCHEL1.IMACHE(IACON) 111 : CONCHE(IA)=MCHEL1.CONCHE(IACON) 112 : SEGINI,MCHAML 113 : ICHAML(IA)=MCHAML 114 : LEMOT(1:4)=MOT2 115 : NOMCHE(1)=LEMOT 116 : TYPCHE(1)=TYPT(IA) 117 : IELVAL(1) = IPOI(IA) 118 : *pv SEGDES,MCHAML 119 : SEGDES,MCHAML 120 : 400 CONTINUE 121 : *pv SEGDES MCHELM 122 : SEGDES MCHELM 123 : * 124 : 666 CONTINUE 125 : * 126 : * SUPPRESSION DES SEGMENTS DE TRAVAIL 127 : * 128 : SEGSUP MTRI,MTRA,MTRB 129 : *pv SEGDES MCHEL1 130 : RETURN 131 : END 132 : 133 : 134 : 135 : 136 : 137 : 138 : 139 : 140 :
© Cast3M 2003 - All rights reserved.
Disclaimer