Télécharger cp2tr2.eso

Retour à la liste

Numérotation des lignes :

  1. C CP2TR2 SOURCE GOUNAND 09/09/03 21:15:02 6481
  2. SUBROUTINE CP2TR2(LISCOM,MELTOT,MYCHPO,
  3. $ MYMTRA,IRET)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM : CP2TR2
  8. C DESCRIPTION : Transformation d'un chpoint MYCHPO
  9. C en un objet MTRAV MYMTRA plus commode
  10. C LISCOM et MELEME sont les composantes et points
  11. C qui nous intéressent.
  12. C
  13. C
  14. C LANGAGE : ESOPE
  15. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C VERSION : v1, 11/04/2008, version initiale
  19. C HISTORIQUE : v1, 11/04/2008, création
  20. C HISTORIQUE :
  21. C HISTORIQUE :
  22. C***********************************************************************
  23. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  24. C en cas de modification de ce sous-programme afin de faciliter
  25. C la maintenance !
  26. C***********************************************************************
  27. -INC CCOPTIO
  28. -INC SMCOORD
  29. *
  30. -INC SMCHPOI
  31. POINTEUR MYCHPO.MCHPOI
  32. POINTEUR MYMSOU.MSOUPO
  33. POINTEUR MYMPOV.MPOVAL
  34. INTEGER N,NC
  35. -INC TMTRAV
  36. POINTEUR MYMTRA.MTRAV
  37. INTEGER NNIN,NNNOE
  38. -INC SMLMOTS
  39. POINTEUR LISCOM.MLMOTS
  40. INTEGER JGN,JGM
  41. -INC SMELEME
  42. POINTEUR MYMEL.MELEME
  43. POINTEUR MELTOT.MELEME
  44. -INC SMLENTI
  45. POINTEUR KRINCO.MLENTI
  46. POINTEUR KRIGEO.MLENTI
  47. INTEGER JG
  48. *
  49. * Includes persos
  50. *
  51. * Liste de MELEME
  52. INTEGER NBMEL
  53. SEGMENT MELS
  54. POINTEUR LISMEL(NBMEL).MELEME
  55. ENDSEGMENT
  56. POINTEUR GPMELS.MELS
  57. *
  58. LOGICAL LVIDE
  59. INTEGER IMPR,IRET
  60. *
  61. INTEGER I,IC,IGM,JGM2,ININ,INNOE,IGLOB
  62. INTEGER NTOTPO,NTOGPO
  63. *
  64. * Executable statements
  65. *
  66. IMPR=0
  67. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans cp2tr2.eso'
  68. *
  69. SEGACT LISCOM
  70. JGN=LISCOM.MOTS(/1)
  71. JGM=LISCOM.MOTS(/2)
  72. IF (JGN.NE.4) THEN
  73. WRITE(IOIMP,*) 'Erreur de programmation'
  74. GOTO 9999
  75. ENDIF
  76. *
  77. * Initialisation de l'objet MTRAV
  78. *
  79. SEGACT MELTOT
  80. NTOTPO=MELTOT.NUM(/2)
  81. NNIN=JGM
  82. NNNOE=NTOTPO
  83. SEGINI MYMTRA
  84. DO ININ=1,NNIN
  85. MYMTRA.INCO(ININ)=LISCOM.MOTS(ININ)
  86. ENDDO
  87. SEGDES LISCOM
  88. DO INNOE=1,NNNOE
  89. MYMTRA.IGEO(INNOE)=MELTOT.NUM(1,INNOE)
  90. ENDDO
  91. SEGDES MELTOT
  92. *
  93. * Remplissage de l'objet MTRAV
  94. *
  95. * Création du segment de répérage dans IGEO
  96. NTOGPO=XCOOR(/1)/(IDIM+1)
  97. JG=NTOGPO
  98. SEGINI,KRIGEO
  99. CALL RSETEE(MYMTRA.IGEO,NNNOE,
  100. $ KRIGEO.LECT,NTOGPO,
  101. $ IMPR,IRET)
  102. IF (IRET.NE.0) GOTO 9999
  103. * Parcours de l'objet champoint
  104. SEGACT MYCHPO
  105. NSOUPO=MYCHPO.IPCHP(/1)
  106. DO ISOUPO=1,NSOUPO
  107. MYMSOU=MYCHPO.IPCHP(ISOUPO)
  108. SEGACT MYMSOU
  109. NC=MYMSOU.NOCOMP(/2)
  110. * Création du segment de repérage dans les noms d'inconnues
  111. JG=NC
  112. SEGINI KRINCO
  113. CALL CREPE2(JGN,NC,NNIN,
  114. $ MYMSOU.NOCOMP,MYMTRA.INCO,
  115. $ KRINCO.LECT,
  116. $ IMPR,IRET)
  117. IF (IRET.NE.0) GOTO 9999
  118. MYMEL=MYMSOU.IGEOC
  119. MYMPOV=MYMSOU.IPOVAL
  120. SEGACT MYMEL
  121. SEGACT MYMPOV
  122. N=MYMPOV.VPOCHA(/1)
  123. DO IC=1,NC
  124. ININ=KRINCO.LECT(IC)
  125. IF (ININ.NE.0) THEN
  126. DO I=1,N
  127. IGLOB=MYMEL.NUM(1,I)
  128. INNOE=KRIGEO.LECT(IGLOB)
  129. IF (INNOE.NE.0) THEN
  130. MYMTRA.IBIN(ININ,INNOE)=1
  131. MYMTRA.BB(ININ,INNOE)=MYMPOV.VPOCHA(I,IC)
  132. ENDIF
  133. ENDDO
  134. ENDIF
  135. ENDDO
  136. SEGDES MYMPOV
  137. SEGDES MYMEL
  138. SEGSUP KRINCO
  139. SEGDES MYMSOU
  140. ENDDO
  141. SEGSUP KRIGEO
  142. SEGDES MYCHPO
  143. SEGDES MYMTRA
  144. *
  145. * Normal termination
  146. *
  147. IRET=0
  148. RETURN
  149. *
  150. * Format handling
  151. *
  152. *
  153. * Error handling
  154. *
  155. 9999 CONTINUE
  156. IRET=1
  157. WRITE(IOIMP,*) 'An error was detected in subroutine cp2tr2'
  158. RETURN
  159. *
  160. * End of subroutine CP2TR2
  161. *
  162. END
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  

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