1 : C EXTR37 SOURCE PV 09/03/12 21:22:10 6325 2 : SUBROUTINE EXTR37(MCHELM,MLMOTS) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : *----------------------------------------------------------------------- 6 : * 7 : * E X T R 37 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * EXTRAIT LES NOMS DES constituants D'UN MCHAML 14 : * ET LES RANGE DANS UN LISTMOTS MLMOTS 15 : * signale les constituants 'nombre' 16 : * 17 : * MODULES UTILISES: 18 : * ----------------- 19 : * 20 : -INC SMCHAML 21 : -INC SMLMOTS 22 : * 23 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 24 : * ----------- 25 : * 26 : * MCHELM (E) POINTEUR SUR LE MCHAML 27 : * MLMOTS (S) POINTEUR SUR LE LISTMOTS 28 : * 29 : *----------------------------------------------------------------------- 30 : * 31 : * 32 : SEGACT MCHELM 33 : JGN=4 34 : JGM=0 35 : SEGINI MLMOTS 36 : IF (IMACHE(/1).EQ.0) GO TO 90 37 : * 38 : JGM = 1 39 : SEGADJ MLMOTS 39 : if (conche(1)(1:4).eq.' ') call erreur (-328) 40 : MOTS(JGM) = CONCHE(1)(1:4) 41 : * 42 : IF (IMACHE(/1).NE.1) THEN 43 : DO 40 K=2,IMACHE(/1) 43 : if (conche(k)(1:4).eq.' ') call erreur (-328) 44 : DO 50 J=1,JGM 45 : IF (MOTS(J).EQ.CONCHE(K)(1:4)) GOTO 40 46 : 50 CONTINUE 47 : JGM=JGM+1 48 : SEGADJ MLMOTS 49 : MOTS(JGM)=CONCHE(K)(1:4) 50 : 40 CONTINUE 51 : ENDIF 52 : * 53 : 90 SEGDES MLMOTS,MCHELM 54 : RETURN 55 : END 56 : 57 : 58 : 59 : 60 :
© Cast3M 2003 - All rights reserved.
Disclaimer