Télécharger cv2cp9.eso

Retour à la liste

Numérotation des lignes :

cv2cp9
  1. C CV2CP9 SOURCE GOUNAND 21/06/02 21:15:35 11022
  2. SUBROUTINE CV2CP9(MYDISC,MYLMOT,MYMCHA,
  3. $ MYFALS,
  4. $ MYCHPO,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : CV2CP9
  10. C DESCRIPTION : Transforme un MCHAEL en MCHPOI
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES :
  17. C APPELE PAR : PRLS92
  18. C***********************************************************************
  19. C ENTREES : * CGEOME (type MELEME) : maillage de QUAFs
  20. C partitionné.
  21. C * MYDISC (type CH*(4)) : nom d'espace de
  22. C discrétisation (cf. NOMFA dans l'include
  23. C SFALRF)
  24. C * MYFALS (type FALRFS) : segment de description
  25. C des familles d'éléments de références.
  26. C SORTIES : * MYMCHA (type MCHAEL) : champ par éléments de
  27. C la grandeur tensorielle (degrés de liberté de
  28. C la grandeur).
  29. C ENTREES/SORTIES : -
  30. C TRAVAIL :
  31. C (1, nb. ddl, NCOMPD, NCOMPP, 1, nb. élément)
  32. C
  33. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  34. C***********************************************************************
  35. C VERSION : v1, 07/10/02, version initiale
  36. C HISTORIQUE : v1, 07/10/02, création
  37. C HISTORIQUE :
  38. C HISTORIQUE :
  39. C***********************************************************************
  40. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  41. C en cas de modification de ce sous-programme afin de faciliter
  42. C la maintenance !
  43. C***********************************************************************
  44.  
  45. -INC PPARAM
  46. -INC CCOPTIO
  47. -INC SMCOORD
  48. -INC SMCHPOI
  49. POINTEUR MYCHPO.MCHPOI
  50. -INC TMTRAV
  51. POINTEUR MYMTRA.MTRAV
  52. INTEGER NNIN,NNNOE
  53. -INC SMELEME
  54. POINTEUR SOUMAI.MELEME
  55. POINTEUR MELTOT.MELEME
  56. POINTEUR SMLTOT.MELEME
  57. POINTEUR ML1TOT.MELEME
  58. INTEGER NBNN,NBELEM,NBSOUS,NBREF
  59. -INC SMLMOTS
  60. POINTEUR MYLMOT.MLMOTS
  61. -INC SMLENTI
  62. POINTEUR KRIGEO.MLENTI
  63. INTEGER JG
  64. *
  65. * Includes persos
  66. *
  67. -INC TNLIN
  68. *-INC SMCHAEL
  69. POINTEUR MYMCHA.MCHAEL
  70. POINTEUR MZMCHA.MCHEVA
  71. *-INC SFALRF
  72. POINTEUR MYFALS.FALRFS
  73. *-INC SELREF
  74. POINTEUR MYLRF.ELREF
  75. *
  76. * Includes persos
  77. *
  78. * Liste de MELEME
  79. INTEGER NBMEL
  80. SEGMENT MELS
  81. POINTEUR LISMEL(NBMEL).MELEME
  82. ENDSEGMENT
  83. POINTEUR GPMELS.MELS
  84. *
  85. CHARACTER*(4) MYDISC
  86. INTEGER IMPR,IRET
  87. *
  88. INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM
  89. INTEGER IDELM
  90. INTEGER IBEL,IDDL,ISOUS,ITQUAF
  91. INTEGER NBEL,NDDL,NSOUS
  92. INTEGER NNGLO,NNLOC,NNQUA
  93. INTEGER ININ,INNOE
  94. INTEGER NTOGPO
  95. *
  96. * Executable statements
  97. *
  98. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2cp9'
  99.  
  100.  
  101. *
  102. * Création de MELTOT maillage des points sur lesquels reposent les ddl
  103. * (il y a des doublons)
  104. *
  105. SEGACT MYMCHA
  106. * SEGPRT,MYMCHA
  107. NSOUS=MYMCHA.JMACHE(/1)
  108. *
  109. NBNN=0
  110. NBELEM=0
  111. NBSOUS=NSOUS
  112. NBREF=0
  113. SEGINI,MELTOT
  114. DO 1 ISOUS=1,NSOUS
  115. SOUMAI=MYMCHA.JMACHE(ISOUS)
  116. SEGACT SOUMAI
  117. * On cherche l'élément fini correspondant au QUAF
  118. ITQUAF=SOUMAI.ITYPEL
  119. CALL KEEF(ITQUAF,MYDISC,
  120. $ MYFALS,
  121. $ MYLRF,
  122. $ IMPR,IRET)
  123. IF (IRET.NE.0) GOTO 9999
  124. SEGACT MYLRF
  125. NDDL=MYLRF.NPQUAF(/1)
  126. NBEL=SOUMAI.NUM(/2)
  127. *
  128. NBNN=NDDL
  129. NBELEM=NBEL
  130. NBSOUS=0
  131. NBREF=0
  132. SEGINI,SMLTOT
  133. DO IBEL=1,NBEL
  134. DO IDDL=1,NDDL
  135. NNQUA=MYLRF.NPQUAF(IDDL)
  136. NNGLO=SOUMAI.NUM(NNQUA,IBEL)
  137. SMLTOT.NUM(IDDL,IBEL)=NNGLO
  138. ENDDO
  139. ENDDO
  140. SEGDES,SMLTOT
  141. MELTOT.LISOUS(ISOUS)=SMLTOT
  142. SEGDES,MYLRF
  143. SEGDES,SOUMAI
  144. 1 CONTINUE
  145. SEGDES,MELTOT
  146. SEGDES,MYMCHA
  147. *
  148. * On construit ML1TOT, ensemble des points de MELTOT
  149. *
  150. NBMEL=1
  151. SEGINI,GPMELS
  152. GPMELS.LISMEL(1)=MELTOT
  153. CALL MLUNIQ(GPMELS,ML1TOT,
  154. $ IMPR,IRET)
  155. IF (IRET.NE.0) GOTO 9999
  156. SEGSUP,GPMELS
  157. *
  158. * Destruction de MELTOT
  159. *
  160. SEGACT,MELTOT*MOD
  161. DO 3 ISOUS=1,NSOUS
  162. SMLTOT=MELTOT.LISOUS(ISOUS)
  163. * SEGACT,SMLTOT
  164. SEGSUP,SMLTOT
  165. 3 CONTINUE
  166. SEGSUP,MELTOT
  167. *
  168. * Initialisation de MYMTRA
  169. *
  170. SEGACT MYLMOT
  171. NNIN=MYLMOT.MOTS(/2)
  172. SEGACT ML1TOT
  173. NNNOE=ML1TOT.NUM(/2)
  174. SEGINI,MYMTRA
  175. * Remplissage de MYMTRA.INCO et MYMTRA.IGEO
  176. DO ININ=1,NNIN
  177. MYMTRA.INCO(ININ)=MYLMOT.MOTS(ININ)
  178. ENDDO
  179. DO INNOE=1,NNNOE
  180. MYMTRA.IGEO(INNOE)=ML1TOT.NUM(1,INNOE)
  181. ENDDO
  182. SEGSUP,ML1TOT
  183. SEGDES,MYLMOT
  184. * Création du segment de repérage dans MYMTRA.IGEO
  185. NTOGPO=nbpts
  186. JG=NTOGPO
  187. SEGINI,KRIGEO
  188. CALL RSETEE(MYMTRA.IGEO,NNNOE,
  189. $ KRIGEO.LECT,NTOGPO,
  190. $ IMPR,IRET)
  191. IF (IRET.NE.0) GOTO 9999
  192. * Remplissage de MYMTRA.BB et MYMTRA.IBIN
  193. SEGACT,MYMCHA
  194. DO 5 ISOUS=1,NSOUS
  195. SOUMAI=MYMCHA.JMACHE(ISOUS)
  196. SEGACT,SOUMAI
  197. MZMCHA=MYMCHA.ICHEVA(ISOUS)
  198. IF (MZMCHA.NE.0) THEN
  199. SEGACT,MZMCHA
  200. * On cherche l'élément fini correspondant au QUAF
  201. ITQUAF=SOUMAI.ITYPEL
  202. CALL KEEF(ITQUAF,MYDISC,
  203. $ MYFALS,
  204. $ MYLRF,
  205. $ IMPR,IRET)
  206. IF (IRET.NE.0) GOTO 9999
  207. SEGACT MYLRF
  208. NDDL=MYLRF.NPQUAF(/1)
  209. NBEL=SOUMAI.NUM(/2)
  210. * Petits tests
  211. NDLIG=MZMCHA.WELCHE(/1)
  212. NDCOL=MZMCHA.WELCHE(/2)
  213. N2DLIG=MZMCHA.WELCHE(/3)
  214. N2DCOL=MZMCHA.WELCHE(/4)
  215. NDNOEU=MZMCHA.WELCHE(/5)
  216. NDELM=MZMCHA.WELCHE(/6)
  217. IF (.NOT.( (NDLIG.EQ.1.AND.NDCOL.EQ.NDDL)
  218. $ .OR. (NDLIG.EQ.NDDL.AND.NDCOL.EQ.1))
  219. $ .OR.N2DLIG.NE.1
  220. $ .OR.N2DCOL.NE.1.OR.NDNOEU.NE.1
  221. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBEL)) THEN
  222. WRITE(IOIMP,*) 'Erreur dims MZMCHA'
  223. GOTO 9999
  224. ENDIF
  225.  
  226. DO IBEL=1,NBEL
  227. IF (NDELM.EQ.1) THEN
  228. IDELM=1
  229. ELSE
  230. IDELM=IBEL
  231. ENDIF
  232. DO IDDL=1,NDDL
  233. IF (NDLIG.EQ.1) THEN
  234. ILIG=1
  235. ICOL=IDDL
  236. ELSE
  237. ILIG=IDDL
  238. ICOL=1
  239. ENDIF
  240. NNQUA=MYLRF.NPQUAF(IDDL)
  241. NNGLO=SOUMAI.NUM(NNQUA,IBEL)
  242. NNLOC=KRIGEO.LECT(NNGLO)
  243. IF (NNLOC.EQ.0) THEN
  244. WRITE(IOIMP,*) 'Erreur de programmation 1'
  245. GOTO 9999
  246. ENDIF
  247. ININ=MYLRF.NUMCMP(IDDL)
  248. MYMTRA.IBIN(ININ,NNLOC)=1
  249. MYMTRA.BB(ININ,NNLOC)=MYMTRA.BB(ININ,NNLOC)
  250. $ +MZMCHA.WELCHE(ILIG,ICOL,1,1,1,IDELM)
  251. ENDDO
  252. ENDDO
  253. SEGDES,MYLRF
  254. SEGDES,MZMCHA
  255. ENDIF
  256. SEGDES,SOUMAI
  257. 5 CONTINUE
  258. SEGDES,MYMCHA
  259. SEGSUP,KRIGEO
  260. *
  261. * Transformation l'objet MTRAV en chpoint
  262. *
  263. CALL CRECHP(MYMTRA,MYCHPO)
  264. SEGSUP MYMTRA
  265. SEGACT MYCHPO*MOD
  266. MYCHPO.JATTRI(1)=2
  267. SEGDES MYCHPO
  268. * IMPR=6
  269. IF (IMPR.GT.3) THEN
  270. CALL ECROBJ('CHPOINT ',MYCHPO)
  271. CALL PRLIST
  272. ENDIF
  273. * IMPR=0
  274. *
  275. * Normal termination
  276. *
  277. IRET=0
  278. RETURN
  279. *
  280. * Format handling
  281. *
  282. *
  283. * Error handling
  284. *
  285. 9999 CONTINUE
  286. IRET=1
  287. WRITE(IOIMP,*) 'An error was detected in subroutine cv2cp9'
  288. RETURN
  289. *
  290. * End of subroutine CV2CP9
  291. *
  292. END
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  

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