1 : C EXTR35 SOURCE CHAT 11/03/16 21:21:45 6902 2 : SUBROUTINE EXTR35(IPMODL,IPCHE1,IPLSTM) 3 : *_____________________________________________________________________ 4 : * 5 : * Extrait les constituants 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 : IPT(**)=IA 60 : SEGDES IMODEL 61 : 100 CONTINUE 62 : SEGINI MLMOTS 63 : IPLSTM=MLMOTS 64 : * 65 : DO 40 K=1,IPT(/1) 65 : if (conche(ipt(k))(1:4).eq.' ') call erreur (-328) 66 : if (jgm.gt.0) then 67 : DO 50 J=1,JGM 68 : IF (MOTS(J).EQ.CONCHE(K)(1:4)) GOTO 40 69 : 50 CONTINUE 70 : JGM=JGM+1 71 : SEGADJ MLMOTS 72 : MOTS(JGM)=CONCHE(ipt(k))(1:4) 73 : else 74 : jgm = 1 75 : segadj mlmots 76 : mots(jgm) = conche(ipt(k))(1:4) 77 : endif 78 : 40 CONTINUE 79 : 80 : SEGDES MMODEL 81 : SEGDES MCHELM 82 : RETURN 83 : * 84 : 555 CONTINUE 85 : SEGDES IMODEL 86 : SEGDES MMODEL 87 : SEGDES MCHELM 88 : RETURN 89 : END 90 : 91 : 92 : 93 : 94 : 95 : 96 : 97 : 98 :
© Cast3M 2003 - All rights reserved.
Disclaimer