Télécharger cv2mab.eso

Retour à la liste

Numérotation des lignes :

  1. C CV2MAB SOURCE PV 16/11/17 21:58:57 9180
  2. SUBROUTINE CV2MAB(MDISCP,NCVARP,MDISCD,NCVARD,
  3. $ IMTLSB,
  4. $ MYFALS,
  5. $ MATLSB,
  6. $ IMPR,IRET)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. IMPLICIT INTEGER (I-N)
  9. C***********************************************************************
  10. C NOM : CV2MAB
  11. C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments)
  12. C représentant un ensemble de matrices élémentaires en
  13. C MATRIK...
  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 : PRLSB2
  23. C***********************************************************************
  24. C ENTREES :
  25. C ENTREES/SORTIES : -
  26. C SORTIES :
  27. C TRAVAIL : * MYMEL (type MELEME) : maillage élémentaire.
  28. C * JMTLSB (type MCHEVA) : valeurs du champ IMTLSB
  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, 22/07/09, version initiale
  37. C HISTORIQUE : v1, 22/07/09, 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 MELPRI.MELEME
  51. POINTEUR MELDUA.MELEME
  52. POINTEUR MYMEL.MELEME
  53. INTEGER NBNN,NBELEM,NBSOUS,NBREF
  54. -INC SMLENTI
  55. POINTEUR LPOQFP.MLENTI
  56. POINTEUR LPOQFD.MLENTI
  57. POINTEUR KPOQFP.MLENTI
  58. POINTEUR KPOQFD.MLENTI
  59. INTEGER JG
  60. POINTEUR MATLSB.MATRIK
  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. POINTEUR IMTLSB.MCHAEL
  77. POINTEUR JMTLSB.MCHEVA
  78. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  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 LRFPRI.ELREF
  109. POINTEUR LRFDUA.ELREF
  110. *
  111. CHARACTER*4 MDISCP,MDISCD
  112. INTEGER IMPR,IRET
  113. *
  114. INTEGER IBNN,IBELEM
  115. INTEGER ITQUAF,NDDLPR,NDDLDU
  116. INTEGER IDDLPR,IDDLDU
  117. INTEGER NSOUS,NPOQUF
  118. INTEGER ISOUS
  119. INTEGER ILIGRP,ILIGRD,IELRIG,ICMPP,ICMPD
  120.  
  121. *
  122. * Executable statements
  123. *
  124. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2mab'
  125. NRIGE=7
  126. NMATRI=0
  127. NKID=9
  128. NKMT=7
  129. SEGINI,MATLSB
  130. *
  131. * Remplissage de MRIGID
  132. *
  133. SEGACT NCVARP
  134. SEGACT NCVARD
  135. SEGACT IMTLSB
  136. NSOUS=IMTLSB.IMACHE(/1)
  137. C SEGPRT,NCVARP
  138. C SEGPRT,NCVARD
  139. C SEGPRT,IMTLSB
  140. DO ISOUS=1,NSOUS
  141. JMTLSB=IMTLSB.ICHEVA(ISOUS)
  142. IF (JMTLSB.NE.0) THEN
  143. C SEGPRT,NCVARP
  144. C SEGPRT,NCVARD
  145. C SEGPRT,JMTLSB
  146. SEGACT JMTLSB
  147. MYMEL =IMTLSB.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. DO IVARP=1,NCVARP.MOTS(/2)
  161. * Construction de la liste des points du QUAF sur lesquels il y a des
  162. * ddl pour l'inconnue primale
  163. JG=0
  164. SEGINI LPOQFP
  165. DO IDDLPR=1,NDDLPR
  166. IF (LRFPRI.NUMCMP(IDDLPR).EQ.IVARP) THEN
  167. LPOQFP.LECT(**)=LRFPRI.NPQUAF(IDDLPR)
  168. ENDIF
  169. ENDDO
  170. IF (LPOQFP.LECT(/1).EQ.0) THEN
  171. GOTO 1
  172. ENDIF
  173. C* Suppression des doublons (pas besoin)
  174. C CALL IUNIQ(LPOQFP.LECT,LPOQFP.LECT(/1),
  175. C $ LPOQFP.LECT,NPOQFP,
  176. C $ IMPR,IRET)
  177. C IF (IRET.NE.0) GOTO 9999
  178. C JG=NPOQFP
  179. C SEGADJ,LPOQFP
  180. * Segment de repérage dans cette liste
  181. JG=MYMEL.NUM(/1)
  182. SEGINI,KPOQFP
  183. CALL RSETXI(KPOQFP.LECT,LPOQFP.LECT,LPOQFP.LECT(/1))
  184. * Construction du maillage primal
  185. NBNN=LPOQFP.LECT(/1)
  186. NBELEM = MYMEL.NUM(/2)
  187. NBSOUS = 0
  188. NBREF=0
  189. SEGINI,MELPRI
  190. * Type 32 POLY
  191. MELPRI.ITYPEL=32
  192. DO IBELEM=1,NBELEM
  193. DO IBNN=1,NBNN
  194. MELPRI.NUM(IBNN,IBELEM)=
  195. $ MYMEL.NUM(LPOQFP.LECT(IBNN),IBELEM)
  196. ENDDO
  197. ENDDO
  198. SEGDES MELPRI
  199. *
  200. DO IVARD=1,NCVARD.MOTS(/2)
  201. * Construction de la liste des points du QUAF sur lesquels il y a des
  202. * ddl pour l'inconnue duale
  203. JG=0
  204. SEGINI LPOQFD
  205. DO IDDLDU=1,NDDLDU
  206. IF (LRFDUA.NUMCMP(IDDLDU).EQ.IVARD) THEN
  207. LPOQFD.LECT(**)=LRFDUA.NPQUAF(IDDLDU)
  208. ENDIF
  209. ENDDO
  210. IF (LPOQFD.LECT(/1).EQ.0) THEN
  211. GOTO 3
  212. ENDIF
  213. C* Suppression des doublons
  214. C CALL IUNIQ(LPOQFD.LECT,LPOQFD.LECT(/1),
  215. C $ LPOQFD.LECT,NPOQFD,
  216. C $ IMPR,IRET)
  217. C IF (IRET.NE.0) GOTO 9999
  218. C JG=NPOQFD
  219. C SEGADJ,LPOQFD
  220. * Segment de repérage dans cette liste
  221. JG=MYMEL.NUM(/1)
  222. SEGINI,KPOQFD
  223. CALL RSETXI(KPOQFD.LECT,LPOQFD.LECT,LPOQFD.LECT(/1))
  224. * Construction du maillage dual
  225. NBNN=LPOQFD.LECT(/1)
  226. NBELEM = MYMEL.NUM(/2)
  227. NBSOUS = 0
  228. NBREF=0
  229. SEGINI,MELDUA
  230. * Type 32 POLY
  231. MELDUA.ITYPEL=32
  232. DO IBELEM=1,NBELEM
  233. DO IBNN=1,NBNN
  234. MELDUA.NUM(IBNN,IBELEM)=
  235. $ MYMEL.NUM(LPOQFD.LECT(IBNN),IBELEM)
  236. ENDDO
  237. ENDDO
  238. SEGDES MELDUA
  239. * Construction du IMATRI
  240. NBME=1
  241. NBSOUS=1
  242. SEGINI IMATRI
  243. LISPRI(1)=NCVARP.MOTS(IVARP)
  244. LISDUA(1)=NCVARD.MOTS(IVARD)
  245. * Construction du IZAFM
  246. NBEL=MYMEL.NUM(/2)
  247. NP=LPOQFP.LECT(/1)
  248. MP=LPOQFD.LECT(/1)
  249. SEGINI IZAFM
  250. * remplissage des matrices élémentaires
  251. NBLIG=JMTLSB.VELCHE(/1)
  252. NBCOL=JMTLSB.VELCHE(/2)
  253. N2LIG=JMTLSB.VELCHE(/3)
  254. N2COL=JMTLSB.VELCHE(/4)
  255. NBPOI=JMTLSB.VELCHE(/5)
  256. NBELM=JMTLSB.VELCHE(/6)
  257. IF (NBLIG.NE.NDDLDU.OR.NBCOL.NE.NDDLPR.OR.N2LIG.NE.1
  258. $ .OR.N2COL.NE.1.OR.NBPOI.NE.1.OR.NBELM.NE.NBEL)
  259. $ THEN
  260. WRITE(IOIMP,*) 'Erreur dims JMTLSB'
  261. GOTO 9999
  262. ENDIF
  263. DO IDDLDU=1,NDDLDU
  264. IF (LRFDUA.NUMCMP(IDDLDU).EQ.IVARD) THEN
  265. IMP=KPOQFD.LECT(LRFDUA.NPQUAF(IDDLDU))
  266. DO IDDLPR=1,NDDLPR
  267. IF (LRFPRI.NUMCMP(IDDLPR).EQ.IVARP) THEN
  268. INP=KPOQFP.LECT(LRFPRI.NPQUAF(IDDLPR))
  269. DO IBEL=1,NBEL
  270. AM(IBEL,INP,IMP)=
  271. $ JMTLSB.VELCHE(IDDLDU,IDDLPR,
  272. $ 1,1,1,IBEL)
  273. ENDDO
  274. ENDIF
  275. ENDDO
  276. ENDIF
  277. ENDDO
  278. SEGDES IZAFM
  279. LIZAFM(1,1)=IZAFM
  280. SEGDES IMATRI
  281. *
  282. * Remplissage du chapeau
  283. *
  284. NRIGE=MATLSB.IRIGEL(/1)
  285. NMATRI=MATLSB.IRIGEL(/2)+1
  286. NKID=MATLSB.KIDMAT(/1)
  287. NKMT=MATLSB.KKMMT(/1)
  288. SEGADJ,MATLSB
  289. MATLSB.IRIGEL(1,NMATRI)=MELPRI
  290. MATLSB.IRIGEL(2,NMATRI)=MELDUA
  291. MATLSB.IRIGEL(4,NMATRI)=IMATRI
  292. MATLSB.IRIGEL(7,NMATRI)=2
  293. SEGSUP KPOQFD
  294. 3 CONTINUE
  295. SEGSUP LPOQFD
  296. ENDDO
  297. SEGSUP KPOQFP
  298. 1 CONTINUE
  299. SEGSUP LPOQFP
  300. ENDDO
  301. SEGDES LRFDUA
  302. SEGDES LRFPRI
  303. SEGDES MYMEL
  304. SEGDES JMTLSB
  305. ENDIF
  306. ENDDO
  307. SEGDES IMTLSB
  308. SEGDES NCVARD
  309. SEGDES NCVARP
  310. SEGDES MATLSB
  311. IF (IMPR.GT.3) THEN
  312. WRITE(IOIMP,*) 'On a créé MATLSB=',MATLSB
  313. CALL ECROBJ('MATRIK ',MATLSB)
  314. CALL PRLIST
  315. ENDIF
  316. *
  317. * Normal termination
  318. *
  319. IRET=0
  320. RETURN
  321. *
  322. * Format handling
  323. *
  324. *
  325. * Error handling
  326. *
  327. 9999 CONTINUE
  328. IRET=1
  329. WRITE(IOIMP,*) 'An error was detected in subroutine cv2mab'
  330. RETURN
  331. *
  332. * End of subroutine CV2MAB
  333. *
  334. END
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  

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