Télécharger cv2cp9.eso

Retour à la liste

Numérotation des lignes :

  1. C CV2CP9 SOURCE GOUNAND 07/10/10 21:15:01 5886
  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. -INC CCOPTIO
  45. -INC SMCOORD
  46. -INC SMCHPOI
  47. POINTEUR MYCHPO.MCHPOI
  48. -INC TMTRAV
  49. POINTEUR MYMTRA.MTRAV
  50. INTEGER NNIN,NNNOE
  51. -INC SMELEME
  52. POINTEUR SOUMAI.MELEME
  53. POINTEUR MELTOT.MELEME
  54. POINTEUR SMLTOT.MELEME
  55. POINTEUR ML1TOT.MELEME
  56. INTEGER NBNN,NBELEM,NBSOUS,NBREF
  57. -INC SMLMOTS
  58. POINTEUR MYLMOT.MLMOTS
  59. -INC SMLENTI
  60. POINTEUR KRIGEO.MLENTI
  61. INTEGER JG
  62. *
  63. * Includes persos
  64. *
  65. CBEGININCLUDE SMCHAEL
  66. SEGMENT MCHAEL
  67. POINTEUR IMACHE(N1).MELEME
  68. POINTEUR ICHEVA(N1).MCHEVA
  69. ENDSEGMENT
  70. SEGMENT MCHEVA
  71. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  72. ENDSEGMENT
  73. SEGMENT LCHEVA
  74. POINTEUR LISCHE(NBCHE).MCHEVA
  75. ENDSEGMENT
  76. CENDINCLUDE SMCHAEL
  77. POINTEUR MYMCHA.MCHAEL
  78. POINTEUR MZMCHA.MCHEVA
  79. CBEGININCLUDE SFALRF
  80. SEGMENT FALRF
  81. CHARACTER*(LNNFA) NOMFA
  82. INTEGER NUQUAF(NBLRF)
  83. POINTEUR ELEMF(NBLRF).ELREF
  84. ENDSEGMENT
  85. SEGMENT FALRFS
  86. POINTEUR LISFA(0).FALRF
  87. ENDSEGMENT
  88. CENDINCLUDE SFALRF
  89. POINTEUR MYFALS.FALRFS
  90. CBEGININCLUDE SELREF
  91. SEGMENT ELREF
  92. CHARACTER*(LNNOM) NOMLRF
  93. CHARACTER*(LNFORM) FORME
  94. CHARACTER*(LNTYPL) TYPEL
  95. CHARACTER*(LNESP) ESPACE
  96. INTEGER DEGRE
  97. REAL*8 XCONOD(NDIMEL,NBNOD)
  98. INTEGER NPQUAF(NBDDL)
  99. INTEGER NUMCMP(NBDDL)
  100. INTEGER QUENOD(NBDDL)
  101. INTEGER ORDDER(NDIMEL,NBDDL)
  102. POINTEUR MBPOLY.POLYNS
  103. ENDSEGMENT
  104. SEGMENT ELREFS
  105. POINTEUR LISEL(0).ELREF
  106. ENDSEGMENT
  107. CENDINCLUDE SELREF
  108. POINTEUR MYLRF.ELREF
  109. *
  110. * Includes persos
  111. *
  112. * Liste de MELEME
  113. INTEGER NBMEL
  114. SEGMENT MELS
  115. POINTEUR LISMEL(NBMEL).MELEME
  116. ENDSEGMENT
  117. POINTEUR GPMELS.MELS
  118. *
  119. CHARACTER*(4) MYDISC
  120. INTEGER IMPR,IRET
  121. *
  122. INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM
  123. INTEGER IDELM
  124. INTEGER IBEL,IDDL,ISOUS,ITQUAF
  125. INTEGER NBEL,NDDL,NSOUS
  126. INTEGER NNGLO,NNLOC,NNQUA
  127. INTEGER ININ,INNOE
  128. INTEGER NTOGPO
  129. *
  130. * Executable statements
  131. *
  132. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2cp9'
  133.  
  134.  
  135. *
  136. * Création de MELTOT maillage des points sur lesquels reposent les ddl
  137. * (il y a des doublons)
  138. *
  139. SEGACT MYMCHA
  140. * SEGPRT,MYMCHA
  141. NSOUS=MYMCHA.IMACHE(/1)
  142. *
  143. NBNN=0
  144. NBELEM=0
  145. NBSOUS=NSOUS
  146. NBREF=0
  147. SEGINI,MELTOT
  148. DO 1 ISOUS=1,NSOUS
  149. SOUMAI=MYMCHA.IMACHE(ISOUS)
  150. SEGACT SOUMAI
  151. * On cherche l'élément fini correspondant au QUAF
  152. ITQUAF=SOUMAI.ITYPEL
  153. CALL KEEF(ITQUAF,MYDISC,
  154. $ MYFALS,
  155. $ MYLRF,
  156. $ IMPR,IRET)
  157. IF (IRET.NE.0) GOTO 9999
  158. SEGACT MYLRF
  159. NDDL=MYLRF.NPQUAF(/1)
  160. NBEL=SOUMAI.NUM(/2)
  161. *
  162. NBNN=NDDL
  163. NBELEM=NBEL
  164. NBSOUS=0
  165. NBREF=0
  166. SEGINI,SMLTOT
  167. DO IBEL=1,NBEL
  168. DO IDDL=1,NDDL
  169. NNQUA=MYLRF.NPQUAF(IDDL)
  170. NNGLO=SOUMAI.NUM(NNQUA,IBEL)
  171. SMLTOT.NUM(IDDL,IBEL)=NNGLO
  172. ENDDO
  173. ENDDO
  174. SEGDES,SMLTOT
  175. MELTOT.LISOUS(ISOUS)=SMLTOT
  176. SEGDES,MYLRF
  177. SEGDES,SOUMAI
  178. 1 CONTINUE
  179. SEGDES,MELTOT
  180. SEGDES,MYMCHA
  181. *
  182. * On construit ML1TOT, ensemble des points de MELTOT
  183. *
  184. NBMEL=1
  185. SEGINI,GPMELS
  186. GPMELS.LISMEL(1)=MELTOT
  187. CALL MLUNIQ(GPMELS,ML1TOT,
  188. $ IMPR,IRET)
  189. IF (IRET.NE.0) GOTO 9999
  190. SEGSUP,GPMELS
  191. *
  192. * Destruction de MELTOT
  193. *
  194. SEGACT,MELTOT*MOD
  195. DO 3 ISOUS=1,NSOUS
  196. SMLTOT=MELTOT.LISOUS(ISOUS)
  197. * SEGACT,SMLTOT
  198. SEGSUP,SMLTOT
  199. 3 CONTINUE
  200. SEGSUP,MELTOT
  201. *
  202. * Initialisation de MYMTRA
  203. *
  204. SEGACT MYLMOT
  205. NNIN=MYLMOT.MOTS(/2)
  206. SEGACT ML1TOT
  207. NNNOE=ML1TOT.NUM(/2)
  208. SEGINI,MYMTRA
  209. * Remplissage de MYMTRA.INCO et MYMTRA.IGEO
  210. DO ININ=1,NNIN
  211. MYMTRA.INCO(ININ)=MYLMOT.MOTS(ININ)
  212. ENDDO
  213. DO INNOE=1,NNNOE
  214. MYMTRA.IGEO(INNOE)=ML1TOT.NUM(1,INNOE)
  215. ENDDO
  216. SEGSUP,ML1TOT
  217. SEGDES,MYLMOT
  218. * Création du segment de repérage dans MYMTRA.IGEO
  219. NTOGPO=XCOOR(/1)/(IDIM+1)
  220. JG=NTOGPO
  221. SEGINI,KRIGEO
  222. CALL RSETEE(MYMTRA.IGEO,NNNOE,
  223. $ KRIGEO.LECT,NTOGPO,
  224. $ IMPR,IRET)
  225. IF (IRET.NE.0) GOTO 9999
  226. * Remplissage de MYMTRA.BB et MYMTRA.IBIN
  227. SEGACT,MYMCHA
  228. DO 5 ISOUS=1,NSOUS
  229. SOUMAI=MYMCHA.IMACHE(ISOUS)
  230. SEGACT,SOUMAI
  231. MZMCHA=MYMCHA.ICHEVA(ISOUS)
  232. IF (MZMCHA.NE.0) THEN
  233. SEGACT,MZMCHA
  234. * On cherche l'élément fini correspondant au QUAF
  235. ITQUAF=SOUMAI.ITYPEL
  236. CALL KEEF(ITQUAF,MYDISC,
  237. $ MYFALS,
  238. $ MYLRF,
  239. $ IMPR,IRET)
  240. IF (IRET.NE.0) GOTO 9999
  241. SEGACT MYLRF
  242. NDDL=MYLRF.NPQUAF(/1)
  243. NBEL=SOUMAI.NUM(/2)
  244. * Petits tests
  245. NDLIG=MZMCHA.VELCHE(/1)
  246. NDCOL=MZMCHA.VELCHE(/2)
  247. N2DLIG=MZMCHA.VELCHE(/3)
  248. N2DCOL=MZMCHA.VELCHE(/4)
  249. NDNOEU=MZMCHA.VELCHE(/5)
  250. NDELM=MZMCHA.VELCHE(/6)
  251. IF (.NOT.( (NDLIG.EQ.1.AND.NDCOL.EQ.NDDL)
  252. $ .OR. (NDLIG.EQ.NDDL.AND.NDCOL.EQ.1))
  253. $ .OR.N2DLIG.NE.1
  254. $ .OR.N2DCOL.NE.1.OR.NDNOEU.NE.1
  255. $ .OR.(NDELM.NE.1.AND.NDELM.NE.NBEL)) THEN
  256. WRITE(IOIMP,*) 'Erreur dims MZMCHA'
  257. GOTO 9999
  258. ENDIF
  259.  
  260. DO IBEL=1,NBEL
  261. IF (NDELM.EQ.1) THEN
  262. IDELM=1
  263. ELSE
  264. IDELM=IBEL
  265. ENDIF
  266. DO IDDL=1,NDDL
  267. IF (NDLIG.EQ.1) THEN
  268. ILIG=1
  269. ICOL=IDDL
  270. ELSE
  271. ILIG=IDDL
  272. ICOL=1
  273. ENDIF
  274. NNQUA=MYLRF.NPQUAF(IDDL)
  275. NNGLO=SOUMAI.NUM(NNQUA,IBEL)
  276. NNLOC=KRIGEO.LECT(NNGLO)
  277. IF (NNLOC.EQ.0) THEN
  278. WRITE(IOIMP,*) 'Erreur de programmation 1'
  279. GOTO 9999
  280. ENDIF
  281. ININ=MYLRF.NUMCMP(IDDL)
  282. MYMTRA.IBIN(ININ,NNLOC)=1
  283. MYMTRA.BB(ININ,NNLOC)=MYMTRA.BB(ININ,NNLOC)
  284. $ +MZMCHA.VELCHE(ILIG,ICOL,1,1,1,IDELM)
  285. ENDDO
  286. ENDDO
  287. SEGDES,MYLRF
  288. SEGDES,MZMCHA
  289. ENDIF
  290. SEGDES,SOUMAI
  291. 5 CONTINUE
  292. SEGDES,MYMCHA
  293. SEGSUP,KRIGEO
  294. *
  295. * Transformation l'objet MTRAV en chpoint
  296. *
  297. CALL CRECHP(MYMTRA,MYCHPO)
  298. SEGSUP MYMTRA
  299. SEGACT MYCHPO*MOD
  300. MYCHPO.JATTRI(1)=2
  301. SEGDES MYCHPO
  302. * IMPR=6
  303. IF (IMPR.GT.3) THEN
  304. WRITE(IOIMP,*) 'On a créé MYCHPO=',MYCHPO
  305. CALL ECROBJ('CHPOINT ',MYCHPO)
  306. CALL PRLIST
  307. ENDIF
  308. * IMPR=0
  309. *
  310. * Normal termination
  311. *
  312. IRET=0
  313. RETURN
  314. *
  315. * Format handling
  316. *
  317. *
  318. * Error handling
  319. *
  320. 9999 CONTINUE
  321. IRET=1
  322. WRITE(IOIMP,*) 'An error was detected in subroutine cv2cp9'
  323. RETURN
  324. *
  325. * End of subroutine CV2CP9
  326. *
  327. END
  328.  
  329.  
  330.  
  331.  

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