Télécharger cp2cv7.eso

Retour à la liste

Numérotation des lignes :

  1. C CP2CV7 SOURCE GOUNAND 07/07/30 21:15:08 5819
  2. SUBROUTINE CP2CV7(CGEOME,MYLMOT,MYDISC,MYCHPO,MYREAL,
  3. $ MYFALS,
  4. $ MYMCHA,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : CP2CV7
  10. C DESCRIPTION : Transforme un chpoint en MCHAEL
  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 : PRLS63
  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, 24/09/03, version initiale
  36. C HISTORIQUE : v1, 24/09/03, 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 CGEOME.MELEME
  53. POINTEUR SOUMAI.MELEME
  54. -INC SMLMOTS
  55. POINTEUR MYLMOT.MLMOTS
  56. INTEGER JGN
  57. -INC SMLENTI
  58. POINTEUR KRIGEO.MLENTI
  59. POINTEUR KRINCO.MLENTI
  60. INTEGER JG
  61. *
  62. * Includes persos
  63. *
  64. CBEGININCLUDE SMCHAEL
  65. SEGMENT MCHAEL
  66. POINTEUR IMACHE(N1).MELEME
  67. POINTEUR ICHEVA(N1).MCHEVA
  68. ENDSEGMENT
  69. SEGMENT MCHEVA
  70. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  71. ENDSEGMENT
  72. SEGMENT LCHEVA
  73. POINTEUR LISCHE(NBCHE).MCHEVA
  74. ENDSEGMENT
  75. CENDINCLUDE SMCHAEL
  76. INTEGER N1
  77. POINTEUR MYMCHA.MCHAEL
  78. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  79. POINTEUR MZMCHA.MCHEVA
  80. CBEGININCLUDE SFALRF
  81. SEGMENT FALRF
  82. CHARACTER*(LNNFA) NOMFA
  83. INTEGER NUQUAF(NBLRF)
  84. POINTEUR ELEMF(NBLRF).ELREF
  85. ENDSEGMENT
  86. SEGMENT FALRFS
  87. POINTEUR LISFA(0).FALRF
  88. ENDSEGMENT
  89. CENDINCLUDE SFALRF
  90. POINTEUR MYFALS.FALRFS
  91. CBEGININCLUDE SELREF
  92. SEGMENT ELREF
  93. CHARACTER*(LNNOM) NOMLRF
  94. CHARACTER*(LNFORM) FORME
  95. CHARACTER*(LNTYPL) TYPEL
  96. CHARACTER*(LNESP) ESPACE
  97. INTEGER DEGRE
  98. REAL*8 XCONOD(NDIMEL,NBNOD)
  99. INTEGER NPQUAF(NBDDL)
  100. INTEGER NUMCMP(NBDDL)
  101. INTEGER QUENOD(NBDDL)
  102. INTEGER ORDDER(NDIMEL,NBDDL)
  103. POINTEUR MBPOLY.POLYNS
  104. ENDSEGMENT
  105. SEGMENT ELREFS
  106. POINTEUR LISEL(0).ELREF
  107. ENDSEGMENT
  108. CENDINCLUDE SELREF
  109. POINTEUR MYLRF.ELREF
  110. *
  111. CHARACTER*(4) MYDISC
  112. INTEGER IMPR,IRET
  113. *
  114. INTEGER IBEL,IDDL,ISOUS,ITQUAF
  115. INTEGER NBEL,NDDL,NSOUS
  116. INTEGER NMLOC,NMQUA,NNGLO,NNLOC,NNMDDL,NNQUA
  117. INTEGER NTOGPO
  118. LOGICAL LDDLEX
  119. REAL*8 MYREAL
  120. REAL*8 CONTRI
  121. LOGICAL LWARN,LVIDE
  122. *
  123. * Executable statements
  124. *
  125. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cp2cv7'
  126.  
  127. * Transformation du chpoint en un objet MTRAV plus commode
  128. *
  129. IF (MYCHPO.EQ.0) THEN
  130. MYMCHA=0
  131. ELSEIF (MYCHPO.LT.0) THEN
  132. SEGACT CGEOME
  133. NSOUS=CGEOME.LISOUS(/1)
  134. N1=NSOUS
  135. SEGINI MYMCHA
  136. DO 2 ISOUS=1,NSOUS
  137. SOUMAI=CGEOME.LISOUS(ISOUS)
  138. SEGACT SOUMAI
  139. * On cherche l'élément fini correspondant au QUAF
  140. ITQUAF=SOUMAI.ITYPEL
  141. CALL KEEF(ITQUAF,MYDISC,
  142. $ MYFALS,
  143. $ MYLRF,
  144. $ IMPR,IRET)
  145. IF (IRET.NE.0) GOTO 9999
  146. SEGACT MYLRF
  147. NDDL=MYLRF.NPQUAF(/1)
  148. * NBEL=SOUMAI.NUM(/2)
  149. * On initialise le MCHEVA a remplir
  150. NBLIG=1
  151. NBCOL=NDDL
  152. N2LIG=1
  153. N2COL=1
  154. NBPOI=1
  155. * Astuce !
  156. NBELM=1
  157. SEGINI MZMCHA
  158. DO IDDL=1,NDDL
  159. MZMCHA.VELCHE(1,IDDL,1,1,1,1)=
  160. $ MYREAL
  161. ENDDO
  162. SEGDES MZMCHA
  163. MYMCHA.ICHEVA(ISOUS)=MZMCHA
  164. SEGDES MYLRF
  165. SEGDES SOUMAI
  166. MYMCHA.IMACHE(ISOUS)=SOUMAI
  167. 2 CONTINUE
  168. SEGDES MYMCHA
  169. SEGDES CGEOME
  170. ELSE
  171. CALL CP2TRA(MYCHPO,
  172. $ MYMTRA,LVIDE,
  173. $ IMPR,IRET)
  174. IF (IRET.NE.0) GOTO 9999
  175. *
  176. * Warning, si aucune valeur du chpoint n'a servi
  177. *
  178. *Pour débugger
  179. * LWARN=.TRUE.
  180. LWARN=.FALSE.
  181. *
  182. * Segments de repérage dans MTRAV
  183. *
  184. SEGACT MYMTRA
  185. JGN=MYMTRA.INCO(/1)
  186. NNIN=MYMTRA.INCO(/2)
  187. NNNOE=MYMTRA.IGEO(/1)
  188. * Création du segment de répérage dans IGEO
  189. NTOGPO=XCOOR(/1)/(IDIM+1)
  190. JG=NTOGPO
  191. SEGINI,KRIGEO
  192. CALL RSETEE(MYMTRA.IGEO,NNNOE,
  193. $ KRIGEO.LECT,NTOGPO,
  194. $ IMPR,IRET)
  195. IF (IRET.NE.0) GOTO 9999
  196. * Création du segment de repérage dans INCO
  197. SEGACT MYLMOT
  198. NNMDDL=MYLMOT.MOTS(/2)
  199. JG=NNMDDL
  200. SEGINI KRINCO
  201. CALL CREPE2(JGN,NNMDDL,NNIN,
  202. $ MYLMOT.MOTS,MYMTRA.INCO,
  203. $ KRINCO.LECT,
  204. $ IMPR,IRET)
  205. IF (IRET.NE.0) GOTO 9999
  206. *
  207. * Création et remplissage du champ par éléments
  208. *
  209. SEGACT CGEOME
  210. NSOUS=CGEOME.LISOUS(/1)
  211. N1=NSOUS
  212. SEGINI MYMCHA
  213. DO 1 ISOUS=1,NSOUS
  214. SOUMAI=CGEOME.LISOUS(ISOUS)
  215. SEGACT SOUMAI
  216. * SEGPRT,SOUMAI
  217. * On cherche l'élément fini correspondant au QUAF
  218. ITQUAF=SOUMAI.ITYPEL
  219. CALL KEEF(ITQUAF,MYDISC,
  220. $ MYFALS,
  221. $ MYLRF,
  222. $ IMPR,IRET)
  223. IF (IRET.NE.0) GOTO 9999
  224. SEGACT MYLRF
  225. NDDL=MYLRF.NPQUAF(/1)
  226. NBEL=SOUMAI.NUM(/2)
  227. * On initialise le MCHEVA a remplir
  228. NBLIG=1
  229. NBCOL=NDDL
  230. N2LIG=1
  231. N2COL=1
  232. NBPOI=1
  233. NBELM=NBEL
  234. SEGINI MZMCHA
  235. DO IBEL=1,NBEL
  236. DO IDDL=1,NDDL
  237. NNQUA=MYLRF.NPQUAF(IDDL)
  238. NNGLO=SOUMAI.NUM(NNQUA,IBEL)
  239. NNLOC=KRIGEO.LECT(NNGLO)
  240. NMQUA=MYLRF.NUMCMP(IDDL)
  241. NMLOC=KRINCO.LECT(NMQUA)
  242. IF (NNLOC.EQ.0.OR.NMLOC.EQ.0) THEN
  243. CONTRI=0.D0
  244. ELSE
  245. LDDLEX=MYMTRA.IBIN(NMLOC,NNLOC).EQ.1
  246. IF (.NOT.LDDLEX) THEN
  247. CONTRI=0.D0
  248. ELSE
  249. LWARN=.FALSE.
  250. CONTRI=MYMTRA.BB(NMLOC,NNLOC)
  251. ENDIF
  252. ENDIF
  253. MZMCHA.VELCHE(1,IDDL,1,1,1,IBEL)=CONTRI
  254. ENDDO
  255. ENDDO
  256. SEGDES MZMCHA
  257. * SEGPRT,MZMCHA
  258. MYMCHA.ICHEVA(ISOUS)=MZMCHA
  259. SEGDES MYLRF
  260. SEGDES SOUMAI
  261. MYMCHA.IMACHE(ISOUS)=SOUMAI
  262. 1 CONTINUE
  263. SEGDES MYMCHA
  264. SEGDES CGEOME
  265. SEGSUP KRINCO
  266. SEGDES MYLMOT
  267. SEGSUP KRIGEO
  268. SEGSUP MYMTRA
  269. * IMPR=6
  270. IF (IMPR.GT.3) THEN
  271. WRITE(IOIMP,*) 'On a créé',
  272. $ ' MYMCHA(élément ,1, 1 , 1 ,1, ddl)'
  273. CALL PRCAEL(MYMCHA,IMPR,IRET)
  274. IF (IRET.NE.0) GOTO 9999
  275. ENDIF
  276. *
  277. * Warning
  278. *
  279. IF (LWARN.AND.(.NOT.LVIDE)) THEN
  280. WRITE(IOIMP,*) 'Error : no values of the given CHPOINT',
  281. $ ' were used'
  282. GOTO 9999
  283. ENDIF
  284. ENDIF
  285. *
  286. * Normal termination
  287. *
  288. IRET=0
  289. RETURN
  290. *
  291. * Format handling
  292. *
  293. *
  294. * Error handling
  295. *
  296. 9999 CONTINUE
  297. IRET=1
  298. WRITE(IOIMP,*) 'An error was detected in subroutine cp2cv7'
  299. RETURN
  300. *
  301. * End of subroutine CP2CV7
  302. *
  303. END
  304.  
  305.  
  306.  
  307.  
  308.  

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