Télécharger pre71.eso

Retour à la liste

Numérotation des lignes :

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

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