Télécharger prlin2.eso

Retour à la liste

Numérotation des lignes :

  1. C PRLIN2 SOURCE CHAT 09/10/09 21:21:50 6519
  2. SUBROUTINE PRLIN2(CGEOM2,LGDISC,CSGEO2,TABCPR,TABCDU,METING,LAXI,
  3. $ LERF,LERJ,IRESO,IMREG,
  4. $ MATLIN,CHPLIN,
  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 SMPOUET)
  28. C lois de comportement
  29. C VERSION : v2, 22/09/03, refonte complète (modif SMPOUET)
  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. -INC CCOPTIO
  40. -INC SMELEME
  41. POINTEUR CGEOME.MELEME
  42. POINTEUR CGEOM2.MELEME
  43. POINTEUR CSGEO2.MELEME
  44. POINTEUR CGEOM3.MELEME
  45. POINTEUR CSGEO3.MELEME
  46. -INC SMTABLE
  47. POINTEUR TABCPR.MTABLE
  48. POINTEUR TABCDU.MTABLE
  49. -INC SMRIGID
  50. POINTEUR MATLIN.MRIGID
  51. -INC SMCHPOI
  52. POINTEUR CHPLIN.MCHPOI
  53. * Segments à moi
  54. CBEGININCLUDE SELREF
  55. SEGMENT ELREF
  56. CHARACTER*(LNNOM) NOMLRF
  57. CHARACTER*(LNFORM) FORME
  58. CHARACTER*(LNTYPL) TYPEL
  59. CHARACTER*(LNESP) ESPACE
  60. INTEGER DEGRE
  61. REAL*8 XCONOD(NDIMEL,NBNOD)
  62. INTEGER NPQUAF(NBDDL)
  63. INTEGER NUMCMP(NBDDL)
  64. INTEGER QUENOD(NBDDL)
  65. INTEGER ORDDER(NDIMEL,NBDDL)
  66. POINTEUR MBPOLY.POLYNS
  67. ENDSEGMENT
  68. SEGMENT ELREFS
  69. POINTEUR LISEL(0).ELREF
  70. ENDSEGMENT
  71. CENDINCLUDE SELREF
  72. POINTEUR MYLRFS.ELREFS
  73. CBEGININCLUDE SFALRF
  74. SEGMENT FALRF
  75. CHARACTER*(LNNFA) NOMFA
  76. INTEGER NUQUAF(NBLRF)
  77. POINTEUR ELEMF(NBLRF).ELREF
  78. ENDSEGMENT
  79. SEGMENT FALRFS
  80. POINTEUR LISFA(0).FALRF
  81. ENDSEGMENT
  82. CENDINCLUDE SFALRF
  83. POINTEUR MYFALS.FALRFS
  84. CBEGININCLUDE SPOGAU
  85. SEGMENT POGAU
  86. CHARACTER*(LNNPG) NOMPG
  87. CHARACTER*(LNTPG) TYPMPG
  88. CHARACTER*(LNFPG) FORLPG
  89. INTEGER NORDPG
  90. REAL*8 XCOPG(NDLPG,NBPG)
  91. REAL*8 XPOPG(NBPG)
  92. ENDSEGMENT
  93. SEGMENT POGAUS
  94. POINTEUR LISPG(0).POGAU
  95. ENDSEGMENT
  96. CENDINCLUDE SPOGAU
  97. POINTEUR MYPGS.POGAUS
  98. CBEGININCLUDE SFAPG
  99. SEGMENT FAPG
  100. CHARACTER*(LNNFAP) NOMFAP
  101. INTEGER NBQUAF(NBMPG)
  102. POINTEUR MPOGAU(NBMPG).POGAU
  103. ENDSEGMENT
  104. SEGMENT FAPGS
  105. POINTEUR LISFPG(0).FAPG
  106. ENDSEGMENT
  107. CENDINCLUDE SFAPG
  108. POINTEUR MYFPGS.FAPGS
  109. CBEGININCLUDE SLCOMP
  110. SEGMENT COMP
  111. CHARACTER*8 NOMCOM
  112. INTEGER DERCOF(NCOCOF)
  113. LOGICAL LTREF
  114. ENDSEGMENT
  115. SEGMENT COMPS
  116. POINTEUR LISCOM(NBCOMP).COMP
  117. ENDSEGMENT
  118. CENDINCLUDE SLCOMP
  119. POINTEUR MYCOMS.COMPS
  120. POINTEUR MYCOM.COMP
  121. CBEGININCLUDE SIQUAF
  122. SEGMENT IQUAF
  123. INTEGER NUMQUF
  124. REAL*8 XCONQR(NDIMQR,NBNOQR)
  125. INTEGER NUCENT
  126. POINTEUR LFACE.MELEME
  127. ENDSEGMENT
  128. SEGMENT IQUAFS
  129. POINTEUR LISQRF(NBQRF).IQUAF
  130. ENDSEGMENT
  131. CENDINCLUDE SIQUAF
  132. POINTEUR MYQRFS.IQUAFS
  133. CBEGININCLUDE SFACTIV
  134. SEGMENT FACTIV
  135. POINTEUR IFACTI(NBSOUV).SFACTI
  136. ENDSEGMENT
  137. SEGMENT SFACTI
  138. POINTEUR ISFACT(NBSOFV).SSFACT
  139. ENDSEGMENT
  140. SEGMENT SSFACT
  141. LOGICAL LFACTI(NBELFV,NBELEV)
  142. ENDSEGMENT
  143. CENDINCLUDE SFACTIV
  144. CBEGININCLUDE SMPOUET
  145. SEGMENT TABGEO
  146. CHARACTER*4 DISGEO
  147. POINTEUR IGEO.MCHAEL
  148. ENDSEGMENT
  149. SEGMENT TABVDC
  150. INTEGER VVARPR(NUMVPR)
  151. INTEGER VVARDU(NUMVDU)
  152. INTEGER VDATPR(NUMDPR)
  153. INTEGER VDATDU(NUMDDU)
  154. INTEGER VCOFPR(NUMCPR)
  155. INTEGER VCOFDU(NUMCDU)
  156. INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR)
  157. INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU)
  158. POINTEUR VLCOF(JLCOF).MLENTI
  159. POINTEUR VCOMP(JGCOF).COMP
  160. POINTEUR VLDAT(JGCOF).MLENTI
  161. INTEGER DJSVD(JGVD)
  162. POINTEUR NOMVD(JGVD).MLMOTS
  163. POINTEUR MVD(JGVD).MCHPOI
  164. REAL*8 XVD(JGVD)
  165. CHARACTER*4 DISVD(KGVD)
  166. ENDSEGMENT
  167. SEGMENT TATRAV
  168. POINTEUR VVCOF(JLCOF).MCHEVA
  169. POINTEUR VCOF(JGCOF).MCHEVA
  170. POINTEUR IVD(JGVD).MCHAEL
  171. POINTEUR VD(JGVD).MCHEVA
  172. POINTEUR DVD(JGVD).MCHEVA
  173. POINTEUR FFVD(KGVD).MCHEVA
  174. POINTEUR DFFVD(KGVD).MCHEVA
  175. LOGICAL LVCOF(JGCOF)
  176. LOGICAL LVD(JGVD)
  177. LOGICAL LDVD(JGVD)
  178. LOGICAL LFFVD(KGVD)
  179. LOGICAL LDFFVD(KGVD)
  180. ENDSEGMENT
  181. SEGMENT TABMAT
  182. POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL
  183. ENDSEGMENT
  184. CENDINCLUDE SMPOUET
  185. *
  186. CHARACTER*4 LGDISC
  187. CHARACTER*4 METING
  188. CHARACTER*4 ITMP
  189. INTEGER LAXI
  190. INTEGER LERF
  191. LOGICAL LERJ
  192. INTEGER IMPR,IRET
  193. *
  194. INTEGER OOOVAL
  195. *
  196. * Executable statements
  197. *
  198. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prlin2'
  199. *
  200. * Initialisation du segment contenant les informations sur les
  201. * éléments de référence.
  202. *
  203. * SEGINI MYLRFS.LISEL(*)
  204. CALL INLRFS(MYLRFS,IMPR,IRET)
  205. IF (IRET.NE.0) GOTO 9999
  206. *
  207. * Initialisation du segment contenant les informations sur les
  208. * familles d'éléments de référence.
  209. *
  210. * SEGINI MYFALS.LISFA(*)
  211. CALL INFALS(MYFALS,MYLRFS,IMPR,IRET)
  212. IF (IRET.NE.0) GOTO 9999
  213. *
  214. * Initialisation du segment contenant les informations sur les
  215. * méthodes d'intégration (type Gauss).
  216. *
  217. * SEGINI MYPGS.LISPG(*)
  218. CALL INPGS(MYPGS,IMPR,IRET)
  219. IF (IRET.NE.0) GOTO 9999
  220. *
  221. * Initialisation du segment contenant les informations sur les
  222. * familles de méthodes d'intégration (type Gauss).
  223. *
  224. * SEGINI MYFPGS.LISFPG(*)
  225. CALL INFPGS(MYFPGS,MYPGS,IMPR,IRET)
  226. IF (IRET.NE.0) GOTO 9999
  227. *
  228. * Initialisation du segment contenant les informations sur les
  229. * lois de comportements
  230. *
  231. * SEGINI MYCOMS.LISCOM(*)
  232. * 19/01/2006
  233. * CALL INCOMS(MYCOMS,IMPR,IRET)
  234. CALL INCOMS(MYCOMS,CGEOM2,LERF,IMPR,IRET)
  235. IF (IRET.NE.0) GOTO 9999
  236. *
  237. * Initialisation du segment contenant les informations sur les
  238. * éléments QUAFs de référence.
  239. *
  240. IF (CSGEO2.NE.0) THEN
  241. * SEGINI MYQRFS
  242. CALL INQRFS(MYQRFS,IMPR,IRET)
  243. IF (IRET.NE.0) GOTO 9999
  244. * On régularise le maillage pour plus se faire chier si LISOUS(/1).EQ.0
  245. * In REGMAI : SEGINI CGEOM3
  246. CALL REGMA2(CGEOM2,CGEOM3,IMPR,IRET)
  247. IF (IRET.NE.0) GOTO 9999
  248. * In REGMAI : SEGINI CSGEO3
  249. CALL REGMA2(CSGEO2,CSGEO3,IMPR,IRET)
  250. IF (IRET.NE.0) GOTO 9999
  251. *
  252. * On extrait de CGEOM3 les éléments qui ont au moins une face
  253. * appartenant à CSGEO3 et un objet contenant les faces actives.
  254. *
  255. * In EXTFAC : SEGINI CGEOME
  256. * In EXTFAC : SEGINI FACTIV
  257. CALL EXTFAC(CGEOM3,CSGEO3,MYQRFS,
  258. $ CGEOME,FACTIV,
  259. $ IMPR,IRET)
  260. IF (IRET.NE.0) GOTO 9999
  261. *
  262. * Après EXTFAC :
  263. *
  264. C Write(ioimp,*) 'Après extfac'
  265. C Write(ioimp,*) ' cgeom3'
  266. C ITMP='RESU'
  267. C CALL ECROBJ('MAILLAGE',CGEOM3)
  268. C CALL ECRCHA(ITMP)
  269. C CALL PRLIST
  270. C ITMP='RESU'
  271. C CALL ECROBJ('MAILLAGE',CSGEO3)
  272. C CALL ECRCHA(ITMP)
  273. C CALL PRLIST
  274. C CALL ECROBJ('MAILLAGE',CGEOME)
  275. C CALL PRLIST
  276. C SEGPRT,FACTIV
  277. IF (METING.NE.' ') THEN
  278. CALL VERFPG(CGEOME,METING,MYFPGS,IMPR,IRET)
  279. IF (IRET.NE.0) GOTO 9999
  280. CALL VERFPG(CSGEO3,METING,MYFPGS,IMPR,IRET)
  281. IF (IRET.NE.0) GOTO 9999
  282. ENDIF
  283. ELSE
  284. *
  285. * On régularise le maillage pour ne plus se faire chier si LISOUS(/1).EQ.0
  286. * In REGMAI : SEGINI CGEOME
  287. CALL REGMA2(CGEOM2,CGEOME,IMPR,IRET)
  288. IF (IRET.NE.0) GOTO 9999
  289. * On vérifie pour la famille de méthode d'intégration :
  290. * - qu'elle est valide ;
  291. * - qu'il y a bien un élément fini qui correspond à chaque élément géométrique
  292. IF (METING.NE.' ') THEN
  293. CALL VERFPG(CGEOME,METING,MYFPGS,IMPR,IRET)
  294. IF (IRET.NE.0) GOTO 9999
  295. ENDIF
  296. ENDIF
  297. *
  298. * In PRLIN3 : SEGINI TABGEO
  299. * In PRLIN3 : SEGINI TABVDC
  300. * In PRLIN3 : SEGINI TATRAV
  301. CALL PRLIN3(CGEOME,LGDISC,TABCPR,TABCDU,LERF,
  302. $ MYFALS,MYCOMS,
  303. $ TABGEO,TABVDC,TATRAV,
  304. $ IMPR,IRET)
  305. IF (IRET.NE.0) GOTO 9999
  306. *
  307. * Dans PRLIN4, on explicite ce que l'on va vraiment devoir
  308. * calculer dans TATRAV
  309. *
  310. CALL PRLIN4(TABVDC,TATRAV,
  311. $ IMPR,IRET)
  312. IF (IRET.NE.0) GOTO 9999
  313. *
  314. * Calculons la matrice des opérateurs
  315. * In NLIN : SEGINI TABMAT
  316. IF (CSGEO2.EQ.0) THEN
  317. CALL NLIN(CGEOME,TABGEO,TABVDC,TATRAV,
  318. $ METING,LAXI,LERF,LERJ,IMREG,
  319. $ MYFALS,MYPGS,MYFPGS,
  320. $ TABMAT,
  321. $ IMPR,IRET)
  322. IF (IRET.NE.0) THEN
  323. IF (LERJ) GOTO 9666
  324. GOTO 9999
  325. ENDIF
  326. ELSE
  327. CALL NLIA(CGEOME,FACTIV,TABGEO,TABVDC,TATRAV,
  328. $ METING,LAXI,LERF,LERJ,
  329. $ MYFALS,MYPGS,MYFPGS,MYQRFS,
  330. $ TABMAT,
  331. $ IMPR,IRET)
  332. IF (IRET.NE.0) GOTO 9999
  333. ENDIF
  334. * Ménage de TATRAV
  335. * In SUTRAV : SEGSUP TATRAV
  336. CALL SUTRAV(TATRAV,IMPR,IRET)
  337. IF (IRET.NE.0) GOTO 9999
  338. *dbg NSEGAV=OOOVAL(2,1)
  339. * Transformer la matrice de moindres carrés en RIGIDITE ou en MATRIK
  340. IF (IRESO.EQ.0) THEN
  341. CALL CV2MC9(TABVDC,TABMAT,
  342. $ MYFALS,
  343. $ MATLIN,CHPLIN,
  344. $ IMPR,IRET)
  345. IF (IRET.NE.0) GOTO 9999
  346. ELSEIF (IRESO.EQ.1) THEN
  347. CALL CV2MCA(CGEOME,TABVDC,TABMAT,
  348. $ MYFALS,
  349. $ MATLIN,CHPLIN,
  350. $ IMPR,IRET)
  351. IF (IRET.NE.0) GOTO 9999
  352. ELSEIF (IRESO.EQ.2) THEN
  353. CALL CV2MCB(TABVDC,TABMAT,
  354. $ MYFALS,
  355. $ MATLIN,CHPLIN,
  356. $ IMPR,IRET)
  357. IF (IRET.NE.0) GOTO 9999
  358. ELSE
  359. WRITE(IOIMP,*) 'Erreur grave'
  360. ENDIF
  361. *dbg NSEGAP=OOOVAL(2,1)
  362. *dbg NSEGD=NSEGAP-NSEGAV
  363. *dbg WRITE(IOIMP,*) 'CV2MC9 : ',NSEGD,' segments crees ',
  364. *dbg $ ' MAT=',MATLIN,' CHP=',CHPLIN
  365. *
  366. * Destructions finales...
  367. *
  368. * In SUPOUE : SEGSUP TABMAT
  369. * In SUPOUE : SEGSUP TABVDC
  370. * In SUPOUE : SEGSUP TABGEO
  371. CALL SUPOUE(TABGEO,TABVDC,TABMAT,IMPR,IRET)
  372. IF (IRET.NE.0) GOTO 9999
  373. *
  374. IF (CSGEO2.EQ.0) THEN
  375. * In SUMEL : SEGSUP CGEOME
  376. CALL SUMEL(CGEOME,IMPR,IRET)
  377. ELSE
  378. * In SUFACT : SEGSUP FACTIV
  379. CALL SUFACT(FACTIV,IMPR,IRET)
  380. IF (IRET.NE.0) GOTO 9999
  381. * In SUMEL : SEGSUP CGEOME
  382. CALL SUMEL(CGEOME,IMPR,IRET)
  383. * In SUMEL : SEGSUP CSGEO3
  384. CALL SUMEL(CSGEO3,IMPR,IRET)
  385. * In SUMEL : SEGSUP CGEOM3
  386. CALL SUMEL(CGEOM3,IMPR,IRET)
  387. * SEGSUP MYQRFS
  388. CALL SUQRFS(MYQRFS,IMPR,IRET)
  389. IF (IRET.NE.0) GOTO 9999
  390. ENDIF
  391. *
  392. * SEGSUP MYLRFS.LISEL(*)
  393. CALL SULRFS(MYLRFS,IMPR,IRET)
  394. IF (IRET.NE.0) GOTO 9999
  395. * SEGSUP MYFALS.LISFA(*)
  396. CALL SUFALS(MYFALS,IMPR,IRET)
  397. IF (IRET.NE.0) GOTO 9999
  398. * SEGSUP MYPGS.LISPG(*)
  399. CALL SUPGS(MYPGS,IMPR,IRET)
  400. IF (IRET.NE.0) GOTO 9999
  401. * SEGSUP MYFPGS.LISFPG(*)
  402. CALL SUFPGS(MYFPGS,IMPR,IRET)
  403. IF (IRET.NE.0) GOTO 9999
  404. SEGACT MYCOMS
  405. NBCOMP=MYCOMS.LISCOM(/1)
  406. DO IBCOMP=1,NBCOMP
  407. MYCOM=MYCOMS.LISCOM(IBCOMP)
  408. SEGSUP,MYCOM
  409. ENDDO
  410. SEGSUP MYCOMS
  411. *
  412. * Normal termination
  413. *
  414. IRET=0
  415. RETURN
  416. *
  417. * Format handling
  418. *
  419. *
  420. * Error handling
  421. *
  422. 9666 CONTINUE
  423. IRET=666
  424. RETURN
  425. 9999 CONTINUE
  426. IRET=1
  427. WRITE(IOIMP,*) 'An error was detected in subroutine prlin2'
  428. RETURN
  429. *
  430. * End of subroutine PRLIN2
  431. *
  432. END
  433.  
  434.  
  435.  
  436.  
  437.  
  438.  
  439.  
  440.  
  441.  

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