Télécharger excham.eso

Retour à la liste

Numérotation des lignes :

  1. C EXCHAM SOURCE PV 16/11/26 21:15:47 9205
  2. SUBROUTINE EXCHAM(ICOLAC,ITLACC,M1,M2,IIICHA)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Sous-programme appel{ par EXPIL, traitant la pile des *
  8. * nouveaux CHAMELEMs. *
  9. * *
  10. * Param}tres: *
  11. * *
  12. * e ICOLAC pointeur sur le chapeau des piles *
  13. * es ITLACC pointeur de la pile examin{e *
  14. * e M1 premier indice d'examen dans la pile *
  15. * e M2 dernier indice d'examen dans la pile *
  16. * e IIICHA = 1 : on change les pointeurs *
  17. * *
  18. *--------------------------------------------------------------------*
  19. -INC CCOPTIO
  20. -INC SMCHAML
  21. -INC TMCOLAC
  22. *
  23. CHARACTER*8 MOTIP
  24. CHARACTER*16 MOTYP
  25. *
  26. IF (M1.GT.M2) RETURN
  27. *
  28. ICO1 = KCOLA( 1)
  29. ILISSE=ILISSG
  30. SEGACT ILISSE*MOD
  31. DO 10 IEL=M1,M2
  32. MCHELM = ITLAC(IEL)
  33. IF (MCHELM.EQ.0) GO TO 10
  34. SEGACT,MCHELM*MOD
  35. N3 = INFCHE(/2)
  36. if (ichaml(/1).lt.0.or.ichaml(/1).gt.10000000) then
  37. * chelm invalide. On le supprime de la pile
  38. moterr(1:8)='MCHELM '
  39. interr(1)=itlac(iel)
  40. call erreur(861)
  41. itlac(iel)=0
  42. goto 10
  43. endif
  44. DO 20 I=1,ICHAML(/1)
  45. MCHAML = ICHAML(I)
  46. SEGACT,MCHAML*MOD
  47. *
  48. IVA = IMACHE(I)
  49. IF(IVA.GT.0) THEN
  50. CALL AJOUN(ICO1,IVA,ILISSE,1)
  51. IF (IIICHA.EQ.1) IMACHE(I) =-IVA
  52. ENDIF
  53. *
  54. IF(N3.GE.4) THEN
  55. IVA = INFCHE(I,4)
  56. ICO2 = KCOLA(40)
  57. IF(IVA.GT.0) THEN
  58. CALL AJOUN(ICO2,IVA,ILISSE,1)
  59. IF (IIICHA.EQ.1) INFCHE(I,4) =-IVA
  60. ENDIF
  61. ENDIF
  62. *
  63. DO 30 J=1,TYPCHE(/2)
  64. MOTYP = TYPCHE(J)
  65. IF (MOTYP(1:6).NE.'REAL*8') THEN
  66. MOTIP(1:8)=MOTYP(9:16)
  67. CALL TYPFIL(MOTIP,ITYP)
  68. IF (ITYP.GT.0) THEN
  69. NUMLIS=1
  70. ilissd=ilissg
  71. IF(ITYP.EQ.24) NUMLIS=6
  72. C IF(ITYP.EQ.25) NUMLIS=4
  73. IF(ITYP.EQ.26) NUMLIS=2
  74. IF(ITYP.EQ.27) NUMLIS=5
  75. IF(ITYP.EQ.32) then
  76. NUMLIS=3
  77. ILISSD=ilissp
  78. ENDIF
  79. IF(ITYP.EQ.36) NUMLIS=7
  80. ICO2 = KCOLA(ITYP)
  81. MELVAL = IELVAL(J)
  82. SEGACT,MELVAL*MOD
  83. NAL1 = IELCHE(/1)
  84. NAL2 = IELCHE(/2)
  85. DO 40 I2=1,NAL2
  86. DO 50 I1=1,NAL1
  87. IVA = IELCHE(I1,I2)
  88. IF(IVA.GT.0) THEN
  89. CALL AJOUN(ICO2,IVA,ILISSD,NUMLIS)
  90. IF (IIICHA.EQ.1) IELCHE(I1,I2) =-IVA
  91. ENDIF
  92. 50 CONTINUE
  93. * END DO
  94. 40 CONTINUE
  95. * END DO
  96. SEGDES,MELVAL
  97. ENDIF
  98. ENDIF
  99. 30 CONTINUE
  100. * END DO
  101. SEGDES,MCHAML
  102. 20 CONTINUE
  103. * END DO
  104. SEGDES,MCHELM
  105. 10 CONTINUE
  106. * END DO
  107. *
  108. * SEGDES ILISSE
  109. RETURN
  110. END
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  

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