Télécharger adcham.eso

Retour à la liste

Numérotation des lignes :

  1. C ADCHAM SOURCE PV 09/03/12 21:15:08 6325
  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 SEGGMENT MCHAML SUPPOSE ACTIF
  13. * XX : COEFFICIENT MULTIPLICATEUR
  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. -INC CCOPTIO
  26. *
  27. MCHAML=IPCHA
  28. MCHAM2=IPCHA2
  29. * ON CHERCHE LES NOM DE COMPOSANTES EN COMMUN DANS LES
  30. * 2 CHAMELEMS
  31. *
  32. DO 1 ICOMP=1,IELVAL(/1)
  33. CALL PLACE (MCHAM2.NOMCHE,MCHAM2.NOMCHE(/2),IPLAC,
  34. & NOMCHE(ICOMP))
  35. IF (IPLAC.NE.0) THEN
  36. C On verifie que les composantes trouvees sont du meme type
  37. TYPCH1=MCHAML.TYPCHE(ICOMP)
  38. TYPCH2=MCHAM2.TYPCHE(IPLAC)
  39. IF (TYPCH1.NE.TYPCH2) THEN
  40. MOTERR(1:4)=MCHAML.NOMCHE(ICOMP)
  41. MOTERR(5:21)=TYPCH1
  42. MOTERR(22:38)=TYPCH2
  43. CALL ERREUR (917)
  44. IPCHA=0
  45. RETURN
  46. ENDIF
  47. C ICOD=0/1/2/3 en fonction du type des composantes
  48. IPMEL1=IELVAL(ICOMP)
  49. IPMEL2=MCHAM2.IELVAL(IPLAC)
  50. ICOD=0
  51. IF (TYPCHE(ICOMP).EQ.'POINTEURLISTREEL') ICOD=1
  52. IF (TYPCHE(ICOMP).EQ.'POINTEURPOINT ') ICOD=2
  53. IF (TYPCHE(ICOMP).EQ.'POINTEUREVOLUTIO') ICOD=3
  54. *
  55. CALL ADCHVE(IPMEL1,IPMEL2,XX,ICOD,IPMELV,IRETOU)
  56. MELVA1=IPMEL1
  57. SEGDES MELVA1
  58. MELVA1=IPMEL2
  59. SEGDES MELVA1
  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. SEGDES MELVAL
  72. ENDIF
  73. 1 CONTINUE
  74. *
  75. * ON RAJOUTE LES COMPOSANTES DU 2IEME CHAMELEM QUI NE SONT PAS
  76. * ENCORE PRIS EN COMPTE (LE NUMERO DE LA SOUS ZONE EST DONNE
  77. * JTAFF(ISOUS1)
  78. *
  79. N22=IELVAL(/1)
  80. DO 2 ICOMP=1,MCHAM2.IELVAL(/1)
  81. CALL PLACE (NOMCHE,N22,IPLAC,
  82. & MCHAM2.NOMCHE(ICOMP))
  83. IF (IPLAC.EQ.0) THEN
  84. N2=IELVAL(/1)
  85. N2=N2+1
  86. SEGADJ MCHAML
  87. NOMCHE(N2)=MCHAM2.NOMCHE(ICOMP)
  88. TYPCHE(N2)=MCHAM2.TYPCHE(ICOMP)
  89. MELVA2=MCHAM2.IELVAL(ICOMP)
  90. SEGINI,MELVAL=MELVA2
  91. IELVAL(N2)=MELVAL
  92. SEGDES MELVAL
  93. ENDIF
  94. 2 CONTINUE
  95. *
  96. 9990 CONTINUE
  97. END
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  

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