Télécharger cqf2mc.eso

Retour à la liste

Numérotation des lignes :

  1. C CQF2MC SOURCE MAGN 18/05/16 21:15:04 9823
  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.OR.ITYP.EQ.36)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. ELSEIF(ITYP.EQ.36)THEN
  100. C write(6,*)' CQF2MC 36 '
  101. MACRO1.LISOUS(L)=IPT1
  102.  
  103. ENDIF
  104.  
  105. 213 CONTINUE
  106.  
  107. IF(NBSOU1.EQ.1)THEN
  108. IPT3=MACRO1
  109. MACRO1=MACRO1.LISOUS(1)
  110. SEGSUP IPT3
  111. ENDIF
  112. C write(6,*)' FIN cqf2mc'
  113.  
  114. RETURN
  115. 1001 FORMAT(20(1X,I5))
  116. 1002 FORMAT(10(1X,1PE11.4))
  117. END
  118.  
  119.  
  120.  
  121.  
  122.  

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