Télécharger cv2ma9.eso

Retour à la liste

Numérotation des lignes :

  1. C CV2MA9 SOURCE CHAT 09/10/09 21:16:48 6519
  2. SUBROUTINE CV2MA9(MDISCP,NCVARP,MDISCD,NCVARD,
  3. $ IMTLS9,
  4. $ MYFALS,
  5. $ MATLS9,
  6. $ IMPR,IRET)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. IMPLICIT INTEGER (I-N)
  9. C***********************************************************************
  10. C NOM : CV2MA9
  11. C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments)
  12. C représentant un ensemble de matrices élémentaires en
  13. C RIGIDITE...
  14. C
  15. C LANGAGE : ESOPE
  16. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17. C mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES : KEEF (recherche de l'élément fini)
  20. C APPELES (E/S) : ECROBJ, PRLIST (écriture entier, objet,
  21. C impression)
  22. C APPELE PAR : PRLS92
  23. C***********************************************************************
  24. C ENTREES :
  25. C ENTREES/SORTIES : -
  26. C SORTIES :
  27. C TRAVAIL : * MYMEL (type MELEME) : maillage élémentaire.
  28. C * JMTLS9 (type MCHEVA) : valeurs du champ IMTLS9
  29. C sur le maillage élémentaire.
  30. C Structure (cf.include SMCHAEL) :
  31. C (nb. ddl dual, nb. ddl primal,
  32. C nb. comp. duales, nb. comp. primales,
  33. C 1, nb. éléments)
  34. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  35. C***********************************************************************
  36. C VERSION : v1, 26/09/03, version initiale
  37. C HISTORIQUE : v1, 26/09/03, création
  38. C HISTORIQUE :
  39. C HISTORIQUE :
  40. C***********************************************************************
  41. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  42. C en cas de modification de ce sous-programme afin de faciliter
  43. C la maintenance !
  44. C***********************************************************************
  45. -INC CCOPTIO
  46. -INC SMLMOTS
  47. POINTEUR NCVARP.MLMOTS
  48. POINTEUR NCVARD.MLMOTS
  49. -INC SMELEME
  50. POINTEUR MYMEL.MELEME
  51. POINTEUR RIGMEL.MELEME
  52. INTEGER NBNN,NBELEM,NBSOUS,NBREF
  53. -INC SMLENTI
  54. POINTEUR LPOQUF.MLENTI
  55. POINTEUR KPOQUF.MLENTI
  56. INTEGER JG
  57. -INC SMRIGID
  58. POINTEUR MATLS9.MRIGID
  59. POINTEUR MYDSCR.DESCR
  60. POINTEUR MYIMAT.IMATRI
  61. POINTEUR MYXMAT.XMATRI
  62. INTEGER NRIGE,NRIGEL,NELRIG,NLIGRP,NLIGRD
  63. *
  64. * Includes persos
  65. *
  66. CBEGININCLUDE SMCHAEL
  67. SEGMENT MCHAEL
  68. POINTEUR IMACHE(N1).MELEME
  69. POINTEUR ICHEVA(N1).MCHEVA
  70. ENDSEGMENT
  71. SEGMENT MCHEVA
  72. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  73. ENDSEGMENT
  74. SEGMENT LCHEVA
  75. POINTEUR LISCHE(NBCHE).MCHEVA
  76. ENDSEGMENT
  77. CENDINCLUDE SMCHAEL
  78. POINTEUR IMTLS9.MCHAEL
  79. POINTEUR JMTLS9.MCHEVA
  80. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  81. CBEGININCLUDE SFALRF
  82. SEGMENT FALRF
  83. CHARACTER*(LNNFA) NOMFA
  84. INTEGER NUQUAF(NBLRF)
  85. POINTEUR ELEMF(NBLRF).ELREF
  86. ENDSEGMENT
  87. SEGMENT FALRFS
  88. POINTEUR LISFA(0).FALRF
  89. ENDSEGMENT
  90. CENDINCLUDE SFALRF
  91. POINTEUR MYFALS.FALRFS
  92. CBEGININCLUDE SELREF
  93. SEGMENT ELREF
  94. CHARACTER*(LNNOM) NOMLRF
  95. CHARACTER*(LNFORM) FORME
  96. CHARACTER*(LNTYPL) TYPEL
  97. CHARACTER*(LNESP) ESPACE
  98. INTEGER DEGRE
  99. REAL*8 XCONOD(NDIMEL,NBNOD)
  100. INTEGER NPQUAF(NBDDL)
  101. INTEGER NUMCMP(NBDDL)
  102. INTEGER QUENOD(NBDDL)
  103. INTEGER ORDDER(NDIMEL,NBDDL)
  104. POINTEUR MBPOLY.POLYNS
  105. ENDSEGMENT
  106. SEGMENT ELREFS
  107. POINTEUR LISEL(0).ELREF
  108. ENDSEGMENT
  109. CENDINCLUDE SELREF
  110. POINTEUR LRFPRI.ELREF
  111. POINTEUR LRFDUA.ELREF
  112. *
  113. CHARACTER*4 MDISCP,MDISCD
  114. INTEGER IMPR,IRET
  115. *
  116. INTEGER IBNN,IBELEM
  117. INTEGER ITQUAF,NDDLPR,NDDLDU
  118. INTEGER IDDLPR,IDDLDU
  119. INTEGER NSOUS,NPOQUF
  120. INTEGER ISOUS
  121. INTEGER ILIGRP,ILIGRD,IELRIG,ICMPP,ICMPD
  122.  
  123. *
  124. * Executable statements
  125. *
  126. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2ma9'
  127. NRIGE=7
  128. NRIGEL=0
  129. SEGINI,MATLS9
  130. MATLS9.MTYMAT='LEASTSQU'
  131. *
  132. * Remplissage de MRIGID
  133. *
  134. SEGACT NCVARP
  135. SEGACT NCVARD
  136. SEGACT IMTLS9
  137. NSOUS=IMTLS9.IMACHE(/1)
  138. C SEGPRT,NCVARP
  139. C SEGPRT,NCVARD
  140. C SEGPRT,IMTLS9
  141. DO ISOUS=1,NSOUS
  142. JMTLS9=IMTLS9.ICHEVA(ISOUS)
  143. IF (JMTLS9.NE.0) THEN
  144. C SEGPRT,NCVARP
  145. C SEGPRT,NCVARD
  146. C SEGPRT,JMTLS9
  147. MYMEL =IMTLS9.IMACHE(ISOUS)
  148. SEGACT MYMEL
  149. ITQUAF=MYMEL.ITYPEL
  150. CALL KEEF(ITQUAF,MDISCP,MYFALS,
  151. $ LRFPRI,IMPR,IRET)
  152. IF (IRET.NE.0) GOTO 9999
  153. SEGACT LRFPRI
  154. NDDLPR=LRFPRI.NPQUAF(/1)
  155. CALL KEEF(ITQUAF,MDISCD,MYFALS,
  156. $ LRFDUA,IMPR,IRET)
  157. IF (IRET.NE.0) GOTO 9999
  158. SEGACT LRFDUA
  159. NDDLDU=LRFDUA.NPQUAF(/1)
  160. *
  161. * remplissage du segment DISCR
  162. *
  163. * Construction de la liste des points du QUAF sur lesquels il y a des
  164. * ddl
  165. JG=0
  166. SEGINI LPOQUF
  167. DO IDDLPR=1,NDDLPR
  168. LPOQUF.LECT(**)=LRFPRI.NPQUAF(IDDLPR)
  169. ENDDO
  170. DO IDDLDU=1,NDDLDU
  171. LPOQUF.LECT(**)=LRFDUA.NPQUAF(IDDLDU)
  172. ENDDO
  173. * Suppression des doublons
  174. CALL IUNIQ(LPOQUF.LECT,LPOQUF.LECT(/1),
  175. $ LPOQUF.LECT,NPOQUF,
  176. $ IMPR,IRET)
  177. IF (IRET.NE.0) GOTO 9999
  178. JG=NPOQUF
  179. SEGADJ,LPOQUF
  180. * Segment de repérage dans cette liste
  181. JG=MYMEL.NUM(/1)
  182. SEGINI,KPOQUF
  183. CALL RSETXI(KPOQUF.LECT,LPOQUF.LECT,LPOQUF.LECT(/1))
  184. NLIGRP=NDDLPR
  185. NLIGRD=NDDLDU
  186. SEGINI MYDSCR
  187. DO ILIGRP=1,NLIGRP
  188. ICMPP=LRFPRI.NUMCMP(ILIGRP)
  189. MYDSCR.LISINC(ILIGRP)=NCVARP.MOTS(ICMPP)
  190. MYDSCR.NOELEP(ILIGRP)=
  191. $ KPOQUF.LECT(LRFPRI.NPQUAF(ILIGRP))
  192. ENDDO
  193. DO ILIGRD=1,NLIGRD
  194. ICMPD=LRFDUA.NUMCMP(ILIGRD)
  195. MYDSCR.LISDUA(ILIGRD)=NCVARD.MOTS(ICMPD)
  196. MYDSCR.NOELED(ILIGRD)=
  197. $ KPOQUF.LECT(LRFDUA.NPQUAF(ILIGRD))
  198. ENDDO
  199. SEGDES MYDSCR
  200. SEGDES LRFDUA
  201. SEGDES LRFPRI
  202. SEGSUP KPOQUF
  203. *
  204. * remplissage du maillage pour la rigidité
  205. *
  206. NBNN=NPOQUF
  207. NBELEM=MYMEL.NUM(/2)
  208. NBSOUS=0
  209. NBREF=0
  210. SEGINI,RIGMEL
  211. * Type 32 POLY
  212. RIGMEL.ITYPEL=32
  213. DO IBELEM=1,NBELEM
  214. DO IBNN=1,NBNN
  215. RIGMEL.NUM(IBNN,IBELEM)=
  216. $ MYMEL.NUM(LPOQUF.LECT(IBNN),IBELEM)
  217. ENDDO
  218. ENDDO
  219. SEGDES RIGMEL
  220. SEGSUP LPOQUF
  221. SEGDES MYMEL
  222. *
  223. * remplissage des matrices élémentaires
  224. *
  225. SEGACT JMTLS9
  226. NBLIG=JMTLS9.VELCHE(/1)
  227. NBCOL=JMTLS9.VELCHE(/2)
  228. N2LIG=JMTLS9.VELCHE(/3)
  229. N2COL=JMTLS9.VELCHE(/4)
  230. NBPOI=JMTLS9.VELCHE(/5)
  231. NBELM=JMTLS9.VELCHE(/6)
  232. IF (NBLIG.NE.NDDLDU.OR.NBCOL.NE.NDDLPR.OR.N2LIG.NE.1
  233. $ .OR.N2COL.NE.1.OR.NBPOI.NE.1) THEN
  234. WRITE(IOIMP,*) 'Erreur dims JMTLS9'
  235. GOTO 9999
  236. ENDIF
  237. NELRIG=NBELM
  238. nligrp=nddlpr
  239. nligrd=nddldu
  240. SEGINI MYxMAT
  241. DO IELRIG=1,NELRIG
  242. * NLIGRP=NDDLPR
  243. * NLIGRD=NDDLDU
  244. * SEGINI MYXMAT
  245. DO ILIGRP=1,NLIGRP
  246. DO ILIGRD=1,NLIGRD
  247. MYXMAT.RE(ILIGRD,ILIGRP,ielrig)=
  248. $ JMTLS9.VELCHE(ILIGRD,ILIGRP,1,1,1,IELRIG)
  249. ENDDO
  250. ENDDO
  251. * SEGDES MYXMAT
  252. * MYIMAT.IMATTT(IELRIG)=MYXMAT
  253. ENDDO
  254. SEGDES MYxMAT
  255. SEGDES JMTLS9
  256. *
  257. * remplissage du chapeau
  258. *
  259. NRIGE=MATLS9.IRIGEL(/1)
  260. NRIGEL=MATLS9.IRIGEL(/2)+1
  261. SEGADJ,MATLS9
  262. MATLS9.COERIG(NRIGEL)=1.D0
  263. MATLS9.IRIGEL(1,NRIGEL)=RIGMEL
  264. MATLS9.IRIGEL(2,NRIGEL)=0
  265. MATLS9.IRIGEL(3,NRIGEL)=MYDSCR
  266. MATLS9.IRIGEL(4,NRIGEL)=MYxMAT
  267. MATLS9.IRIGEL(5,NRIGEL)=0
  268. MATLS9.IRIGEL(6,NRIGEL)=0
  269. *
  270. * la matrice ne possède pas de symétries (a priori...)
  271. *
  272. MATLS9.IRIGEL(7,NRIGEL)=2
  273. ENDIF
  274. ENDDO
  275. SEGDES IMTLS9
  276. SEGDES NCVARD
  277. SEGDES NCVARP
  278. SEGDES MATLS9
  279. IF (IMPR.GT.3) THEN
  280. WRITE(IOIMP,*) 'On a créé MATLS9=',MATLS9
  281. CALL ECROBJ('RIGIDITE',MATLS9)
  282. CALL PRLIST
  283. ENDIF
  284. *
  285. * Normal termination
  286. *
  287. IRET=0
  288. RETURN
  289. *
  290. * Format handling
  291. *
  292. *
  293. * Error handling
  294. *
  295. 9999 CONTINUE
  296. IRET=1
  297. WRITE(IOIMP,*) 'An error was detected in subroutine cv2ma9'
  298. RETURN
  299. *
  300. * End of subroutine CV2MA9
  301. *
  302. END
  303.  
  304.  
  305.  
  306.  
  307.  

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