Sources Esope | Cast3M

adcham
C ADCHAM    SOURCE    SP204843  24/10/25    21:15:02     12048          
      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 (IERR.NE.0) RETURN
         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)
            IF (IERR.NE.0) RETURN
            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 (IERR.NE.0) RETURN
         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)
              IF (IERR.NE.0) RETURN
            ENDIF
         ENDIF
 2    CONTINUE
*
 9990 CONTINUE
      END