Télécharger konv15.eso

Retour à la liste

Numérotation des lignes :

  1. C KONV15 SOURCE BECC 11/05/26 21:15:51 6981
  2. SUBROUTINE KONV15
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : KONV15
  8. C
  9. C DESCRIPTION : Subroutine appellée par KONV1
  10. C
  11. C Modelisation 2D/3D des equations d'Euler.
  12. C Ghost Fluid Method for the poor.
  13. C
  14. C Calcul du residu / DELTAT
  15. C
  16. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  17. C
  18. C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF
  19. C
  20. C************************************************************************
  21. C
  22. C APPELES (Calcul) : KGFM12 (2D, GFMP)
  23. C
  24. C************************************************************************
  25. C
  26. C*** SINTAXE
  27. C
  28. C Discrétisation en VF "cell-centered" des équations d'Euler pour
  29. C un "stiffened" gas. Methode GFMP.
  30. C
  31. C Inconnues: phi, densité, quantité de mouvement, énergie totale par
  32. C unité de volume (variables conservatives), densité et fractions
  33. C volumiques des constituants.
  34. C
  35. C
  36. C RCHPO1 RFLOT1 = 'KONV' 'VF' 'GFMP' MOT1 MOT2 MOD1
  37. C TABG
  38. C LMOT1 MCHAPH MCHAR MCHAV MCHAP MCHAY
  39. C MCHAA MCHAY MCHPPH LOG1 MAILLIM ;
  40. C ENTREES
  41. C
  42. C
  43. C MOT1 : objet de type MOT
  44. C Il vaut 'RESI' si on veut calculer le résidu
  45. C
  46. C MOT2 : objet de type MOT
  47. C Il indique la méthode de décentrement:
  48. C 'GODUNOV'
  49. C
  50. C MOD1 : objet modele de type Euler
  51. C
  52. C TABG : objet de type TABLE
  53. C il contient les proprietes du gaz:
  54. C
  55. C LMOT1 : objet de type LISTMOTS
  56. C Noms de composantes du résultat (RCHPO1)
  57. C Il contient dans l'ordre suivant les noms de
  58. * phi, de la densités, de la vitesse, de l'énergie totale
  59. * par unité de volume, des densités des espèces, des
  60. C fractions volumiques.
  61. C
  62. C MCHAPH : MCHAML contenant la function phi,
  63. C qui a comme SPG (support géométrique) l'indice 'FACEL' de la
  64. C table associée à MOD1 (une composante, 'SCAL')
  65. C
  66. C MCHAR : MCHAML contenant la masse volumique,
  67. C même SPG que MCHAA1, une composante, 'SCAL'
  68. C
  69. C MCHAV : MCHAML contenant la vitesse et les cosinus
  70. C directeurs du repère locale (n,t) dans le repère
  71. C global (x,y), même SPG que MCHAA1,
  72. C (dans le cas 2D 6 composantes:
  73. C * 'UN' = vitesse normale (SPG =('DOMA' MOD1 'FACEL'))
  74. C * 'UT' = vitesse tangentielle (SPG =('DOMA' MOD1 'FACEL'))
  75. C * 'NX' = n.x (SPG = 'FACE')
  76. C * 'NY' = n.y (SPG = 'FACE')
  77. C * 'TX' = t.x (SPG = 'FACE')
  78. C * 'TY' = t.y (SPG = 'FACE')).
  79. C
  80. C MCHAP : MCHAML (SPG =('DOMA' MOD1 'FACEL')) contenant la pression
  81. C (une seule composante, 'SCAL').
  82. C
  83. C MCHAY : MCHAML (SPG =('DOMA' MOD1 'FACEL')) contenant les fractions
  84. C massiques (composantes dans TABG . 'ESPEULE').
  85. C
  86. C MCHAA : MCHAML (SPG =('DOMA' MOD1 'FACEL')) contenant les fractions
  87. C volumiques (composantes dans TABG . 'ESPEULE').
  88. C
  89. C MCHPPH : CHPO contenant phi,
  90. C qui a comme SPG (support géométrique) l'indice 'CENTRE' de la
  91. C table associée à MOD1 (une composante, 'SCAL')
  92. C
  93. C MCHPPH : CHPO contenant la fraction volumique alpha de la phase 1,
  94. C qui a comme SPG (support géométrique) l'indice 'CENTRE' de la
  95. C table associée à MOD1 (une composante, 'SCAL')
  96. C
  97. C LOG1 : LOGIQUE, si VRAI phi et les fractions volumiques sont
  98. C traités avec une approche conservative
  99. C
  100. C MAILLIM : MAILLAGE -- describes the mesh where the flux is not
  101. C determined; it will be found by using
  102. C the subroutins for the Boundary Conditions
  103. C
  104. C SORTIES
  105. C
  106. C RCHPO1 : objet de type CHPOINT (composantes = LMOT1)
  107. C Residu si MOT2 = 'RESI' (SPG =('DOMA' MOD1 'CENTRE'))
  108. C
  109. C RFLOT1 : objet de type FLOTTANT
  110. C Il est le temps caracteristique associé à l'onde la plus
  111. C rapide.
  112. C
  113. C Remarque
  114. C --------
  115. C
  116. C RCHPO1 est égal à:
  117. C * la derivé temporelle des inconnues si l'option 'RESI' est utilisée
  118. C
  119. C
  120. C***********************************************************************
  121. C
  122. C************************************************************************
  123. C
  124. C HISTORIQUE (Anomalies et modifications éventuelles)
  125. C
  126. C 04/12/2010 - Created
  127. * 25/05/2011 - Evolution in CAST3M
  128. C
  129. C************************************************************************
  130. C
  131. IMPLICIT INTEGER(I-N)
  132. C
  133. -INC CCOPTIO
  134. -INC SMLMOTS
  135. POINTEUR MLMVIT.MLMOTS, MLMESP.MLMOTS
  136. -INC SMELEME
  137. -INC SMLREEL
  138. POINTEUR MLRMGA.MLREEL, MLRPGA.MLREEL,
  139. & MLRMPI.MLREEL, MLRPPI.MLREEL
  140. C
  141. INTEGER NESP, NESP1, IPGAS
  142. & , IDOMA, MELEMC, MELEMF, MELEFE, ICHPSU, ICHPDI , ICHPVO
  143. & , INORM, MELLIM, IFLIM
  144. & , NBMET, INDMET, IRET
  145. & , JGM, JGN
  146. & , INDIC, NBCOMP
  147. & , IPHI1
  148. & , IPHIF, IROF1, IVITF1, IPF1
  149. & , NINC, ILIINC, NC, ICELL
  150. & , ICHRES, INEFMD, ICOND, MMODEL
  151. & , ITOTO, IFRMAF, IFRALF, IALC
  152. C
  153. PARAMETER (NBMET=1)
  154. REAL*8 DT, PMIN
  155. CHARACTER*8 LMETO(NBMET), TYPE, MTYPI
  156. CHARACTER*4 LFLUX(1), MOT1(1)
  157. CHARACTER*(40) MESERR
  158. LOGICAL LOGNC, LOGAN, LOGCON
  159. C
  160. C**** Variables en ACCTAB
  161. C
  162. INTEGER IVALI, IRETI,IVALR, IRETR
  163. REAL*8 XVALI,XVALR
  164. LOGICAL LOGII, LOGIR
  165. CHARACTER*(8) CHARR
  166. C
  167. DATA LMETO/'GODUNOV '/
  168. DATA LFLUX/'RESI'/
  169. C
  170. C**** Initialisation des variables pour la gestion des erreurs.
  171. C
  172. LOGNC = .FALSE.
  173. LOGAN = .FALSE.
  174. MESERR = ' '
  175. C
  176. C******* Flux ou residu???
  177. C
  178. CALL LIRMOT(LFLUX,1,ICELL,1)
  179. IF(IERR .NE. 0)GOTO 9999
  180. IF(ICELL .NE. 1)THEN
  181. C LOGRES = .TRUE.
  182. C ELSE
  183. C
  184. C******** Message d'erreur standard
  185. C 251 2
  186. C Tentative d'utilisation d'une option non implémentée
  187. C
  188. CALL ERREUR(251)
  189. ENDIF
  190. C
  191. C**** Metode utilisée
  192. C
  193. CALL LIRMOT(LMETO,NBMET,INDMET,1)
  194. IF(IERR .NE. 0)GOTO 9999
  195. IF(INDMET .EQ. 0)THEN
  196. C
  197. C******** Message d'erreur standard
  198. C 251 2
  199. C Tentative d'utilisation d'une option non implémentée
  200. C
  201. CALL ERREUR(251)
  202. ENDIF
  203. C********************************
  204. C**** La table IPGAZ *******
  205. C********************************
  206. C
  207. C write(*,*) 'Son qui prima di gas'
  208. C
  209. C
  210. C**** Initialisation des variables en ACCTAB
  211. C
  212. IVALI = 0
  213. IVALR = 0
  214. XVALI = 0.0D0
  215. XVALR = 0.0D0
  216. LOGII = .FALSE.
  217. LOGIR = .FALSE.
  218. IRETI = 0
  219. IRETR = 0
  220. CHARR = ' '
  221. C
  222. C**************************************************
  223. C**** Lecture de la table des proprietes du gaz ***
  224. C**************************************************
  225. C
  226. ICOND = 1
  227. CALL QUETYP(TYPE,ICOND,IRETOU)
  228. IF(IERR .NE. 0)GOTO 9999
  229. IF(TYPE .NE. 'TABLE ')THEN
  230. C
  231. C******* Message d'erreur standard
  232. C 37 2
  233. C On ne trouve pas d'objet de type %m1:8
  234. C
  235. MOTERR(1:8) = 'TABLE '
  236. CALL ERREUR(37)
  237. GOTO 9999
  238. ELSE
  239. ICOND = 1
  240. CALL LIROBJ(TYPE,IPGAS,ICOND,IRETOU)
  241. IF(IERR .NE. 0)GOTO 9999
  242. ENDIF
  243. C
  244. C**** Nom de l'espece qui n'est pas dans les equations d'Euler
  245. C
  246. MTYPI = 'MOT '
  247. TYPE = ' '
  248. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE', LOGII,IRETI,
  249. & TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
  250. IF((IERR .NE. 0) .OR. (TYPE .NE. 'MOT ')) THEN
  251. C
  252. C******* Message d'erreur standard
  253. C -301 0 %m1:40
  254. C
  255. MOTERR = 'TAB1 . ESPNEULE = ??? '
  256. WRITE(IOIMP,*) MOTERR(1:40)
  257. C
  258. C********** Message d'erreur standard
  259. C 21 2
  260. C Données incompatibles
  261. C
  262. CALL ERREUR(21)
  263. GOTO 9999
  264. ENDIF
  265. C
  266. C**** Les especes qui sont dans les Equations d'Euler
  267. C
  268. TYPE = ' '
  269. CALL ACMO(IPGAS,'ESPEULE',TYPE,MLMESP)
  270. IF(TYPE .NE. 'LISTMOTS')THEN
  271. C
  272. C******* Message d'erreur standard
  273. C -301 0 %m1:40
  274. C
  275. MOTERR(1:40) = 'TAB1 . ESPEULE = ??? '
  276. WRITE(IOIMP,*) MOTERR(1:40)
  277. C
  278. C******* Message d'erreur standard
  279. C 21 2
  280. C Données incompatibles
  281. C
  282. CALL ERREUR(21)
  283. GOTO 9999
  284. ENDIF
  285. SEGACT MLMESP
  286. NESP = MLMESP.MOTS(/2)
  287. SEGDES MLMESP
  288. C
  289. C**** List de gamma, PHI < 0 (MLRMGA, MLRrel Minus GAMMA)
  290. C
  291. MTYPI = 'MOT '
  292. TYPE = ' '
  293. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'MGAM', LOGII,IRETI,
  294. & TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
  295. IF((IERR .NE. 0) .OR. (TYPE .NE. 'LISTREEL')) THEN
  296. C
  297. C********** Message d'erreur standard
  298. C -301 0 %m1:40
  299. C
  300. MOTERR = ' TAB1 . MGAM = ??? '
  301. WRITE(IOIMP,*) MOTERR
  302. C
  303. C********** Message d'erreur standard
  304. C 21 2
  305. C Données incompatibles
  306. C
  307. CALL ERREUR(21)
  308. GOTO 9999
  309. ENDIF
  310. MLRMGA = IRETR
  311. SEGACT MLRMGA
  312. NESP1 = MLRMGA.PROG(/1)
  313. IF(NESP1 .NE. (NESP + 1))THEN
  314. C
  315. C********** Message d'erreur standard
  316. C -301 0 %m1:40
  317. C
  318. MOTERR = 'DIME(TAB1.MGAM) != NESP '
  319. WRITE(IOIMP,*) MOTERR(1:40)
  320. C
  321. C********** Message d'erreur standard
  322. C 21 2
  323. C Données incompatibles
  324. C
  325. CALL ERREUR(21)
  326. GOTO 9999
  327. ENDIF
  328. C
  329. C**** List de gamma, PHI > 0 (MLRPGA, MLRrel Plus GAMMA)
  330. C
  331. MTYPI = 'MOT '
  332. TYPE = ' '
  333. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'PGAM', LOGII,IRETI,
  334. & TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
  335. IF((IERR .NE. 0) .OR. (TYPE .NE. 'LISTREEL')) THEN
  336. C
  337. C********** Message d'erreur standard
  338. C -301 0 %m1:40
  339. C
  340. MOTERR = ' TAB1 . PGAM = ??? '
  341. WRITE(IOIMP,*) MOTERR
  342. C
  343. C********** Message d'erreur standard
  344. C 21 2
  345. C Données incompatibles
  346. C
  347. CALL ERREUR(21)
  348. GOTO 9999
  349. ENDIF
  350. MLRPGA = IRETR
  351. SEGACT MLRPGA
  352. NESP1 = MLRPGA.PROG(/1)
  353. IF(NESP1 .NE. (NESP + 1))THEN
  354. C
  355. C********** Message d'erreur standard
  356. C -301 0 %m1:40
  357. C
  358. MOTERR = 'DIME(TAB1.PGAM) != NESP '
  359. WRITE(IOIMP,*) MOTERR(1:40)
  360. C
  361. C********** Message d'erreur standard
  362. C 21 2
  363. C Données incompatibles
  364. C
  365. CALL ERREUR(21)
  366. GOTO 9999
  367. ENDIF
  368. C
  369. C**** List de PINF, PHI < 0 (MLRMPI)
  370. C
  371. MTYPI = 'MOT '
  372. TYPE = ' '
  373. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'MPIN', LOGII,IRETI,
  374. & TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
  375. IF((IERR .NE. 0) .OR. (TYPE .NE. 'LISTREEL')) THEN
  376. C
  377. C********** Message d'erreur standard
  378. C -301 0 %m1:40
  379. C
  380. MOTERR = ' TAB1 . MPIN = ??? '
  381. WRITE(IOIMP,*) MOTERR
  382. C
  383. C********** Message d'erreur standard
  384. C 21 2
  385. C Données incompatibles
  386. C
  387. CALL ERREUR(21)
  388. GOTO 9999
  389. ENDIF
  390. MLRMPI = IRETR
  391. SEGACT MLRMPI
  392. NESP1 = MLRMPI.PROG(/1)
  393. IF(NESP1 .NE. (NESP + 1))THEN
  394. C
  395. C********** Message d'erreur standard
  396. C -301 0 %m1:40
  397. C
  398. MOTERR = 'DIME(TAB1.MPIN) != NESP '
  399. WRITE(IOIMP,*) MOTERR(1:40)
  400. C
  401. C********** Message d'erreur standard
  402. C 21 2
  403. C Données incompatibles
  404. C
  405. CALL ERREUR(21)
  406. GOTO 9999
  407. ENDIF
  408. C
  409. C**** List de PINF, PHI > 0 (MLRPPI)
  410. C
  411. MTYPI = 'MOT '
  412. TYPE = ' '
  413. CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'PPIN', LOGII,IRETI,
  414. & TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
  415. IF((IERR .NE. 0) .OR. (TYPE .NE. 'LISTREEL')) THEN
  416. C
  417. C********** Message d'erreur standard
  418. C -301 0 %m1:40
  419. C
  420. MOTERR = ' TAB1 . PPIN = ??? '
  421. WRITE(IOIMP,*) MOTERR
  422. C
  423. C********** Message d'erreur standard
  424. C 21 2
  425. C Données incompatibles
  426. C
  427. CALL ERREUR(21)
  428. GOTO 9999
  429. ENDIF
  430. MLRPPI = IRETR
  431. SEGACT MLRPPI
  432. NESP1 = MLRPPI.PROG(/1)
  433. IF(NESP1 .NE. (NESP + 1))THEN
  434. C
  435. C********** Message d'erreur standard
  436. C -301 0 %m1:40
  437. C
  438. MOTERR = 'DIME(TAB1.PPIN) != NESP '
  439. WRITE(IOIMP,*) MOTERR(1:40)
  440. C
  441. C********** Message d'erreur standard
  442. C 21 2
  443. C Données incompatibles
  444. C
  445. CALL ERREUR(21)
  446. GOTO 9999
  447. ENDIF
  448. C
  449. C***********************************************************************
  450. C******************** Lecture du reste *********************************
  451. C***********************************************************************
  452. C
  453. C**********************************
  454. C**** Lecture de l'objet MODELE ***
  455. C**********************************
  456. C
  457. ICOND = 1
  458. CALL QUETYP(TYPE,ICOND,IRET)
  459.  
  460. IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN
  461. WRITE(IOIMP,*)' On attend un objet MMODEL'
  462. RETURN
  463. ENDIF
  464. CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET)
  465. IF(IERR.NE.0)GOTO 9999
  466. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  467. IF(IERR.NE.0)GOTO 9999
  468. C
  469. C**** Centre, FACE et FACEL
  470. C
  471. CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
  472. IF(IERR .NE. 0) GOTO 9999
  473. C
  474. CALL LEKTAB(IDOMA,'FACE',MELEMF)
  475. IF(IERR .NE. 0) GOTO 9999
  476. C
  477. CALL LEKTAB(IDOMA,'FACEL',MELEFE)
  478. IF(IERR .NE. 0) GOTO 9999
  479. C
  480. C**** Lecture du CHPOINT contenant les surfaces des faces.
  481. C
  482. CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU)
  483. IF(IERR .NE. 0) GOTO 9999
  484. C
  485. C**** Lecture du CHPOINT contenant les diametres minimums.
  486. C
  487. CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI)
  488. IF(IERR .NE. 0) GOTO 9999
  489. C
  490. C**** Lecture du CHPOINT contenant les volumes
  491. C
  492. CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO)
  493. IF(IERR .NE. 0) GOTO 9999
  494. C
  495. C********** Les normales aux faces
  496. C
  497. IF(IDIM .EQ. 2)THEN
  498. C Que les normales
  499. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  500. IF(IERR .NE. 0) GOTO 9999
  501. JGN = 4
  502. JGM = 2
  503. SEGINI MLMVIT
  504. MLMVIT.MOTS(1) = 'UX '
  505. MLMVIT.MOTS(2) = 'UY '
  506. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  507. SEGSUP MLMVIT
  508. IF(IERR .NE. 0) GOTO 9999
  509. ELSE
  510. C Les normales et les tangentes
  511. TYPE = ' '
  512. CALL ACMO(IDOMA,'MATROT',TYPE,INORM)
  513. IF (TYPE .NE. 'CHPOINT ') THEN
  514. CALL MATRAN(IDOMA,INORM)
  515. IF(IERR .NE. 0) GOTO 9999
  516. ENDIF
  517. JGN = 4
  518. JGM = 9
  519. SEGINI MLMVIT
  520. MLMVIT.MOTS(1) = 'UX '
  521. MLMVIT.MOTS(2) = 'UY '
  522. MLMVIT.MOTS(3) = 'UZ '
  523. MLMVIT.MOTS(4) = 'RX '
  524. MLMVIT.MOTS(5) = 'RY '
  525. MLMVIT.MOTS(6) = 'RZ '
  526. MLMVIT.MOTS(7) = 'MX '
  527. MLMVIT.MOTS(8) = 'MY '
  528. MLMVIT.MOTS(9) = 'MZ '
  529. CALL QUEPO1(INORM, MELEMF, MLMVIT)
  530. SEGSUP MLMVIT
  531. ENDIF
  532. C
  533. C********************************
  534. C**** Fin table domaine *********
  535. C********************************
  536. C
  537. C**** Lecture du CHPOINT PHI1 (level set)
  538. C
  539. TYPE='CHPOINT '
  540. ICOND = 1
  541. CALL LIROBJ(TYPE,IPHI1,ICOND,IRET)
  542. IF(IERR .NE. 0)GOTO 9999
  543. C
  544. C**** Control du CHPOINT: QUEPOI
  545. C
  546. C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
  547. C N.B. Le CHPOINT peut changer de structure pour
  548. C avoir SPG = ICEN!!!!
  549. C INDIC = 0 -> on ne fait que verifier le support geometrique
  550. C (ICEN). Si le SPG sont differents INDIC = -4 en sortie
  551. C
  552. C NBCOMP > 0 -> numero des composantes
  553. C
  554. C MOT1(1) = ' ' obligatoire s'on connais pas les noms des composantes
  555. C
  556. INDIC = 1
  557. NBCOMP = 1
  558. MOT1(1) = 'SCAL'
  559. CALL QUEPOI(IPHI1, MELEMC, INDIC, NBCOMP, MOT1)
  560. IF(IERR .NE. 0)THEN
  561. C
  562. C******** Message d'erreur standard
  563. C -301 0 %m1:40
  564. C
  565. MOTERR = 'IPHI1 = ??? '
  566. WRITE(IOIMP,*) MOTERR(1:40)
  567. GOTO 9999
  568. ENDIF
  569. C
  570. IF (NESP .GE. 1) THEN
  571. C
  572. C******* ALPHA au centre.
  573. C
  574. ICOND = 1
  575. TYPE = 'CHPOINT '
  576. CALL LIROBJ(TYPE,IALC,1,IRET)
  577. IF (IERR.NE.0) GOTO 9999
  578. C
  579. C**** Control du CHPOINT
  580. C
  581. CALL QUEPO1(IALC, MELEMC, MLMESP)
  582. IF(IERR .NE. 0) GOTO 9999
  583. ENDIF
  584. C
  585. C**** On va lire les pointeurs des MCHAMLs
  586. C Lecture du MCHAML 'FACEL' alpha
  587. C
  588. TYPE='MCHAML '
  589. CALL LIROBJ(TYPE,IPHIF,1,IRET)
  590. IF(IERR.NE.0) GOTO 9999
  591. C Lecture du MCHAML 'FACEL' densité
  592. C
  593. TYPE='MCHAML '
  594. CALL LIROBJ(TYPE,IROF1,1,IRET)
  595. IF(IERR.NE.0) GOTO 9999
  596. C
  597. C**** Lecture du MCHAML 'FACEL' vitesse
  598. C
  599. TYPE='MCHAML '
  600. CALL LIROBJ(TYPE,IVITF1,1,IRET)
  601. IF(IERR .NE. 0) GOTO 9999
  602. C
  603. C**** Lecture du MCHAML 'FACEL' contenant la pression
  604. C
  605. TYPE='MCHAML '
  606. CALL LIROBJ(TYPE,IPF1,1,IRET)
  607. IF(IERR .NE. 0) GOTO 9999
  608. C
  609. IF (NESP .GE. 1) THEN
  610. C
  611. C******** Lecture du MCHAML 'FACEL' contenant les fractiones massiques
  612. C ET ALPHA
  613. C
  614. TYPE='MCHAML '
  615. CALL LIROBJ(TYPE,IFRMAF,1,IRET)
  616. IF(IERR .NE. 0) GOTO 9999
  617. C
  618. TYPE='MCHAML '
  619. CALL LIROBJ(TYPE,IFRALF,1,IRET)
  620. IF(IERR .NE. 0) GOTO 9999
  621. C
  622. ELSE
  623. C
  624. IFRMAF = 0
  625. IFRALF = 0
  626. C
  627. ENDIF
  628. C
  629. C**** NINC = nombre d'inconnues
  630. C
  631. NINC=(IDIM+3)+(2*NESP)
  632. C
  633. TYPE='LISTMOTS'
  634. CALL LIROBJ(TYPE,ILIINC,1,IRET)
  635. IF(IERR .NE. 0) GOTO 9999
  636. MLMOTS = ILIINC
  637. SEGACT MLMOTS
  638. NC = MLMOTS.MOTS(/2)
  639. SEGDES MLMOTS
  640. IF(NC .NE. NINC)THEN
  641. MOTERR(1:40) = 'LISTINCO = ???'
  642. WRITE(IOIMP,*) MOTERR
  643. C
  644. C******* Message d'erreur standard
  645. C 21 2
  646. C Données incompatibles
  647. C
  648. CALL ERREUR(21)
  649. GOTO 9999
  650. ENDIF
  651. C
  652. C**** Boundary condition
  653. C
  654. IRET=0
  655. TYPE='MAILLAGE'
  656. CALL LIROBJ(TYPE,IFLIM,0,IRET)
  657. IF(IERR.NE.0)GOTO 9999
  658. IF(IRET .EQ. 0)THEN
  659. MELLIM = 0
  660. ELSE
  661. MELEME=IFLIM
  662. SEGACT MELEME
  663. ITOTO=MELEME.NUM(/2)
  664. IF(ITOTO .EQ. 0)THEN
  665. MELLIM = 0
  666. ELSE
  667. MELLIM = IFLIM
  668. ENDIF
  669. SEGDES MELEME
  670. ENDIF
  671. C
  672. C**** Conservative or non-conservative approach
  673. C
  674. CALL LIRLOG(LOGCON , ICOND , IRET)
  675. IF (IERR.NE.0) GOTO 9999
  676. C
  677. C**** Minimum pressure for vacuum
  678. C
  679. CALL LIRREE(PMIN, ICOND , IRET)
  680. IF (IERR.NE.0) GOTO 9999
  681. C
  682. C
  683. C write(*,*) 'Son qui dopo la lettura degli inputs'
  684. C
  685. C**** Creation du residu
  686. C
  687. TYPE = 'CHPOINT '
  688. CALL KRCHP1(TYPE, MELEMC, ICHRES, MLMOTS)
  689. C
  690. C**** Calcul des flux et du pas du temps.
  691. C
  692. IF( IDIM .EQ. 2)THEN
  693. CALL KGFM12(LOGCON,
  694. & NESP,
  695. & INDMET,
  696. & MLRMGA, MLRMPI, MLRPGA, MLRPPI,
  697. & PMIN,
  698. & IPHI1, IALC,
  699. & IPHIF,IROF1,IVITF1,IPF1,
  700. & IFRMAF, IFRALF,
  701. & ICHPSU,ICHPDI,ICHPVO,
  702. & MELEMC,MELEMF,MELEFE,MELLIM,
  703. & ICHRES,
  704. & DT,
  705. & LOGNC,LOGAN,MESERR)
  706. C ELSE
  707. C CALL KONFL4(LOGME,LOGSCA,INDMET,NORDP1,
  708. C & IROF,IVITF,IPF,IFRMAF,ISCAF,PROPHY,
  709. C & ICHPSU,ICHPDI,
  710. C & MELEMC,MELEMF,MELEFE,MELLIM,
  711. C & ICHRES,
  712. C & DT,
  713. C & LOGNC,LOGAN,MESERR)
  714. ENDIF
  715. C
  716. IF(LOGAN)THEN
  717. C
  718. C******* Anomalie detectée
  719. C
  720. C
  721. C******* Message d'erreur standard
  722. C -301 0
  723. C %m1:40
  724. C
  725. MOTERR(1:40) = MESERR(1:40)
  726. WRITE(IOIMP,*) MOTERR(1:40)
  727. C
  728. C******* Message d'erreur standard
  729. C 5 3
  730. C Erreur anormale.contactez votre support
  731. C
  732. CALL ERREUR(5)
  733. GOTO 9999
  734. ENDIF
  735. IF(LOGNC)THEN
  736. C
  737. C******* Message d'erreur standard
  738. C -301 0
  739. C %m1:40
  740. C
  741. MOTERR(1:40) = MESERR(1:40)
  742. WRITE(IOIMP,*) MOTERR(1:40)
  743. C
  744. C******* Message d'erreur standard
  745. C 460 2
  746. C Pas de convergence dans les itérations internes
  747. C
  748. CALL ERREUR(460)
  749. GOTO 9999
  750. ENDIF
  751. C
  752. C**** Ecriture des resultats
  753. C
  754. CALL ECRREE(DT)
  755. TYPE = 'CHPOINT '
  756. IF(ICHRES .NE. 0) CALL ECROBJ(TYPE,ICHRES)
  757. C
  758. 9999 CONTINUE
  759. RETURN
  760. END
  761.  
  762.  
  763.  
  764.  
  765.  
  766.  
  767.  
  768.  
  769.  
  770.  
  771.  
  772.  
  773.  
  774.  
  775.  
  776.  
  777.  

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