Télécharger prlin2.eso

Retour à la liste

Numérotation des lignes :

prlin2
  1. C PRLIN2 SOURCE PV 22/04/19 16:18:09 11344
  2. SUBROUTINE PRLIN2(CGEOM2,LGDISC,CSGEO2,TABCPR,TABCDU,METING,LAXI,
  3. $ LERF,LERJ,IRESO,IMREG,LCHAM,
  4. $ MATLIN,ICHLIN,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : PRLIN2
  10. C DESCRIPTION : Initialisations, tests et formatage des données et des
  11. C résultats pour nlin.
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES :
  18. C APPELE PAR : PRLIN
  19. C***********************************************************************
  20. C ENTREES :
  21. C SORTIES :
  22. C TRAVAIL :
  23. C
  24. C***********************************************************************
  25. C VERSION : v3.1, 30/07/04, possiblité de travailler
  26. C dans l'espace de référence
  27. C VERSION : v3, 10/05/04, refonte complète (modif SMTNLIN)
  28. C lois de comportement
  29. C VERSION : v2, 22/09/03, refonte complète (modif SMTNLIN)
  30. C VERSION : v1, 22/08/2003, version initiale
  31. C HISTORIQUE : v1, 22/08/2003, création
  32. C HISTORIQUE :
  33. C HISTORIQUE :
  34. C***********************************************************************
  35. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  36. C en cas de modification de ce sous-programme afin de faciliter
  37. C la maintenance !
  38. C***********************************************************************
  39.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. -INC SMELEME
  43. POINTEUR CGEOME.MELEME
  44. POINTEUR CGEOM2.MELEME
  45. POINTEUR CSGEO2.MELEME
  46. POINTEUR CGEOM3.MELEME
  47. POINTEUR CSGEO3.MELEME
  48. -INC SMTABLE
  49. POINTEUR TABCPR.MTABLE
  50. POINTEUR TABCDU.MTABLE
  51. -INC SMRIGID
  52. POINTEUR MATLIN.MRIGID
  53. -INC SMCHPOI
  54. POINTEUR CHPLIN.MCHPOI
  55. * Segments à moi
  56. -INC TNLIN
  57. *-INC SELREF
  58. POINTEUR MYLRFS.ELREFS
  59. *-INC SFALRF
  60. POINTEUR MYFALS.FALRFS
  61. *-INC SPOGAU
  62. POINTEUR MYPGS.POGAUS
  63. *-INC SFAPG
  64. POINTEUR MYFPGS.FAPGS
  65. *-INC SLCOMP
  66. POINTEUR MYCOMS.COMPS
  67. POINTEUR MYCOM.COMP
  68. *-INC SIQUAF
  69. POINTEUR MYQRFS.IQUAFS
  70. *-INC SFACTIV
  71. *-INC SMTNLIN
  72. *
  73. CHARACTER*4 LGDISC
  74. CHARACTER*4 METING
  75. CHARACTER*4 ITMP
  76. INTEGER LAXI
  77. INTEGER LERF
  78. LOGICAL LERJ
  79. INTEGER IMPR,IRET
  80. *
  81. INTEGER OOOVAL
  82. *
  83. * Executable statements
  84. *
  85. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prlin2'
  86. *
  87. * Initialisation du segment contenant les informations sur les
  88. * éléments de référence.
  89. *
  90. * SEGINI MYLRFS.LISEL(*)
  91. CALL INLRFS(MYLRFS,IMPR,IRET)
  92. IF (IRET.NE.0) GOTO 9999
  93. *
  94. * Initialisation du segment contenant les informations sur les
  95. * familles d'éléments de référence.
  96. *
  97. * SEGINI MYFALS.LISFA(*)
  98. CALL INFALS(MYFALS,MYLRFS,IMPR,IRET)
  99. IF (IRET.NE.0) GOTO 9999
  100. *
  101. * Initialisation du segment contenant les informations sur les
  102. * méthodes d'intégration (type Gauss).
  103. *
  104. * SEGINI MYPGS.LISPG(*)
  105. CALL INPGS(MYPGS,IMPR,IRET)
  106. IF (IRET.NE.0) GOTO 9999
  107. *
  108. * Initialisation du segment contenant les informations sur les
  109. * familles de méthodes d'intégration (type Gauss).
  110. *
  111. * SEGINI MYFPGS.LISFPG(*)
  112. CALL INFPGS(MYFPGS,MYPGS,IMPR,IRET)
  113. IF (IRET.NE.0) GOTO 9999
  114. *
  115. * Initialisation du segment contenant les informations sur les
  116. * lois de comportements
  117. *
  118. * SEGINI MYCOMS.LISCOM(*)
  119. * 19/01/2006
  120. * CALL INCOMS(MYCOMS,IMPR,IRET)
  121. CALL INCOMS(MYCOMS,CGEOM2,LERF,IMPR,IRET)
  122. IF (IRET.NE.0) GOTO 9999
  123. *
  124. * Initialisation du segment contenant les informations sur les
  125. * éléments QUAFs de référence.
  126. *
  127. IF (CSGEO2.NE.0) THEN
  128. * SEGINI MYQRFS
  129. CALL INQRFS(MYQRFS,IMPR,IRET)
  130. IF (IRET.NE.0) GOTO 9999
  131. * On régularise le maillage pour plus se faire chier si LISOUS(/1).EQ.0
  132. * In REGMAI : SEGINI CGEOM3
  133. CALL REGMA2(CGEOM2,CGEOM3,IMPR,IRET)
  134. IF (IRET.NE.0) GOTO 9999
  135. * In REGMAI : SEGINI CSGEO3
  136. CALL REGMA2(CSGEO2,CSGEO3,IMPR,IRET)
  137. IF (IRET.NE.0) GOTO 9999
  138. *
  139. * On extrait de CGEOM3 les éléments qui ont au moins une face
  140. * appartenant à CSGEO3 et un objet contenant les faces actives.
  141. *
  142. * In EXTFAC : SEGINI CGEOME
  143. * In EXTFAC : SEGINI FACTIV
  144. CALL EXTFAC(CGEOM3,CSGEO3,MYQRFS,
  145. $ CGEOME,FACTIV,
  146. $ IMPR,IRET)
  147. IF (IRET.NE.0) GOTO 9999
  148. *
  149. * Après EXTFAC :
  150. *
  151. C Write(ioimp,*) 'Après extfac'
  152. C Write(ioimp,*) ' cgeom3'
  153. C ITMP='RESU'
  154. C CALL ECROBJ('MAILLAGE',CGEOM3)
  155. C CALL ECRCHA(ITMP)
  156. C CALL PRLIST
  157. C ITMP='RESU'
  158. C CALL ECROBJ('MAILLAGE',CSGEO3)
  159. C CALL ECRCHA(ITMP)
  160. C CALL PRLIST
  161. C CALL ECROBJ('MAILLAGE',CGEOME)
  162. C CALL PRLIST
  163. C SEGPRT,FACTIV
  164. IF (METING.NE.' ') THEN
  165. CALL VERFPG(CGEOME,METING,MYFPGS,IMPR,IRET)
  166. IF (IRET.NE.0) GOTO 9999
  167. CALL VERFPG(CSGEO3,METING,MYFPGS,IMPR,IRET)
  168. IF (IRET.NE.0) GOTO 9999
  169. ENDIF
  170. ELSE
  171. *
  172. * On régularise le maillage pour ne plus se faire chier si LISOUS(/1).EQ.0
  173. * In REGMAI : SEGINI CGEOME
  174. CALL REGMA2(CGEOM2,CGEOME,IMPR,IRET)
  175. IF (IRET.NE.0) GOTO 9999
  176. *
  177. * Transformation de CGEOME en QUAF si ça n'est pas le cas
  178. *
  179. CALL TRQUAF(CGEOME,MYFALS,IMPR,IRET)
  180. IF (IRET.NE.0) GOTO 9999
  181. *
  182. * On vérifie pour la famille de méthode d'intégration :
  183. * - qu'elle est valide ;
  184. * - qu'il y a bien un élément fini qui correspond à chaque élément géométrique
  185. IF (METING.NE.' ') THEN
  186. CALL VERFPG(CGEOME,METING,MYFPGS,IMPR,IRET)
  187. IF (IRET.NE.0) GOTO 9999
  188. ENDIF
  189. ENDIF
  190. *
  191. * In PRLIN3 : SEGINI TABGEO
  192. * In PRLIN3 : SEGINI TABVDC
  193. * In PRLIN3 : SEGINI TATRAV
  194. CALL PRLIN3(CGEOME,LGDISC,TABCPR,TABCDU,LERF,
  195. $ MYFALS,MYCOMS,
  196. $ TABGEO,TABVDC,TATRAV,
  197. $ IMPR,IRET)
  198. IF (IRET.NE.0) GOTO 9999
  199. *
  200. * Dans PRLIN4, on explicite ce que l'on va vraiment devoir
  201. * calculer dans TATRAV
  202. *
  203. CALL PRLIN4(TABVDC,TATRAV,
  204. $ IMPR,IRET)
  205. IF (IRET.NE.0) GOTO 9999
  206. *
  207. * Calculons la matrice des opérateurs
  208. * In NLIN : SEGINI TABMAT
  209. IF (CSGEO2.EQ.0) THEN
  210. CALL NLIN(CGEOME,TABGEO,TABVDC,TATRAV,
  211. $ METING,LAXI,LERF,LERJ,IMREG,
  212. $ MYFALS,MYPGS,MYFPGS,
  213. $ TABMAT,
  214. $ IMPR,IRET)
  215. IF (IRET.NE.0) THEN
  216. IF (LERJ) GOTO 9666
  217. GOTO 9999
  218. ENDIF
  219. ELSE
  220. CALL NLIA(CGEOME,FACTIV,TABGEO,TABVDC,TATRAV,
  221. $ METING,LAXI,LERF,LERJ,
  222. $ MYFALS,MYPGS,MYFPGS,MYQRFS,
  223. $ TABMAT,
  224. $ IMPR,IRET)
  225. IF (IRET.NE.0) GOTO 9999
  226. ENDIF
  227. * Ménage de TATRAV
  228. * In SUTRAV : SEGSUP TATRAV
  229. CALL SUTRAV(TATRAV,IMPR,IRET)
  230. IF (IRET.NE.0) GOTO 9999
  231. *dbg NSEGAV=OOOVAL(2,1)
  232. * Transformer la matrice de moindres carrés en RIGIDITE ou en MATRIK
  233. IF (IRESO.EQ.0) THEN
  234. CALL CV2MC9(TABVDC,TABMAT,
  235. $ MYFALS,LCHAM,
  236. $ MATLIN,ICHLIN,
  237. $ IMPR,IRET)
  238. IF (IRET.NE.0) GOTO 9999
  239. ELSEIF (IRESO.EQ.1) THEN
  240. CALL CV2MCA(CGEOME,TABVDC,TABMAT,
  241. $ MYFALS,LCHAM,
  242. $ MATLIN,ICHLIN,
  243. $ IMPR,IRET)
  244. IF (IRET.NE.0) GOTO 9999
  245. ELSEIF (IRESO.EQ.2) THEN
  246. CALL CV2MCB(TABVDC,TABMAT,
  247. $ MYFALS,
  248. $ MATLIN,ICHLIN,
  249. $ IMPR,IRET)
  250. IF (IRET.NE.0) GOTO 9999
  251. ELSE
  252. WRITE(IOIMP,*) 'Erreur grave'
  253. ENDIF
  254. *dbg NSEGAP=OOOVAL(2,1)
  255. *dbg NSEGD=NSEGAP-NSEGAV
  256. *dbg WRITE(IOIMP,*) 'CV2MC9 : ',NSEGD,' segments crees ',
  257. *dbg $ ' MAT=',MATLIN,' CHP=',ICHLIN
  258. *
  259. * Destructions finales...
  260. *
  261. * In SUPOUE : SEGSUP TABMAT
  262. * In SUPOUE : SEGSUP TABVDC
  263. * In SUPOUE : SEGSUP TABGEO
  264. CALL SUPOUE(TABGEO,TABVDC,TABMAT,IMPR,IRET)
  265. IF (IRET.NE.0) GOTO 9999
  266. *
  267. IF (CSGEO2.EQ.0) THEN
  268. * In SUMEL : SEGSUP CGEOME
  269. CALL SUMEL(CGEOME)
  270. ELSE
  271. * In SUFACT : SEGSUP FACTIV
  272. CALL SUFACT(FACTIV,IMPR,IRET)
  273. IF (IRET.NE.0) GOTO 9999
  274. * In SUMEL : SEGSUP CGEOME
  275. CALL SUMEL(CGEOME)
  276. * In SUMEL : SEGSUP CSGEO3
  277. CALL SUMEL(CSGEO3)
  278. * In SUMEL : SEGSUP CGEOM3
  279. CALL SUMEL(CGEOM3)
  280. * SEGSUP MYQRFS
  281. CALL SUQRFS(MYQRFS,IMPR,IRET)
  282. IF (IRET.NE.0) GOTO 9999
  283. ENDIF
  284. *
  285. * SEGSUP MYLRFS.LISEL(*)
  286. CALL SULRFS(MYLRFS,IMPR,IRET)
  287. IF (IRET.NE.0) GOTO 9999
  288. * SEGSUP MYFALS.LISFA(*)
  289. CALL SUFALS(MYFALS,IMPR,IRET)
  290. IF (IRET.NE.0) GOTO 9999
  291. * SEGSUP MYPGS.LISPG(*)
  292. CALL SUPGS(MYPGS,IMPR,IRET)
  293. IF (IRET.NE.0) GOTO 9999
  294. * SEGSUP MYFPGS.LISFPG(*)
  295. CALL SUFPGS(MYFPGS,IMPR,IRET)
  296. IF (IRET.NE.0) GOTO 9999
  297. SEGACT MYCOMS
  298. NBCOMP=MYCOMS.LISCOM(/1)
  299. DO IBCOMP=1,NBCOMP
  300. MYCOM=MYCOMS.LISCOM(IBCOMP)
  301. SEGSUP,MYCOM
  302. ENDDO
  303. SEGSUP MYCOMS
  304. *
  305. * Normal termination
  306. *
  307. IRET=0
  308. RETURN
  309. *
  310. * Format handling
  311. *
  312. *
  313. * Error handling
  314. *
  315. 9666 CONTINUE
  316. IRET=666
  317. RETURN
  318. 9999 CONTINUE
  319. IRET=1
  320. WRITE(IOIMP,*) 'An error was detected in subroutine prlin2'
  321. RETURN
  322. *
  323. * End of subroutine PRLIN2
  324. *
  325. END
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  

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