Télécharger cp2tra.eso

Retour à la liste

Numérotation des lignes :

  1. C CP2TRA SOURCE GOUNAND 06/12/19 21:15:13 5612
  2. SUBROUTINE CP2TRA(MYCHPO,
  3. $ MYMTRA,LVIDE,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : CP2TRA
  9. C DESCRIPTION : Transformation d'un chpoint MYCHPO
  10. C en un objet MTRAV MYMTRA plus commode
  11. C LVIDE est vrai, si le chpoint était vide
  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 APPELES :
  19. C APPELES (E/S) :
  20. C APPELES (BLAS) :
  21. C APPELES (CALCUL) :
  22. C APPELE PAR : CP2CV6
  23. C***********************************************************************
  24. C SYNTAXE GIBIANE :
  25. C ENTREES :
  26. C ENTREES/SORTIES :
  27. C SORTIES :
  28. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  29. C***********************************************************************
  30. C VERSION : v1, 26/09/2002, version initiale
  31. C HISTORIQUE : v1, 26/09/2002, création
  32. C HISTORIQUE :
  33. C HISTORIQUE :
  34. C***********************************************************************
  35. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  36. C en cas de modification de ce sous-programme afin de faciliter
  37. C la maintenance !
  38. C***********************************************************************
  39. -INC CCOPTIO
  40. -INC SMCOORD
  41. *
  42. -INC SMCHPOI
  43. POINTEUR MYCHPO.MCHPOI
  44. POINTEUR MYMSOU.MSOUPO
  45. POINTEUR MYMPOV.MPOVAL
  46. INTEGER N,NC
  47. -INC TMTRAV
  48. POINTEUR MYMTRA.MTRAV
  49. INTEGER NNIN,NNNOE
  50. -INC SMLMOTS
  51. POINTEUR LISCOM.MLMOTS
  52. INTEGER JGN,JGM
  53. -INC SMELEME
  54. POINTEUR MYMEL.MELEME
  55. POINTEUR MELTOT.MELEME
  56. -INC SMLENTI
  57. POINTEUR KRINCO.MLENTI
  58. POINTEUR KRIGEO.MLENTI
  59. INTEGER JG
  60. *
  61. * Includes persos
  62. *
  63. * Liste de MELEME
  64. INTEGER NBMEL
  65. SEGMENT MELS
  66. POINTEUR LISMEL(NBMEL).MELEME
  67. ENDSEGMENT
  68. POINTEUR GPMELS.MELS
  69. *
  70. LOGICAL LVIDE
  71. INTEGER IMPR,IRET
  72. *
  73. INTEGER I,IC,IGM,JGM2,ININ,INNOE,IGLOB
  74. INTEGER NTOTPO,NTOGPO
  75. *
  76. * Executable statements
  77. *
  78. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans cp2tra.eso'
  79. LVIDE=.TRUE.
  80. *
  81. * Construction de la liste des composantes et de la liste des
  82. * melemes du champoint
  83. *
  84. JGN=4
  85. JGM=0
  86. IGM=0
  87. SEGINI,LISCOM
  88. NBMEL=0
  89. SEGINI,GPMELS
  90. *
  91. SEGACT MYCHPO
  92. NSOUPO=MYCHPO.IPCHP(/1)
  93. DO ISOUPO=1,NSOUPO
  94. MYMSOU=MYCHPO.IPCHP(ISOUPO)
  95. SEGACT MYMSOU
  96. NC=MYMSOU.NOCOMP(/2)
  97. JGM=JGM+NC
  98. SEGADJ,LISCOM
  99. DO IC=1,NC
  100. IGM=IGM+1
  101. LISCOM.MOTS(IGM)=MYMSOU.NOCOMP(IC)
  102. ENDDO
  103. GPMELS.LISMEL(**)=MYMSOU.IGEOC
  104. SEGDES MYMSOU
  105. ENDDO
  106. SEGDES MYCHPO
  107. *
  108. * Suppression des doublons dans la liste des composantes
  109. * et création du maillage total des points supports
  110. *
  111. CALL CUNIQ(LISCOM.MOTS,JGN,JGM,
  112. $ LISCOM.MOTS,JGM2,
  113. $ IMPR,IRET)
  114. IF (IRET.NE.0) GOTO 9999
  115. JGM=JGM2
  116. SEGADJ,LISCOM
  117. * In MLUNIQ : SEGINI MELTOT
  118. CALL MLUNIQ(GPMELS,MELTOT,
  119. $ IMPR,IRET)
  120. IF (IRET.NE.0) GOTO 9999
  121. SEGSUP GPMELS
  122. *
  123. * Initialisation de l'objet MTRAV
  124. *
  125. SEGACT MELTOT
  126. NTOTPO=MELTOT.NUM(/2)
  127. NNIN=JGM
  128. NNNOE=NTOTPO
  129. SEGINI MYMTRA
  130. DO ININ=1,NNIN
  131. MYMTRA.INCO(ININ)=LISCOM.MOTS(ININ)
  132. ENDDO
  133. SEGSUP LISCOM
  134. DO INNOE=1,NNNOE
  135. MYMTRA.IGEO(INNOE)=MELTOT.NUM(1,INNOE)
  136. ENDDO
  137. * SEGDES MELTOT
  138. SEGSUP MELTOT
  139. *
  140. * Remplissage de l'objet MTRAV
  141. *
  142. * Création du segment de répérage dans IGEO
  143. NTOGPO=XCOOR(/1)/(IDIM+1)
  144. JG=NTOGPO
  145. SEGINI,KRIGEO
  146. CALL RSETEE(MYMTRA.IGEO,NNNOE,
  147. $ KRIGEO.LECT,NTOGPO,
  148. $ IMPR,IRET)
  149. IF (IRET.NE.0) GOTO 9999
  150. * Parcours de l'objet champoint
  151. SEGACT MYCHPO
  152. NSOUPO=MYCHPO.IPCHP(/1)
  153. DO ISOUPO=1,NSOUPO
  154. MYMSOU=MYCHPO.IPCHP(ISOUPO)
  155. SEGACT MYMSOU
  156. NC=MYMSOU.NOCOMP(/2)
  157. * Création du segment de repérage dans les noms d'inconnues
  158. JG=NNIN
  159. SEGINI KRINCO
  160. CALL CREPER(JGN,NC,NNIN,
  161. $ MYMSOU.NOCOMP,MYMTRA.INCO,
  162. $ KRINCO.LECT,
  163. $ IMPR,IRET)
  164. IF (IRET.NE.0) GOTO 9999
  165. MYMEL=MYMSOU.IGEOC
  166. MYMPOV=MYMSOU.IPOVAL
  167. SEGACT MYMEL
  168. SEGACT MYMPOV
  169. N=MYMPOV.VPOCHA(/1)
  170. DO IC=1,NC
  171. ININ=KRINCO.LECT(IC)
  172. DO I=1,N
  173. IGLOB=MYMEL.NUM(1,I)
  174. INNOE=KRIGEO.LECT(IGLOB)
  175. IF (INNOE.EQ.0) THEN
  176. WRITE(IOIMP,*) 'Erreur de programmation'
  177. GOTO 9999
  178. ENDIF
  179. LVIDE=.FALSE.
  180. MYMTRA.IBIN(ININ,INNOE)=1
  181. MYMTRA.BB(ININ,INNOE)=MYMPOV.VPOCHA(I,IC)
  182. ENDDO
  183. ENDDO
  184. SEGDES MYMPOV
  185. SEGDES MYMEL
  186. SEGSUP KRINCO
  187. SEGDES MYMSOU
  188. ENDDO
  189. SEGSUP KRIGEO
  190. SEGDES MYCHPO
  191. SEGDES MYMTRA
  192. *
  193. * Normal termination
  194. *
  195. IRET=0
  196. RETURN
  197. *
  198. * Format handling
  199. *
  200. *
  201. * Error handling
  202. *
  203. 9999 CONTINUE
  204. IRET=1
  205. WRITE(IOIMP,*) 'An error was detected in subroutine cp2tra'
  206. RETURN
  207. *
  208. * End of subroutine CP2TRA
  209. *
  210. END
  211.  
  212.  
  213.  
  214.  

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