mecham
C MECHAM SOURCE OF166741 24/10/03 21:15:25 12022 *--------------------------------------------------------------------* * * * Sous-programme de la directive MENAGE: nouveau CHAMELEM * * _______________________________________________________ * * * * Param}tres: * * * * es IPLIS pointeur sur le segment ISLIS ( suppose actif ) * * es IPOLAC pointeur sur le segment ICOLAC ( suppose actif ) * * * *--------------------------------------------------------------------* IMPLICIT INTEGER(I-N) -INC PPARAM -INC CCOPTIO -INC SMCHAML -INC TMCOLAC SEGMENT ISLIS(NP) SEGMENT ISEG(0) ISLIS = IPLIS ICOLAC = IPOLAC * * Cas du nouveau CHAMELEM : MCHAML * ITLACC = KCOLA(39) DO 10 I=1,ITLAC(/1) MCHELM = ITLAC(I) IF (MCHELM.NE.0) THEN ISLIS(( MCHELM-1)/npgcd)=1 SEGACT,MCHELM N3=INFCHE(/2) DO 20 J=1,ICHAML(/1) MCHAML = ICHAML(J) IF (MCHAML.NE.0) THEN ISLIS((MCHAML-1)/npgcd)=1 SEGACT,MCHAML ISEG=INFCHE(J,4) IF(ISEG.NE.0) THEN ISLIS((ISEG-1)/npgcd)=1 SEGDES ISEG ENDIF DO 30 K=1,IELVAL(/1) MELVAL = IELVAL(K) IF (MELVAL.NE.0) THEN ISLIS((MELVAL-1)/npgcd)=1 IF(TYPCHE(K)(1:8).EQ.'POINTEUR' .AND. * TYPCHE(K)(9:13).NE.'POINT' .AND. * TYPCHE(K)(9:15).NE.'LOGIQUE' .AND. * TYPCHE(K)(9:11).NE.'MOT' ) THEN SEGACT MELVAL NAL1=IELCHE(/1) NAL2=IELCHE(/2) DO 50 I1=1,NAL1 IF(ISEG.NE.0) THEN ISLIS((ISEG-1)/npgcd)=1 SEGDES ISEG ENDIF 50 CONTINUE * 40 CONTINUE * ENDIF SEGDES,MELVAL ENDIF 30 CONTINUE * END DO SEGDES,MCHAML ENDIF 20 CONTINUE * END DO SEGDES,MCHELM ENDIF 10 CONTINUE * END DO RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales