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

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