Télécharger cv2ma9.eso

Retour à la liste

Numérotation des lignes :

  1. C CV2MA9 SOURCE GOUNAND 20/03/16 21:15:01 10551
  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.  
  46. -INC PPARAM
  47. -INC CCOPTIO
  48. -INC SMLMOTS
  49. POINTEUR NCVARP.MLMOTS
  50. POINTEUR NCVARD.MLMOTS
  51. -INC SMELEME
  52. POINTEUR MYMEL.MELEME
  53. POINTEUR RIGMEL.MELEME
  54. INTEGER NBNN,NBELEM,NBSOUS,NBREF
  55. -INC SMLENTI
  56. POINTEUR LPOQUF.MLENTI
  57. POINTEUR KPOQUF.MLENTI
  58. INTEGER JG
  59. -INC SMRIGID
  60. POINTEUR MATLS9.MRIGID
  61. POINTEUR MYDSCR.DESCR
  62. POINTEUR MYIMAT.IMATRI
  63. POINTEUR MYXMAT.XMATRI
  64. INTEGER NRIGE,NRIGEL,NELRIG,NLIGRP,NLIGRD
  65. *
  66. * Includes persos
  67. *
  68. CBEGININCLUDE SMCHAEL
  69. SEGMENT MCHAEL
  70. POINTEUR IMACHE(N1).MELEME
  71. POINTEUR ICHEVA(N1).MCHEVA
  72. ENDSEGMENT
  73. SEGMENT MCHEVA
  74. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  75. ENDSEGMENT
  76. SEGMENT LCHEVA
  77. POINTEUR LISCHE(NBCHE).MCHEVA
  78. ENDSEGMENT
  79. CENDINCLUDE SMCHAEL
  80. POINTEUR IMTLS9.MCHAEL
  81. POINTEUR JMTLS9.MCHEVA
  82. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  83. CBEGININCLUDE SFALRF
  84. SEGMENT FALRF
  85. CHARACTER*(LNNFA) NOMFA
  86. INTEGER NUQUAF(NBLRF)
  87. POINTEUR ELEMF(NBLRF).ELREF
  88. ENDSEGMENT
  89. SEGMENT FALRFS
  90. POINTEUR LISFA(0).FALRF
  91. ENDSEGMENT
  92. CENDINCLUDE SFALRF
  93. POINTEUR MYFALS.FALRFS
  94. CBEGININCLUDE SELREF
  95. SEGMENT ELREF
  96. CHARACTER*(LNNOM) NOMLRF
  97. CHARACTER*(LNFORM) FORME
  98. CHARACTER*(LNTYPL) TYPEL
  99. CHARACTER*(LNESP) ESPACE
  100. INTEGER DEGRE
  101. REAL*8 XCONOD(NDIMEL,NBNOD)
  102. INTEGER NPQUAF(NBDDL)
  103. INTEGER NUMCMP(NBDDL)
  104. INTEGER QUENOD(NBDDL)
  105. INTEGER ORDDER(NDIMEL,NBDDL)
  106. POINTEUR MBPOLY.POLYNS
  107. ENDSEGMENT
  108. SEGMENT ELREFS
  109. POINTEUR LISEL(0).ELREF
  110. ENDSEGMENT
  111. CENDINCLUDE SELREF
  112. POINTEUR LRFPRI.ELREF
  113. POINTEUR LRFDUA.ELREF
  114. *
  115. CHARACTER*4 MDISCP,MDISCD
  116. INTEGER IMPR,IRET
  117. *
  118. INTEGER IBNN,IBELEM
  119. INTEGER ITQUAF,NDDLPR,NDDLDU
  120. INTEGER IDDLPR,IDDLDU
  121. INTEGER NSOUS,NPOQUF
  122. INTEGER ISOUS
  123. INTEGER ILIGRP,ILIGRD,IELRIG,ICMPP,ICMPD
  124.  
  125. *
  126. * Executable statements
  127. *
  128. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2ma9'
  129. NRIGE=7
  130. NRIGEL=0
  131. SEGINI,MATLS9
  132. MATLS9.MTYMAT='LEASTSQU'
  133. *
  134. * Remplissage de MRIGID
  135. *
  136. SEGACT NCVARP
  137. SEGACT NCVARD
  138. SEGACT IMTLS9
  139. NSOUS=IMTLS9.IMACHE(/1)
  140. C SEGPRT,NCVARP
  141. C SEGPRT,NCVARD
  142. C SEGPRT,IMTLS9
  143. DO ISOUS=1,NSOUS
  144. JMTLS9=IMTLS9.ICHEVA(ISOUS)
  145. IF (JMTLS9.NE.0) THEN
  146. C SEGPRT,NCVARP
  147. C SEGPRT,NCVARD
  148. C SEGPRT,JMTLS9
  149. MYMEL =IMTLS9.IMACHE(ISOUS)
  150. SEGACT MYMEL
  151. ITQUAF=MYMEL.ITYPEL
  152. CALL KEEF(ITQUAF,MDISCP,MYFALS,
  153. $ LRFPRI,IMPR,IRET)
  154. IF (IRET.NE.0) GOTO 9999
  155. SEGACT LRFPRI
  156. NDDLPR=LRFPRI.NPQUAF(/1)
  157. CALL KEEF(ITQUAF,MDISCD,MYFALS,
  158. $ LRFDUA,IMPR,IRET)
  159. IF (IRET.NE.0) GOTO 9999
  160. SEGACT LRFDUA
  161. NDDLDU=LRFDUA.NPQUAF(/1)
  162. *
  163. * remplissage du segment DISCR
  164. *
  165. * Construction de la liste des points du QUAF sur lesquels il y a des
  166. * ddl
  167. JG=0
  168. SEGINI LPOQUF
  169. DO IDDLPR=1,NDDLPR
  170. LPOQUF.LECT(**)=LRFPRI.NPQUAF(IDDLPR)
  171. ENDDO
  172. DO IDDLDU=1,NDDLDU
  173. LPOQUF.LECT(**)=LRFDUA.NPQUAF(IDDLDU)
  174. ENDDO
  175. * Suppression des doublons
  176. CALL IUNIQ(LPOQUF.LECT,LPOQUF.LECT(/1),
  177. $ LPOQUF.LECT,NPOQUF,
  178. $ IMPR,IRET)
  179. IF (IRET.NE.0) GOTO 9999
  180. JG=NPOQUF
  181. SEGADJ,LPOQUF
  182. * Segment de repérage dans cette liste
  183. JG=MYMEL.NUM(/1)
  184. SEGINI,KPOQUF
  185. CALL RSETXI(KPOQUF.LECT,LPOQUF.LECT,LPOQUF.LECT(/1))
  186. NLIGRP=NDDLPR
  187. NLIGRD=NDDLDU
  188. SEGINI MYDSCR
  189. DO ILIGRP=1,NLIGRP
  190. ICMPP=LRFPRI.NUMCMP(ILIGRP)
  191. MYDSCR.LISINC(ILIGRP)=NCVARP.MOTS(ICMPP)
  192. MYDSCR.NOELEP(ILIGRP)=
  193. $ KPOQUF.LECT(LRFPRI.NPQUAF(ILIGRP))
  194. ENDDO
  195. DO ILIGRD=1,NLIGRD
  196. ICMPD=LRFDUA.NUMCMP(ILIGRD)
  197. MYDSCR.LISDUA(ILIGRD)=NCVARD.MOTS(ICMPD)
  198. MYDSCR.NOELED(ILIGRD)=
  199. $ KPOQUF.LECT(LRFDUA.NPQUAF(ILIGRD))
  200. ENDDO
  201. SEGDES MYDSCR
  202. SEGDES LRFDUA
  203. SEGDES LRFPRI
  204. SEGSUP KPOQUF
  205. *
  206. * remplissage du maillage pour la rigidité
  207. *
  208. NBNN=NPOQUF
  209. NBELEM=MYMEL.NUM(/2)
  210. NBSOUS=0
  211. NBREF=0
  212. SEGINI,RIGMEL
  213. * Type 32 POLY
  214. RIGMEL.ITYPEL=32
  215. DO IBELEM=1,NBELEM
  216. DO IBNN=1,NBNN
  217. RIGMEL.NUM(IBNN,IBELEM)=
  218. $ MYMEL.NUM(LPOQUF.LECT(IBNN),IBELEM)
  219. ENDDO
  220. ENDDO
  221. SEGDES RIGMEL
  222. SEGSUP LPOQUF
  223. SEGDES MYMEL
  224. *
  225. * remplissage des matrices élémentaires
  226. *
  227. SEGACT JMTLS9
  228. NBLIG=JMTLS9.VELCHE(/1)
  229. NBCOL=JMTLS9.VELCHE(/2)
  230. N2LIG=JMTLS9.VELCHE(/3)
  231. N2COL=JMTLS9.VELCHE(/4)
  232. NBPOI=JMTLS9.VELCHE(/5)
  233. NBELM=JMTLS9.VELCHE(/6)
  234. IF (NBLIG.NE.NDDLDU.OR.NBCOL.NE.NDDLPR.OR.N2LIG.NE.1
  235. $ .OR.N2COL.NE.1.OR.NBPOI.NE.1) THEN
  236. WRITE(IOIMP,*) 'Erreur dims JMTLS9'
  237. GOTO 9999
  238. ENDIF
  239. NELRIG=NBELM
  240. nligrp=nddlpr
  241. nligrd=nddldu
  242. SEGINI MYxMAT
  243.  
  244. DO IELRIG=1,NELRIG
  245. * NLIGRP=NDDLPR
  246. * NLIGRD=NDDLDU
  247. * SEGINI MYXMAT
  248. DO ILIGRP=1,NLIGRP
  249. DO ILIGRD=1,NLIGRD
  250. MYXMAT.RE(ILIGRD,ILIGRP,ielrig)=
  251. $ JMTLS9.VELCHE(ILIGRD,ILIGRP,1,1,1,IELRIG)
  252. ENDDO
  253. ENDDO
  254. * SEGDES MYXMAT
  255. * MYIMAT.IMATTT(IELRIG)=MYXMAT
  256. ENDDO
  257. SEGDES JMTLS9
  258. *
  259. * remplissage du chapeau
  260. *
  261. NRIGE=MATLS9.IRIGEL(/1)
  262. NRIGEL=MATLS9.IRIGEL(/2)+1
  263. SEGADJ,MATLS9
  264. MATLS9.COERIG(NRIGEL)=1.D0
  265. MATLS9.IRIGEL(1,NRIGEL)=RIGMEL
  266. MATLS9.IRIGEL(2,NRIGEL)=0
  267. MATLS9.IRIGEL(3,NRIGEL)=MYDSCR
  268. MATLS9.IRIGEL(4,NRIGEL)=MYxMAT
  269. MATLS9.IRIGEL(5,NRIGEL)=0
  270. MATLS9.IRIGEL(6,NRIGEL)=0
  271. *
  272. * la matrice ne possède pas de symétries (a priori...)
  273. *
  274. MATLS9.IRIGEL(7,NRIGEL)=2
  275. myxmat.symre = 2
  276. SEGDES MYxMAT
  277. ENDIF
  278. ENDDO
  279. SEGDES IMTLS9
  280. SEGDES NCVARD
  281. SEGDES NCVARP
  282. SEGDES MATLS9
  283. IF (IMPR.GT.3) THEN
  284. WRITE(IOIMP,*) 'On a créé MATLS9=',MATLS9
  285. CALL ECROBJ('RIGIDITE',MATLS9)
  286. CALL PRLIST
  287. ENDIF
  288. *
  289. * Normal termination
  290. *
  291. IRET=0
  292. RETURN
  293. *
  294. * Format handling
  295. *
  296. *
  297. * Error handling
  298. *
  299. 9999 CONTINUE
  300. IRET=1
  301. WRITE(IOIMP,*) 'An error was detected in subroutine cv2ma9'
  302. RETURN
  303. *
  304. * End of subroutine CV2MA9
  305. *
  306. END
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  

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