Télécharger la plaquette Cast3M


fr en

Télécharger adcham.eso

Retour à la liste

Numérotation des lignes : 

adcham

  1. C ADCHAM    SOURCE    CB215821  20/11/04    21:15:04     10766          
  2.       SUBROUTINE ADCHAM (IPCHA2,IPCHA,XX)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5.       CHARACTER*16 TYPCH1,TYPCH2
  6. *_______________________________________________________________________
  7. *
  8. *         ROUTINE EXECUTANT L'ADDITION DES COMPOSANTE DE 2 MCHAML
  9. *
  10. *  ENTREES :
  11. *        IPCHA    : POINTEUR SUR UN SEGMENT MCHAML SUPPOSE ACTIF
  12. *        IPCHA2   : POINTEUR SUR 2IEME SEGMENT MCHAML SUPPOSE ACTIF
  13. *        XX       : COEFFICIENT MULTIPLICATEUR sur le 2nd
  14. *
  15. *
  16. *  SORTIE :
  17. *        IPCHA    : POINTEUR SUR UN SEGMENT MCHAML RESULTAT SUPPOSE ACTI
  18. *                 = 0 SI PB
  19. *
  20. *  PASSAGE AUX NOUVEAU CHAMELEM PAR JM CAMPENON LE 01/91
  21. *
  22. *_______________________________________________________________________
  23. *
  24. -INC SMCHAML
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. *
  29.       MCHAML=IPCHA
  30.       MCHAM2=IPCHA2
  31. *     ON CHERCHE LES NOM DE COMPOSANTES EN COMMUN DANS LES
  32. *     2 CHAMELEMS
  33. *
  34.       DO 1 ICOMP=1,IELVAL(/1)
  35.          CALL PLACE(MCHAM2.NOMCHE,MCHAM2.NOMCHE(/2),IPLAC,
  36.      &               NOMCHE(ICOMP))
  37.          IF (IPLAC.NE.0) THEN
  38. C           On verifie que les composantes trouvees sont du meme type
  39.             TYPCH1=MCHAML.TYPCHE(ICOMP)
  40.             TYPCH2=MCHAM2.TYPCHE(IPLAC)
  41.             IF (TYPCH1.NE.TYPCH2) THEN
  42.                MOTERR(1:4)=MCHAML.NOMCHE(ICOMP)
  43.                MOTERR(5:21)=TYPCH1
  44.                MOTERR(22:38)=TYPCH2
  45.                CALL ERREUR (917)
  46.                IPCHA=0
  47.                RETURN
  48.             ENDIF
  49. C           ICOD=0/1/2/3 en fonction du type des composantes
  50.             IPMEL1=IELVAL(ICOMP)
  51.             IPMEL2=MCHAM2.IELVAL(IPLAC)
  52.             ICOD=0
  53.             IF (TYPCHE(ICOMP).EQ.'POINTEURLISTREEL') ICOD=1
  54.             IF (TYPCHE(ICOMP).EQ.'POINTEURPOINT   ') ICOD=2
  55.             IF (TYPCHE(ICOMP).EQ.'POINTEUREVOLUTIO') ICOD=3
  56. *
  57.             CALL ADCHVE(IPMEL1,IPMEL2,XX,ICOD,IPMELV,IRETOU)
  58.             MELVA1=IPMEL1
  59.             MELVA1=IPMEL2
  60.             IF (IRETOU.NE.0) THEN
  61.                IF (IRETOU.EQ.197) MOTERR(1:4)=NOMCHE(ICOMP)
  62.                CALL ERREUR (IRETOU)
  63.                IPCHA=0
  64.                RETURN
  65.             ENDIF
  66.             IELVAL(ICOMP)=IPMELV
  67.          ELSE
  68.             MELVA1=IELVAL(ICOMP)
  69.             SEGINI,MELVAL=MELVA1
  70.             IELVAL(ICOMP)=MELVAL
  71.          ENDIF
  72.  1    CONTINUE
  73. *
  74. *     ON RAJOUTE LES COMPOSANTES DU 2IEME CHAMELEM QUI NE SONT PAS
  75. *     ENCORE PRIS EN COMPTE (LE NUMERO DE LA SOUS ZONE EST DONNE
  76. *     JTAFF(ISOUS1)
  77. *
  78.       N22=IELVAL(/1)
  79.       DO 2 ICOMP=1,MCHAM2.IELVAL(/1)
  80.          CALL PLACE(NOMCHE,N22,IPLAC,MCHAM2.NOMCHE(ICOMP))
  81.          IF (IPLAC.EQ.0) THEN
  82.             N2=IELVAL(/1)
  83.             N2=N2+1
  84.             SEGADJ MCHAML
  85.             NOMCHE(N2)=MCHAM2.NOMCHE(ICOMP)
  86.             TYPCH2=MCHAM2.TYPCHE(ICOMP)
  87.             TYPCHE(N2)=TYPCH2
  88.             MELVA2=MCHAM2.IELVAL(ICOMP)
  89.             SEGINI,MELVAL=MELVA2
  90.             IELVAL(N2)=MELVAL
  91. cbp,2020    prise en compte de XX --> appel a MULMEL
  92.             IF(XX.NE.1.D0) THEN
  93.               CALL MULMEL(MELVAL,XX,TYPCH2)
  94.             ENDIF
  95.          ENDIF
  96.  2    CONTINUE
  97. *
  98.  9990 CONTINUE
  99.       END
  100.  
  101.  
  102.  
  103.  
  104.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales