1 : C EXTR15 SOURCE CHAT 11/03/16 21:21:44 6902 2 : SUBROUTINE EXTR15(IPMODL,IPCHE1,IPLSTM) 3 : *_____________________________________________________________________ 4 : * 5 : * Extrait les composantes d'un MCHAML 6 : * 7 : * Entrees : 8 : * --------- 9 : * 10 : * IPMODL Pointeur sur un MMODEL 11 : * IPCHE1 Pointeur sur un MCHAML 12 : * 13 : * Sortie : 14 : * -------- 15 : * IPLSTM Pointeur sur un LISTMOTS 16 : * 17 : * JM CAMPENON le 07/91 18 : *_____________________________________________________________________ 19 : * 20 : IMPLICIT INTEGER(I-N) 21 : IMPLICIT REAL*8(A-H,O-Z) 22 : * 23 : -INC CCOPTIO 24 : -INC SMCHAML 25 : -INC SMMODEL 26 : -INC SMLMOTS 27 : * 28 : SEGMENT MTR1 29 : INTEGER IPT(0) 30 : ENDSEGMENT 31 : * 32 : IPLSTM=0 33 : JGN=4 34 : JGM=0 35 : MMODEL=IPMODL 36 : SEGACT MMODEL 37 : NSOUS=KMODEL(/1) 38 : * 39 : MCHELM=IPCHE1 40 : SEGACT MCHELM 41 : * 42 : SEGINI MTR1 43 : * 44 : DO 100 ISOUS=1,NSOUS 45 : IMODEL=KMODEL(ISOUS) 46 : SEGACT IMODEL 47 : IPMAIL=IMAMOD 48 : * 49 : DO 200 IA=1,ICHAML(/1) 50 : IF (IMACHE(IA).EQ.IPMAIL.AND.CONCHE(IA).EQ.CONMOD) GOTO 300 51 : 200 CONTINUE 52 : * 53 : * Pas de sous zone dans le MCHAML qui corresponde au MMODEL 54 : * 54 : CALL ERREUR(472) 55 : SEGSUP MTR1 56 : GOTO 555 57 : * 58 : 300 CONTINUE 59 : MCHAML=ICHAML(IA) 60 : SEGACT MCHAML 61 : NCOMP=NOMCHE(/2) 62 : JGM=JGM+NCOMP 63 : IPT(**)=IA 64 : 100 CONTINUE 65 : SEGINI MLMOTS 66 : IPLSTM=MLMOTS 67 : * 68 : IMEM=0 69 : DO 150 ISOUS=1,IPT(/1) 70 : MCHAML=ICHAML(IPT(ISOUS)) 71 : NCOMP=NOMCHE(/2) 72 : * 73 : DO 400 ICOMP=IMEM+1,IMEM+NCOMP 74 : MOTS(ICOMP)=NOMCHE(ICOMP-IMEM) 75 : 400 CONTINUE 76 : IMEM=IMEM+NCOMP 77 : SEGDES MCHAML 78 : 150 CONTINUE 79 : * 80 : 555 CONTINUE 81 : SEGDES IMODEL 82 : SEGDES MMODEL 83 : SEGDES MCHELM 84 : RETURN 85 : END 86 : 87 : 88 : 89 : 90 : 91 : 92 :
© Cast3M 2003 - All rights reserved.
Disclaimer