Télécharger adcham.eso

Retour à la liste

Numérotation des lignes :

  1. C ADCHAM SOURCE BP208322 20/02/21 21:15:01 10529
  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 PLAMO8(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 PLAMO8(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.  

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