C ADCHAM SOURCE CB215821 20/11/04 21:15:04 10766 SUBROUTINE ADCHAM (IPCHA2,IPCHA,XX) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) CHARACTER*16 TYPCH1,TYPCH2 *_______________________________________________________________________ * * ROUTINE EXECUTANT L'ADDITION DES COMPOSANTE DE 2 MCHAML * * ENTREES : * IPCHA : POINTEUR SUR UN SEGMENT MCHAML SUPPOSE ACTIF * IPCHA2 : POINTEUR SUR 2IEME SEGMENT MCHAML SUPPOSE ACTIF * XX : COEFFICIENT MULTIPLICATEUR sur le 2nd * * * SORTIE : * IPCHA : POINTEUR SUR UN SEGMENT MCHAML RESULTAT SUPPOSE ACTI * = 0 SI PB * * PASSAGE AUX NOUVEAU CHAMELEM PAR JM CAMPENON LE 01/91 * *_______________________________________________________________________ * -INC SMCHAML -INC PPARAM -INC CCOPTIO * MCHAML=IPCHA MCHAM2=IPCHA2 * ON CHERCHE LES NOM DE COMPOSANTES EN COMMUN DANS LES * 2 CHAMELEMS * DO 1 ICOMP=1,IELVAL(/1) CALL PLACE(MCHAM2.NOMCHE,MCHAM2.NOMCHE(/2),IPLAC, & NOMCHE(ICOMP)) IF (IPLAC.NE.0) THEN C On verifie que les composantes trouvees sont du meme type TYPCH1=MCHAML.TYPCHE(ICOMP) TYPCH2=MCHAM2.TYPCHE(IPLAC) IF (TYPCH1.NE.TYPCH2) THEN MOTERR(1:4)=MCHAML.NOMCHE(ICOMP) MOTERR(5:21)=TYPCH1 MOTERR(22:38)=TYPCH2 CALL ERREUR (917) IPCHA=0 RETURN ENDIF C ICOD=0/1/2/3 en fonction du type des composantes IPMEL1=IELVAL(ICOMP) IPMEL2=MCHAM2.IELVAL(IPLAC) ICOD=0 IF (TYPCHE(ICOMP).EQ.'POINTEURLISTREEL') ICOD=1 IF (TYPCHE(ICOMP).EQ.'POINTEURPOINT ') ICOD=2 IF (TYPCHE(ICOMP).EQ.'POINTEUREVOLUTIO') ICOD=3 * CALL ADCHVE(IPMEL1,IPMEL2,XX,ICOD,IPMELV,IRETOU) MELVA1=IPMEL1 MELVA1=IPMEL2 IF (IRETOU.NE.0) THEN IF (IRETOU.EQ.197) MOTERR(1:4)=NOMCHE(ICOMP) CALL ERREUR (IRETOU) IPCHA=0 RETURN ENDIF IELVAL(ICOMP)=IPMELV ELSE MELVA1=IELVAL(ICOMP) SEGINI,MELVAL=MELVA1 IELVAL(ICOMP)=MELVAL ENDIF 1 CONTINUE * * ON RAJOUTE LES COMPOSANTES DU 2IEME CHAMELEM QUI NE SONT PAS * ENCORE PRIS EN COMPTE (LE NUMERO DE LA SOUS ZONE EST DONNE * JTAFF(ISOUS1) * N22=IELVAL(/1) DO 2 ICOMP=1,MCHAM2.IELVAL(/1) CALL PLACE(NOMCHE,N22,IPLAC,MCHAM2.NOMCHE(ICOMP)) IF (IPLAC.EQ.0) THEN N2=IELVAL(/1) N2=N2+1 SEGADJ MCHAML NOMCHE(N2)=MCHAM2.NOMCHE(ICOMP) TYPCH2=MCHAM2.TYPCHE(ICOMP) TYPCHE(N2)=TYPCH2 MELVA2=MCHAM2.IELVAL(ICOMP) SEGINI,MELVAL=MELVA2 IELVAL(N2)=MELVAL cbp,2020 prise en compte de XX --> appel a MULMEL IF(XX.NE.1.D0) THEN CALL MULMEL(MELVAL,XX,TYPCH2) ENDIF ENDIF 2 CONTINUE * 9990 CONTINUE END