Télécharger pre61.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE61 SOURCE BECC 11/01/05 21:15:19 6836
  2. SUBROUTINE PRE61()
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PRE61
  8. C
  9. C DESCRIPTION : Voir PRE6
  10. C
  11. C Discrete Equations Method
  12. C
  13. C 2me ordre en espace
  14. C
  15. C Creation of the MCHAMLs IALPF, IROF, IVITF, IPF,
  16. C for the two phases.
  17. C
  18. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  19. C
  20. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  21. C
  22. C************************************************************************
  23. C
  24. C
  25. C************************************************************************
  26. C
  27. C HISTORIQUE (Anomalies et modifications éventuelles)
  28. C
  29. C HISTORIQUE : Crée le 03.12.2009
  30. C Estension au 3D le 21.12.2010
  31. C
  32. C************************************************************************
  33. C
  34. IMPLICIT INTEGER(I-N)
  35. C
  36. C**** Les variables
  37. C
  38. INTEGER ICOND, IRETOU, MMODEL, ICELL
  39. & , IDOMA, ICEN, IFACE, IFACEL, INORM
  40. & , IAL1, IGRAL1, ILIAL1
  41. & , IAL2, IGRAL2, ILIAL2
  42. & , IRN1, IGRRN1, ILIRN1
  43. & , IRN2, IGRRN2, ILIRN2
  44. & , IVN1, IGRVN1, ILIVN1
  45. & , IVN2, IGRVN2, ILIVN2
  46. & , IPN1, IGRPN1, ILIPN1
  47. & , IPN2, IGRPN2, ILIPN2
  48. & , IAL1F, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F
  49. C
  50. CHARACTER*(4) NOMGRA(27),NOMLIM(9)
  51. CHARACTER*(8) MTYPR
  52. CHARACTER*(40) MESERR
  53. C
  54. C**** Les Includes
  55. C
  56. -INC CCOPTIO
  57. INTEGER JGM, JGN
  58. -INC SMLMOTS
  59. POINTEUR MLMCOM.MLMOTS, MLMVIT.MLMOTS, MLMTEN.MLMOTS
  60. C
  61. C**** Nom de composantes de gradients (HP. <= 9 composantes)
  62. C
  63. DATA NOMGRA /'P1DX','P1DY','P1DZ',
  64. & 'P2DX','P2DY','P2DZ',
  65. & 'P3DX','P3DY','P3DZ',
  66. & 'P4DX','P4DY','P4DZ',
  67. & 'P5DX','P5DY','P5DZ',
  68. & 'P6DX','P6DY','P6DZ',
  69. & 'P7DX','P7DY','P7DZ',
  70. & 'P8DX','P8DY','P8DZ',
  71. & 'P9DX','P9DY','P9DZ'/
  72. C
  73. DATA NOMLIM /'P1 ',
  74. & 'P2 ',
  75. & 'P3 ',
  76. & 'P4 ',
  77. & 'P5 ',
  78. & 'P6 ',
  79. & 'P7 ',
  80. & 'P8 ',
  81. & 'P9 '/
  82. C
  83. C**** Initialisation of some segment
  84. C
  85. JGN=4
  86. JGM=1
  87. SEGINI MLMCOM
  88. JGN=4
  89. JGM=IDIM
  90. SEGINI MLMVIT
  91. JGN=4
  92. JGM=IDIM*IDIM
  93. SEGINI MLMTEN
  94. C
  95. C**** Lecture de l'objet MODELE
  96. C
  97. ICOND = 1
  98. MTYPR = 'MMODEL '
  99. CALL LIROBJ(MTYPR, MMODEL, ICOND, IRETOU)
  100. IF(IERR.NE.0)GOTO 9999
  101. CALL LEKMOD(MMODEL, IDOMA, ICELL)
  102. IF(IERR.NE.0)GOTO 9999
  103. C
  104. C**** Lecture du MELEME SPG des points CENTRE.
  105. C
  106. C
  107. C CALL LEKTAB(IDOMA,'CENTRE',IP)
  108. C
  109. C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
  110. C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
  111. C -> la correspondance global des noeuds saut!
  112. C
  113. C On peut utilizer ACCTAB ou ACMO
  114. C
  115. MTYPR = 'MAILLAGE'
  116. CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN)
  117. IF(IERR.NE.0)GOTO 9999
  118. C
  119. C**** Lecture du MELEME 'FACE'
  120. C
  121. MTYPR = 'MAILLAGE'
  122. CALL ACMO(IDOMA,'FACE',MTYPR,IFACE)
  123. IF(IERR.NE.0)GOTO 9999
  124. C
  125. C**** Lecture du MELEME 'FACEL'
  126. C
  127. MTYPR = 'MAILLAGE'
  128. CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL)
  129. IF(IERR.NE.0)GOTO 9999
  130. C
  131. C**** Lecture du CHPOINT contenant les normales (tangentes) aux faces
  132. C
  133. IF(IDIM .EQ. 2)THEN
  134. C Que les normales
  135. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  136. IF(IERR .NE. 0) GOTO 9999
  137. MLMVIT.MOTS(1) = 'UX '
  138. MLMVIT.MOTS(2) = 'UY '
  139. CALL QUEPO1(INORM, IFACE, MLMVIT)
  140. IF(IERR.NE.0)GOTO 9999
  141. ELSE
  142. C Les normales et les tangentes
  143. MTYPR = ' '
  144. CALL ACMO(IDOMA,'MATROT',MTYPR,INORM)
  145. IF (MTYPR .NE. 'CHPOINT ') THEN
  146. CALL MATRAN(IDOMA,INORM)
  147. IF(IERR .NE. 0) GOTO 9999
  148. ENDIF
  149. MLMTEN.MOTS(1) = 'UX '
  150. MLMTEN.MOTS(2) = 'UY '
  151. MLMTEN.MOTS(3) = 'UZ '
  152. MLMTEN.MOTS(4) = 'RX '
  153. MLMTEN.MOTS(5) = 'RY '
  154. MLMTEN.MOTS(6) = 'RZ '
  155. MLMTEN.MOTS(7) = 'MX '
  156. MLMTEN.MOTS(8) = 'MY '
  157. MLMTEN.MOTS(9) = 'MZ '
  158. CALL QUEPO1(INORM, IFACE, MLMTEN)
  159. IF(IERR.NE.0)GOTO 9999
  160. ENDIF
  161. C
  162. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  163. C**** Lecture des CHPOINTs alpha ****C
  164. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  165. C
  166. C**** IAL1
  167. C
  168. ICOND = 1
  169. MTYPR = 'CHPOINT '
  170. CALL LIROBJ(MTYPR,IAL1,ICOND,IRETOU)
  171. IF(IERR .NE. 0)GOTO 9999
  172. C Control du CHPOINT: QUEPO1
  173. SEGACT MLMCOM*MOD
  174. MLMCOM.MOTS(1)='SCAL'
  175. CALL QUEPO1(IAL1, ICEN, MLMCOM)
  176. SEGDES MLMCOM
  177. IF(IERR .NE. 0)THEN
  178. GOTO 9999
  179. ENDIF
  180. C
  181. C**** Lecture du CHPOINT IGRAL1
  182. C
  183. ICOND = 1
  184. MTYPR = 'CHPOINT '
  185. CALL LIROBJ(MTYPR,IGRAL1,ICOND,IRETOU)
  186. IF (IERR.NE.0) GOTO 9999
  187. C Control du CHPOINT: QUEPO1
  188. SEGACT MLMVIT*MOD
  189. MLMVIT.MOTS(1)=NOMGRA(1)
  190. MLMVIT.MOTS(2)=NOMGRA(2)
  191. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3)
  192. CALL QUEPO1(IGRAL1, ICEN, MLMVIT)
  193. SEGDES MLMVIT
  194. IF(IERR .NE. 0)THEN
  195. GOTO 9999
  196. ENDIF
  197. C
  198. C**** Lecture du CHPOINT ILIAL1
  199. C
  200. ICOND = 1
  201. MTYPR = 'CHPOINT '
  202. CALL LIROBJ(MTYPR,ILIAL1,ICOND,IRETOU)
  203. IF (IERR.NE.0) GOTO 9999
  204. C Control du CHPOINT: QUEPO1
  205. SEGACT MLMCOM*MOD
  206. MLMCOM.MOTS(1)= NOMLIM(1)
  207. CALL QUEPO1(ILIAL1, ICEN, MLMCOM)
  208. SEGDES MLMCOM
  209. IF(IERR .NE. 0)THEN
  210. GOTO 9999
  211. ENDIF
  212. C
  213. C**** IAL2
  214. C
  215. ICOND = 1
  216. MTYPR = 'CHPOINT '
  217. CALL LIROBJ(MTYPR,IAL2,ICOND,IRETOU)
  218. IF(IERR .NE. 0)GOTO 9999
  219. C Control du CHPOINT: QUEPO1
  220. SEGACT MLMCOM*MOD
  221. MLMCOM.MOTS(1)='SCAL'
  222. CALL QUEPO1(IAL2, ICEN, MLMCOM)
  223. SEGDES MLMCOM
  224. IF(IERR .NE. 0)THEN
  225. GOTO 9999
  226. ENDIF
  227. C
  228. C**** Lecture du CHPOINT IGRAL2
  229. C
  230. ICOND = 1
  231. MTYPR = 'CHPOINT '
  232. CALL LIROBJ(MTYPR,IGRAL2,ICOND,IRETOU)
  233. IF (IERR.NE.0) GOTO 9999
  234. C Control du CHPOINT: QUEPO1
  235. SEGACT MLMVIT*MOD
  236. MLMVIT.MOTS(1)=NOMGRA(1)
  237. MLMVIT.MOTS(2)=NOMGRA(2)
  238. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3)
  239. CALL QUEPO1(IGRAL2, ICEN, MLMVIT)
  240. SEGDES MLMVIT
  241. IF(IERR .NE. 0)THEN
  242. GOTO 9999
  243. ENDIF
  244. C
  245. C**** Lecture du CHPOINT ILIAL2
  246. C
  247. ICOND = 1
  248. MTYPR = 'CHPOINT '
  249. CALL LIROBJ(MTYPR,ILIAL2,ICOND,IRETOU)
  250. IF (IERR.NE.0) GOTO 9999
  251. C Control du CHPOINT: QUEPO1
  252. SEGACT MLMCOM*MOD
  253. MLMCOM.MOTS(1)= NOMLIM(1)
  254. CALL QUEPO1(ILIAL2, ICEN, MLMCOM)
  255. SEGDES MLMCOM
  256. IF(IERR .NE. 0)THEN
  257. GOTO 9999
  258. ENDIF
  259. C
  260. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  261. C**** Lecture des CHPOINTs rho ****C
  262. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  263. C
  264. C**** RN1
  265. C
  266. ICOND = 1
  267. MTYPR = 'CHPOINT '
  268. CALL LIROBJ(MTYPR,IRN1,ICOND,IRETOU)
  269. IF(IERR .NE. 0)GOTO 9999
  270. C Control du CHPOINT: QUEPO1
  271. SEGACT MLMCOM*MOD
  272. MLMCOM.MOTS(1)='SCAL'
  273. CALL QUEPO1(IRN1, ICEN, MLMCOM)
  274. SEGDES MLMCOM
  275. IF(IERR .NE. 0)THEN
  276. GOTO 9999
  277. ENDIF
  278. C
  279. C**** Lecture du CHPOINT IGRRN1
  280. C
  281. ICOND = 1
  282. MTYPR = 'CHPOINT '
  283. CALL LIROBJ(MTYPR,IGRRN1,ICOND,IRETOU)
  284. IF (IERR.NE.0) GOTO 9999
  285. C Control du CHPOINT: QUEPO1
  286. SEGACT MLMVIT*MOD
  287. MLMVIT.MOTS(1)=NOMGRA(1)
  288. MLMVIT.MOTS(2)=NOMGRA(2)
  289. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3)
  290. CALL QUEPO1(IGRRN1, ICEN, MLMVIT)
  291. SEGDES MLMVIT
  292. IF(IERR .NE. 0)THEN
  293. GOTO 9999
  294. ENDIF
  295. C
  296. C**** Lecture du CHPOINT ILIRN1
  297. C
  298. ICOND = 1
  299. MTYPR = 'CHPOINT '
  300. CALL LIROBJ(MTYPR,ILIRN1,ICOND,IRETOU)
  301. IF (IERR.NE.0) GOTO 9999
  302. C Control du CHPOINT: QUEPO1
  303. SEGACT MLMCOM*MOD
  304. MLMCOM.MOTS(1)= NOMLIM(1)
  305. CALL QUEPO1(ILIRN1, ICEN, MLMCOM)
  306. SEGDES MLMCOM
  307. IF(IERR .NE. 0)THEN
  308. GOTO 9999
  309. ENDIF
  310. C
  311. C**** IRN2
  312. C
  313. ICOND = 1
  314. MTYPR = 'CHPOINT '
  315. CALL LIROBJ(MTYPR,IRN2,ICOND,IRETOU)
  316. IF(IERR .NE. 0)GOTO 9999
  317. C Control du CHPOINT: QUEPO1
  318. SEGACT MLMCOM*MOD
  319. MLMCOM.MOTS(1)='SCAL'
  320. CALL QUEPO1(IRN2, ICEN, MLMCOM)
  321. SEGDES MLMCOM
  322. IF(IERR .NE. 0)THEN
  323. GOTO 9999
  324. ENDIF
  325. C
  326. C**** Lecture du CHPOINT IGRRN2
  327. C
  328. ICOND = 1
  329. MTYPR = 'CHPOINT '
  330. CALL LIROBJ(MTYPR,IGRRN2,ICOND,IRETOU)
  331. IF (IERR.NE.0) GOTO 9999
  332. C Control du CHPOINT: QUEPO1
  333. SEGACT MLMVIT*MOD
  334. MLMVIT.MOTS(1)=NOMGRA(1)
  335. MLMVIT.MOTS(2)=NOMGRA(2)
  336. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3)
  337. CALL QUEPO1(IGRRN2, ICEN, MLMVIT)
  338. SEGDES MLMVIT
  339. IF(IERR .NE. 0)THEN
  340. GOTO 9999
  341. ENDIF
  342. C
  343. C**** Lecture du CHPOINT ILIRN2
  344. C
  345. ICOND = 1
  346. MTYPR = 'CHPOINT '
  347. CALL LIROBJ(MTYPR,ILIRN2,ICOND,IRETOU)
  348. IF (IERR.NE.0) GOTO 9999
  349. C Control du CHPOINT: QUEPO1
  350. SEGACT MLMCOM*MOD
  351. MLMCOM.MOTS(1)= NOMLIM(1)
  352. CALL QUEPO1(ILIRN2, ICEN, MLMCOM)
  353. SEGDES MLMCOM
  354. IF(IERR .NE. 0)THEN
  355. GOTO 9999
  356. ENDIF
  357. C
  358. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  359. C**** Lecture des CHPOINTs vitesse ****C
  360. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  361. C
  362. C**** VN1
  363. C
  364. ICOND = 1
  365. MTYPR = 'CHPOINT '
  366. CALL LIROBJ(MTYPR,IVN1,ICOND,IRETOU)
  367. IF(IERR .NE. 0)GOTO 9999
  368. C Control du CHPOINT: QUEPO1
  369. SEGACT MLMVIT*MOD
  370. MLMVIT.MOTS(1)='UX '
  371. MLMVIT.MOTS(2)='UY '
  372. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ '
  373. CALL QUEPO1(IVN1, ICEN, MLMVIT)
  374. SEGDES MLMVIT
  375. IF(IERR .NE. 0)THEN
  376. GOTO 9999
  377. ENDIF
  378. C
  379. C**** Lecture du CHPOINT IGRVN1
  380. C
  381. ICOND = 1
  382. MTYPR = 'CHPOINT '
  383. CALL LIROBJ(MTYPR,IGRVN1,ICOND,IRETOU)
  384. IF (IERR.NE.0) GOTO 9999
  385. C Control du CHPOINT: QUEPO1
  386. SEGACT MLMTEN*MOD
  387. IF (IDIM .EQ. 2)THEN
  388. MLMTEN.MOTS(1)=NOMGRA(1)
  389. MLMTEN.MOTS(2)=NOMGRA(2)
  390. MLMTEN.MOTS(3)=NOMGRA(4)
  391. MLMTEN.MOTS(4)=NOMGRA(5)
  392. ELSEIF(IDIM .EQ. 3) THEN
  393. MLMTEN.MOTS(1)=NOMGRA(1)
  394. MLMTEN.MOTS(2)=NOMGRA(2)
  395. MLMTEN.MOTS(3)=NOMGRA(3)
  396. MLMTEN.MOTS(4)=NOMGRA(4)
  397. MLMTEN.MOTS(5)=NOMGRA(5)
  398. MLMTEN.MOTS(6)=NOMGRA(6)
  399. MLMTEN.MOTS(7)=NOMGRA(7)
  400. MLMTEN.MOTS(8)=NOMGRA(8)
  401. MLMTEN.MOTS(9)=NOMGRA(9)
  402. ENDIF
  403. CALL QUEPO1(IGRVN1, ICEN, MLMTEN)
  404. SEGDES MLMTEN
  405. IF(IERR .NE. 0)THEN
  406. GOTO 9999
  407. ENDIF
  408. C
  409. C
  410. C**** Lecture du CHPOINT ILIVN1
  411. C
  412. ICOND = 1
  413. MTYPR = 'CHPOINT '
  414. CALL LIROBJ(MTYPR,ILIVN1,ICOND,IRETOU)
  415. IF (IERR.NE.0) GOTO 9999
  416. C Control du CHPOINT: QUEPO1
  417. SEGACT MLMVIT*MOD
  418. MLMVIT.MOTS(1)=NOMLIM(1)
  419. MLMVIT.MOTS(2)=NOMLIM(2)
  420. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMLIM(3)
  421. CALL QUEPO1(ILIVN1, ICEN, MLMVIT)
  422. SEGDES MLMVIT
  423. IF(IERR .NE. 0)THEN
  424. GOTO 9999
  425. ENDIF
  426. C
  427. C**** VN2
  428. C
  429. ICOND = 1
  430. MTYPR = 'CHPOINT '
  431. CALL LIROBJ(MTYPR,IVN2,ICOND,IRETOU)
  432. IF(IERR .NE. 0)GOTO 9999
  433. C Control du CHPOINT: QUEPO1
  434. SEGACT MLMVIT*MOD
  435. MLMVIT.MOTS(1)='UX '
  436. MLMVIT.MOTS(2)='UY '
  437. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = 'UZ '
  438. CALL QUEPO1(IVN2, ICEN, MLMVIT)
  439. SEGDES MLMVIT
  440. IF(IERR .NE. 0)THEN
  441. GOTO 9999
  442. ENDIF
  443. C
  444. C**** Lecture du CHPOINT IGRVN2
  445. C
  446. ICOND = 1
  447. MTYPR = 'CHPOINT '
  448. CALL LIROBJ(MTYPR,IGRVN2,ICOND,IRETOU)
  449. IF (IERR.NE.0) GOTO 9999
  450. C Control du CHPOINT: QUEPO1
  451. SEGACT MLMTEN*MOD
  452. IF (IDIM .EQ. 2)THEN
  453. MLMTEN.MOTS(1)=NOMGRA(1)
  454. MLMTEN.MOTS(2)=NOMGRA(2)
  455. MLMTEN.MOTS(3)=NOMGRA(4)
  456. MLMTEN.MOTS(4)=NOMGRA(5)
  457. ELSEIF(IDIM .EQ. 3) THEN
  458. MLMTEN.MOTS(1)=NOMGRA(1)
  459. MLMTEN.MOTS(2)=NOMGRA(2)
  460. MLMTEN.MOTS(3)=NOMGRA(3)
  461. MLMTEN.MOTS(4)=NOMGRA(4)
  462. MLMTEN.MOTS(5)=NOMGRA(5)
  463. MLMTEN.MOTS(6)=NOMGRA(6)
  464. MLMTEN.MOTS(7)=NOMGRA(7)
  465. MLMTEN.MOTS(8)=NOMGRA(8)
  466. MLMTEN.MOTS(9)=NOMGRA(9)
  467. ENDIF
  468. CALL QUEPO1(IGRVN2, ICEN, MLMTEN)
  469. SEGDES MLMTEN
  470. IF(IERR .NE. 0)THEN
  471. GOTO 9999
  472. ENDIF
  473. C
  474. C
  475. C**** Lecture du CHPOINT ILIVN2
  476. C
  477. ICOND = 1
  478. MTYPR = 'CHPOINT '
  479. CALL LIROBJ(MTYPR,ILIVN2,ICOND,IRETOU)
  480. IF (IERR.NE.0) GOTO 9999
  481. C Control du CHPOINT: QUEPO1
  482. SEGACT MLMVIT*MOD
  483. MLMVIT.MOTS(1)=NOMLIM(1)
  484. MLMVIT.MOTS(2)=NOMLIM(2)
  485. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMLIM(3)
  486. CALL QUEPO1(ILIVN2, ICEN, MLMVIT)
  487. SEGDES MLMVIT
  488. IF(IERR .NE. 0)THEN
  489. GOTO 9999
  490. ENDIF
  491. C
  492. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  493. C**** Lecture des CHPOINTs rho ****C
  494. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  495. C
  496. C**** PN1
  497. C
  498. ICOND = 1
  499. MTYPR = 'CHPOINT '
  500. CALL LIROBJ(MTYPR,IPN1,ICOND,IRETOU)
  501. IF(IERR .NE. 0)GOTO 9999
  502. C Control du CHPOINT: QUEPO1
  503. SEGACT MLMCOM*MOD
  504. MLMCOM.MOTS(1)='SCAL'
  505. CALL QUEPO1(IPN1, ICEN, MLMCOM)
  506. SEGDES MLMCOM
  507. IF(IERR .NE. 0)THEN
  508. GOTO 9999
  509. ENDIF
  510. C
  511. C**** Lecture du CHPOINT IGRPN1
  512. C
  513. ICOND =spaî spyle="color: #339933;">= 1
  514. MTYPR = 'CHPOINT '
  515. CALL LIROBJ(MTYPR,IGRPN1,ICOND,IRETOU)
  516. IF (IERR.NE.0) GOTO 9999
  517. C Control du CHPOINT: QUEPO1
  518. SEGACT MLMVIT*MOD
  519. MLMVIT.MOTS(1)=NOMGRA(1)
  520. MLMVIT.MOTS(2)=NOMGRA(2)
  521. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3)
  522. CALL QUEPO1(IGRPN1, ICEN, MLMVIT)
  523. SEGDES MLMVIT
  524. IF(IERR .NE. 0)THEN
  525. GOTO 9999
  526. ENDIF
  527. C
  528. C**** Lecture du CHPOINT ILIPN1
  529. C
  530. ICOND = 1
  531. MTYPR = 'CHPOINT '
  532. CALL LIROBJ(MTYPR,ILIPN1,ICOND,IRETOU)
  533. IF (IERR.NE.0) GOTO 9999
  534. C Control du CHPOINT: QUEPO1
  535. SEGACT MLMCOM*MOD
  536. MLMCOM.MOTS(1)= NOMLIM(1)
  537. CALL QUEPO1(ILIPN1, ICEN, MLMCOM)
  538. SEGDES MLMCOM
  539. IF(IERR .NE. 0)THEN
  540. GOTO 9999
  541. ENDIF
  542. C
  543. C**** IPN2
  544. C
  545. ICOND = 1
  546. MTYPR = 'CHPOINT '
  547. CALL LIROBJ(MTYPR,IPN2,ICOND,IRETOU)
  548. IF(IERR .NE. 0)GOTO 9999
  549. C Control du CHPOINT: QUEPO1
  550. SEGACT MLMCOM*MOD
  551. MLMCOM.MOTS(1)='SCAL'
  552. CALL QUEPO1(IPN2, ICEN, MLMCOM)
  553. SEGDES MLMCOM
  554. IF(IERR .NE. 0)THEN
  555. GOTO 9999
  556. ENDIF
  557. C
  558. C**** Lecture du CHPOINT IGRPN2
  559. C
  560. ICOND = 1
  561. MTYPR = 'CHPOINT '
  562. CALL LIROBJ(MTYPR,IGRPN2,ICOND,IRETOU)
  563. IF (IERR.NE.0) GOTO 9999
  564. C Control du CHPOINT: QUEPO1
  565. SEGACT MLMVIT*MOD
  566. MLMVIT.MOTS(1)=NOMGRA(1)
  567. MLMVIT.MOTS(2)=NOMGRA(2)
  568. IF(IDIM .EQ. 3) MLMVIT.MOTS(3) = NOMGRA(3)
  569. CALL QUEPO1(IGRPN2, ICEN, MLMVIT)
  570. SEGDES MLMVIT
  571. IF(IERR .NE. 0)THEN
  572. GOTO 9999
  573. ENDIF
  574. C
  575. C**** Lecture du CHPOINT ILIPN2
  576. C
  577. ICOND = 1
  578. MTYPR = 'CHPOINT '
  579. CALL LIROBJ(MTYPR,ILIPN2,ICOND,IRETOU)
  580. IF (IERR.NE.0) GOTO 9999
  581. C Control du CHPOINT: QUEPO1
  582. SEGACT MLMCOM*MOD
  583. MLMCOM.MOTS(1)= NOMLIM(1)
  584. CALL QUEPO1(ILIPN2, ICEN, MLMCOM)
  585. SEGDES MLMCOM
  586. IF(IERR .NE. 0)THEN
  587. GOTO 9999
  588. ENDIF
  589. C
  590. C write(*,*) 'Fin qui'
  591. C write(*,*) IAL1, IGRAL1, ILIAL1
  592. C write(*,*) IAL2, IGRAL2, ILIAL2
  593. C write(*,*) IRN1, IGRRN1, ILIRN1
  594. C write(*,*) IRN2, IGRRN2, ILIRN2
  595. C write(*,*) IVN1, IGRVN1, ILIVN1
  596. C write(*,*) IVN2, IGRVN2, ILIVN2
  597. C write(*,*) IPN1, IGRPN1, ILIPN1
  598. C write(*,*) IPN2, IGRPN2, ILIPN2
  599. C goto 9999
  600. C
  601. CALL PRE611(
  602. & ICEN,IFACE,IFACEL,INORM,
  603. & IAL1, IGRAL1, ILIAL1,
  604. & IAL2, IGRAL2, ILIAL2,
  605. & IRN1, IGRRN1, ILIRN1,
  606. & IRN2, IGRRN2, ILIRN2,
  607. & IVN1, IGRVN1, ILIVN1,
  608. & IVN2, IGRVN2, ILIVN2,
  609. & IPN1, IGRPN1, ILIPN1,
  610. & IPN2, IGRPN2, ILIPN2,
  611. & IAL1F, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F)
  612. C
  613. SEGSUP MLMCOM
  614. SEGSUP MLMVIT
  615. SEGSUP MLMTEN
  616. C
  617. C**** Ecriture de
  618. C IAL1F, IAL2F, IRN1F, IRN2F, IVN1F, IVN2F, IPN1F, IPN2F
  619. C
  620. MTYPR = 'MCHAML '
  621. CALL ECROBJ(MTYPR,IPN2F)
  622. CALL ECROBJ(MTYPR,IPN1F)
  623. CALL ECROBJ(MTYPR,IVN2F)
  624. CALL ECROBJ(MTYPR,IVN1F)
  625. CALL ECROBJ(MTYPR,IRN2F)
  626. CALL ECROBJ(MTYPR,IRN1F)
  627. CALL ECROBJ(MTYPR,IAL2F)
  628. CALL ECROBJ(MTYPR,IAL1F)
  629. C
  630. 9999 CONTINUE
  631. C
  632. RETURN
  633. END
  634.  
  635.  
  636.  

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