Télécharger cqf2mc.eso

Retour à la liste

Numérotation des lignes :

  1. C CQF2MC SOURCE CHAT 05/01/12 22:27:30 5004
  2. SUBROUTINE CQF2MC(MELEME,MACRO1)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C************************************************************************
  6. C Ce sp transforme des éléments QUAF pris
  7. C dans la liste ci-dessous
  8. C SEG3 TRI7 QUA9 CU27 PR21 TE15 PY19
  9. C 3 7 11 33 34 35 36
  10. C
  11. C en les éléments correspondant MACRO (iso p2 ou q2) de la liste
  12. C ci-dessous
  13. C
  14. C SEG3 TRI6 QUA9 CU27 PR18 TE10 PY14
  15. C 3 6 11 33 40 24 ??
  16. C************************************************************************
  17. -INC SMELEME
  18. POINTEUR MACRO1.MELEME
  19.  
  20. SEGACT MELEME
  21. NBSOU1=LISOUS(/1)
  22. IF(NBSOU1.EQ.0)NBSOU1=1
  23. C write(6,*)' SUB CQF2MC '
  24.  
  25. C On vérifie qu'il y a quelque chose à faire
  26.  
  27. DO 12 L=1,NBSOU1
  28. IPT1=MELEME
  29. IF(NBSOU1.NE.1)IPT1=LISOUS(L)
  30. SEGACT IPT1
  31. ITYP=IPT1.ITYPEL
  32. C write(6,*)' CQF2MC ITYP=',ityp
  33. IF(ITYP.EQ.7.OR.ITYP.EQ.34.OR.ITYP.EQ.35)GO TO 212
  34. IF(ITYP.EQ.36)THEN
  35. CALL ERREUR(29)
  36. RETURN
  37. ENDIF
  38. SEGDES IPT1
  39. 12 CONTINUE
  40. SEGDES MELEME
  41. MACRO1=MELEME
  42. C write(6,*)'CMACRO il n y a rien a faire '
  43.  
  44. RETURN
  45.  
  46. 212 CONTINUE
  47. C write(6,*)'CQF2MC il y a a faire '
  48.  
  49. NBSOUS=NBSOU1
  50. NBNN=0
  51. NBELEM=0
  52. NBREF=0
  53. SEGINI MACRO1
  54. DO 213 L=1,NBSOU1
  55. IPT1=MELEME
  56. IF(NBSOU1.NE.1)IPT1=LISOUS(L)
  57. SEGACT IPT1
  58. ITYP=IPT1.ITYPEL
  59. NBNN0=IPT1.NUM(/1)
  60. NBELEM=IPT1.NUM(/2)
  61. MACRO1.LISOUS(L)=IPT1
  62.  
  63. IF(ITYP.EQ.7)THEN
  64. NBNN=6
  65. NBSOUS=0
  66. NBREF=0
  67. SEGINI IPT2
  68. MACRO1.LISOUS(L)=IPT2
  69. IPT2.ITYPEL=6
  70. DO 217 K=1,NBELEM
  71. DO 217 I=1,NBNN
  72. IPT2.NUM(I,K)=IPT1.NUM(I,K)
  73. 217 CONTINUE
  74.  
  75. ELSEIF(ITYP.EQ.34)THEN
  76. NBNN=18
  77. NBSOUS=0
  78. NBREF=0
  79. SEGINI IPT2
  80. MACRO1.LISOUS(L)=IPT2
  81. IPT2.ITYPEL=40
  82. DO 218 K=1,NBELEM
  83. DO 218 I=1,NBNN
  84. IPT2.NUM(I,K)=IPT1.NUM(I,K)
  85. 218 CONTINUE
  86.  
  87. ELSEIF(ITYP.EQ.35)THEN
  88. NBNN=10
  89. NBSOUS=0
  90. NBREF=0
  91. SEGINI IPT2
  92. MACRO1.LISOUS(L)=IPT2
  93. IPT2.ITYPEL=24
  94. DO 219 K=1,NBELEM
  95. DO 219 I=1,NBNN
  96. IPT2.NUM(I,K)=IPT1.NUM(I,K)
  97. 219 CONTINUE
  98.  
  99. ENDIF
  100.  
  101. 213 CONTINUE
  102.  
  103. IF(NBSOU1.EQ.1)THEN
  104. IPT3=MACRO1
  105. MACRO1=MACRO1.LISOUS(1)
  106. SEGSUP IPT3
  107. ENDIF
  108.  
  109. RETURN
  110. 1001 FORMAT(20(1X,I5))
  111. 1002 FORMAT(10(1X,1PE11.4))
  112. END
  113.  
  114.  
  115.  
  116.  

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