Télécharger pre42f.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE42F SOURCE KK2000 14/04/10 21:15:31 8032
  2. SUBROUTINE PRE42F(ORDTEM)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PRE42F
  8. C
  9. C DESCRIPTION : Voir PRE2F
  10. C
  11. C Two Fluid flow
  12. C
  13. C 2nd order in space 1st or 2nd order in time
  14. C
  15. C Creation of the objects MCHAML IALPHF, IUVF, IULF,
  16. C IPF, ITVF, ITLF, IRVF, IRLF
  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 Modified for two-fluid flow by
  22. C Jose R. Garcia-Cascales
  23. C
  24. C************************************************************************
  25. C
  26. C APPELES (Outils) : LIRTAB, ACMO, LEKTAB, QUETYP, ERREUR, LIROBJ,
  27. C QUEPOI, ECROBJ
  28. C
  29. C
  30. C APPELES (Calcul) : PRE52F (2D) PRE62F (3D)
  31. C
  32. C************************************************************************
  33. C
  34. C HISTORIQUE (Anomalies et modifications éventuelles)
  35. C
  36. C HISTORIQUE : Créée le 26/04/2002.
  37. C
  38. C************************************************************************
  39. C
  40. IMPLICIT INTEGER(I-N)
  41. IMPLICIT REAL*8(A-H,O-Z)
  42.  
  43. C
  44. C**** Les variables
  45. C
  46. INTEGER ORDTEM, ICOND, IRETOU, INDIC, NBCOMP,
  47. & IDOMA, ICEN, IFACE, IFACEL, INORM,
  48. & IALPH, IGRALP, IALALP,
  49. & IUVC, IGRUVC, IALUVC,
  50. & IULC, IGRULC, IALULC,
  51. & IPC, IGRPC, IALPC,
  52. & ITVC, IGRTVC, IALTVC,
  53. & ITLC, IGRTLC, IALTLC,
  54. & IRVC, IRLC,
  55. & IALPHF, IUVF, IULF, IPF, ITVF, ITLF, IRVF, IRLF
  56. REAL*8 VALER, VAL1, VAL2, DELTAT
  57. CHARACTER*(4) NOMTOT(9)
  58. CHARACTER*(8) MTYPR
  59. CHARACTER*(40) MESERR
  60. LOGICAL LOGAN,LOGNEG, LOGBOR,LOGTEM
  61. C
  62. C**** Les Includes
  63. C
  64.  
  65. -INC PPARAM
  66. -INC CCOPTIO
  67. C
  68. C
  69. C**** Initialisation des parametres d'erreur
  70. C
  71. LOGAN = .FALSE.
  72. LOGNEG = .FALSE.
  73. LOGBOR = .FALSE.
  74. MESERR = ' '
  75. MOTERR(1:40) = MESERR(1:40)
  76. VALER = 0.0D0
  77. VAL1 = 0.0D0
  78. VAL2 = 0.0D0
  79. C
  80. C**** Initialisation des NOMTOT
  81. C
  82. NOMTOT(1) = ' '
  83. NOMTOT(2) = ' '
  84. NOMTOT(3) = ' '
  85. NOMTOT(4) = ' '
  86. NOMTOT(5) = ' '
  87. NOMTOT(6) = ' '
  88. NOMTOT(7) = ' '
  89. NOMTOT(8) = ' '
  90. NOMTOT(9) = ' '
  91. C
  92. C**** Lecture de la TABLE domaine (IDOMA)
  93. C
  94. ICOND = 1
  95. CALL LIRTAB('DOMAINE',IDOMA,ICOND,IRETOU)
  96. IF (IERR .NE. 0) GOTO 9999
  97. C
  98. C**** Lecture du MELEME SPG des points CENTRE.
  99. C
  100. C
  101. C CALL LEKTAB(IDOMA,'CENTRE',IP)
  102. C
  103. C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
  104. C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
  105. C -> la correspondance global des noeuds saut!
  106. C
  107. C On peut utilizer ACCTAB ou ACMO
  108. C
  109. MTYPR = 'MAILLAGE'
  110. CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN)
  111. IF(IERR.NE.0)GOTO 9999
  112. C
  113. C**** Lecture du MELEME 'FACE'
  114. C
  115. MTYPR = 'MAILLAGE'
  116. CALL ACMO(IDOMA,'FACE',MTYPR,IFACE)
  117. IF(IERR.NE.0)GOTO 9999
  118. C
  119. C**** Lecture du MELEME 'FACEL'
  120. C
  121. MTYPR = 'MAILLAGE'
  122. CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL)
  123. IF(IERR.NE.0)GOTO 9999
  124. C
  125. C**** Lecture du CHPOINT contenant les normales aux faces
  126. C
  127. IF(IDIM .EQ. 2)THEN
  128. C Que les normales
  129. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  130. IF(IERR .NE. 0) GOTO 9999
  131. ELSE
  132. C Les normales et les tangentes
  133. MTYPR = ' '
  134. CALL ACMO(IDOMA,'MATROT',MTYPR,INORM)
  135. IF (MTYPR .NE. 'CHPOINT ') THEN
  136. CALL MATRAN(IDOMA,INORM)
  137. IF(IERR .NE. 0) GOTO 9999
  138. ENDIF
  139.  
  140. C
  141. ENDIF
  142. C
  143. C**** N.B. On veut lire les objets sequentiellement.
  144. C Donc on utilise QUETYP pour controler que
  145. C le type de l'objet soit le bon.
  146. C
  147. C**** Lecture du CHPOINT IALPH, VOID FRACTION
  148. C
  149. ICOND = 1
  150. CALL QUETYP(MTYPR,ICOND,IRETOU)
  151. IF(IERR .NE. 0)GOTO 9999
  152. IF(MTYPR .NE. 'CHPOINT ')THEN
  153. C
  154. C******* Message d'erreur standard
  155. C 37 2
  156. C On ne trouve pas d'objet de type %m1:8
  157. C
  158. MOTERR(1:8) = 'CHPOINT '
  159. CALL ERREUR(37)
  160. GOTO 9999
  161. ELSE
  162. ICOND = 1
  163. CALL LIROBJ(MTYPR,IALPH,ICOND,IRETOU)
  164. IF (IERR.NE.0) GOTO 9999
  165. ENDIF
  166. C
  167. C**** Control du CHPOINT: QUEPOI
  168. C
  169. C INDIC = 1 -> on impose le pointeur du support geometrique (IM1)
  170. C INDIC = 0 -> on ne fait que verifier le support geometrique (IM1)
  171. C
  172. C NBCOMP > 0 -> numero des composantes
  173. C
  174. C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
  175. C
  176. INDIC = 1
  177. NBCOMP = 1
  178. NOMTOT(1) = 'SCAL'
  179. CALL QUEPOI(IALPH, ICEN, INDIC, NBCOMP, NOMTOT)
  180. IF(IERR .NE. 0)THEN
  181.  
  182. C******* Message d'erreur standard
  183. C -301 0 %m1:40
  184. C
  185. MOTERR(1:40) = 'CHPO1 = ??? '
  186. CALL ERREUR(-301)
  187.  
  188. GOTO 9999
  189. ENDIF
  190. C
  191. C**** Lecture du CHPOINT GRADALP, void fraction gradient
  192. C
  193. ICOND = 1
  194. CALL QUETYP(MTYPR,ICOND,IRETOU)
  195. IF(IERR .NE. 0)GOTO 9999
  196. IF(MTYPR .NE. 'CHPOINT ')THEN
  197. C
  198. C******* Message d'erreur standard
  199. C 37 2
  200. C On ne trouve pas d'objet de type %m1:8
  201. C
  202. MOTERR(1:8) = 'CHPOINT '
  203. CALL ERREUR(37)
  204. GOTO 9999
  205. ELSE
  206. ICOND = 1
  207. CALL LIROBJ(MTYPR,IGRALP,ICOND,IRETOU)
  208. IF (IERR.NE.0) GOTO 9999
  209. ENDIF
  210. C
  211. C**** Control du CHPOINT: QUEPOI
  212. C
  213. C INDIC = 1 -> on impose le pointeur du support geometrique (IM1)
  214. C INDIC = 0 -> on ne fait que verifier le support geometrique (IM1)
  215. C
  216. C NBCOMP = 2 -> on teste le noms des composantes
  217. C
  218. C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
  219. C
  220. INDIC = 1
  221. NBCOMP = IDIM
  222. NOMTOT(1) = 'P1DX'
  223. NOMTOT(2) = 'P1DY'
  224. IF(IDIM .EQ. 3) NOMTOT(3) = 'P1DZ'
  225. CALL QUEPOI(IGRALP, ICEN, INDIC, NBCOMP, NOMTOT)
  226. IF(IERR .NE. 0)THEN
  227. C
  228. C******* Message d'erreur standard
  229. C -301 0 %m1:40
  230. C
  231. MOTERR(1:40) = 'CHPO2 = ??? '
  232. CALL ERREUR(-301)
  233.  
  234. GOTO 9999
  235. ENDIF
  236. C
  237. C**** Lecture du CHPOINT IALALP, limited void fraction gradient
  238. C
  239. ICOND = 1
  240. CALL QUETYP(MTYPR,ICOND,IRETOU)
  241. IF(IERR .NE. 0)GOTO 9999
  242. IF(MTYPR .NE. 'CHPOINT ')THEN
  243. C
  244. C******* Message d'erreur standard
  245. C 37 2
  246. C On ne trouve pas d'objet de type %m1:8
  247. C
  248. MOTERR(1:8) = 'CHPOINT '
  249. CALL ERREUR(37)
  250. GOTO 9999
  251. ELSE
  252. ICOND = 1
  253. CALL LIROBJ(MTYPR,IALALP,ICOND,IRETOU)
  254. IF (IERR.NE.0) GOTO 9999
  255. ENDIF
  256. C
  257. C**** Control du CHPOINT: QUEPOI
  258. C
  259. INDIC = 1
  260. NBCOMP = 1
  261. NOMTOT(1) = 'P1'
  262. CALL QUEPOI(IALALP, ICEN, INDIC, NBCOMP, NOMTOT)
  263. IF(IERR .NE. 0)THEN
  264.  
  265. C******* Message d'erreur standard
  266. C -301 0 %m1:40
  267. C
  268. MOTERR(1:40) = 'CHPO3 = ??? '
  269. CALL ERREUR(-301)
  270.  
  271. GOTO 9999
  272. ENDIF
  273. C
  274. C**** Lecture du CHPOINT IUVC, VAPOUR VELOCITY
  275. C
  276. ICOND = 1
  277. CALL QUETYP(MTYPR,ICOND,IRETOU)
  278. IF(IERR .NE. 0)GOTO 9999
  279. IF(MTYPR .NE. 'CHPOINT ')THEN
  280. C
  281. C******* Message d'erreur standard
  282. C 37 2
  283. C On ne trouve pas d'objet de type %m1:8
  284. C
  285. MOTERR(1:8) = 'CHPOINT '
  286. CALL ERREUR(37)
  287. GOTO 9999
  288. ELSE
  289. ICOND = 1
  290. CALL LIROBJ(MTYPR,IUVC,ICOND,IRETOU)
  291. IF (IERR.NE.0) GOTO 9999
  292. ENDIF
  293. C
  294. C**** Control du CHPOINT
  295. C
  296. INDIC = 1
  297. NBCOMP = IDIM
  298. NOMTOT(1) = 'UVX '
  299. NOMTOT(2) = 'UVY '
  300. IF(IDIM .EQ. 3) NOMTOT(3) = 'UVZ '
  301. CALL QUEPOI(IUVC, ICEN, INDIC, NBCOMP, NOMTOT)
  302. IF(IERR .NE. 0)THEN
  303.  
  304. C******* Message d'erreur standard
  305. C -301 0 %m1:40
  306. C
  307. MOTERR(1:40) = 'CHPO4 = ??? '
  308. CALL ERREUR(-301)
  309.  
  310. GOTO 9999
  311. ENDIF
  312. C
  313. C**** Lecture du CHPOINT GRADUVC, vapour velocity gradient
  314. C
  315. ICOND = 1
  316. CALL QUETYP(MTYPR,ICOND,IRETOU)
  317. IF(IERR .NE. 0)GOTO 9999
  318. IF(MTYPR .NE. 'CHPOINT ')THEN
  319. C
  320. C******* Message d'erreur standard
  321. C 37 2
  322. C On ne trouve pas d'objet de type %m1:8
  323. C
  324. MOTERR(1:8) = 'CHPOINT '
  325. CALL ERREUR(37)
  326. GOTO 9999
  327. ELSE
  328. ICOND = 1
  329. CALL LIROBJ(MTYPR,IGRUVC,ICOND,IRETOU)
  330. IF (IERR.NE.0) GOTO 9999
  331. ENDIF
  332. C
  333. C**** Control du CHPOINT: QUEPOI
  334. C
  335. INDIC = 1
  336. IF(IDIM .EQ.2)THEN
  337. NBCOMP = 4
  338. NOMTOT(1) = 'P1DX'
  339. NOMTOT(2) = 'P1DY'
  340. NOMTOT(3) = 'P2DX'
  341. NOMTOT(4) = 'P2DY'
  342. ELSE
  343. NBCOMP = 9
  344. NOMTOT(1) = 'P1DX'
  345. NOMTOT(2) = 'P1DY'
  346. NOMTOT(3) = 'P1DZ'
  347. NOMTOT(4) = 'P2DX'
  348. NOMTOT(5) = 'P2DY'
  349. NOMTOT(6) = 'P2DZ'
  350. NOMTOT(7) = 'P3DX'
  351. NOMTOT(8) = 'P3DY'
  352. NOMTOT(9) = 'P3DZ'
  353. ENDIF
  354. CALL QUEPOI(IGRUVC, ICEN, INDIC, NBCOMP, NOMTOT)
  355. IF(IERR .NE. 0)THEN
  356. C
  357. C******* Message d'erreur standard
  358. C -301 0 %m1:40
  359. C
  360. MOTERR(1:40) = 'CHPO5 = ??? '
  361. CALL ERREUR(-301)
  362.  
  363. GOTO 9999
  364. ENDIF
  365. C
  366. C**** Lecture du CHPOINT IALUVC, limited vapour velocity
  367. C
  368. ICOND = 1
  369. CALL QUETYP(MTYPR,ICOND,IRETOU)
  370. IF(IERR .NE. 0)GOTO 9999
  371. IF(MTYPR .NE. 'CHPOINT ')THEN
  372. C
  373. C******* Message d'erreur standard
  374. C 37 2
  375. C On ne trouve pas d'objet de type %m1:8
  376. C
  377. MOTERR(1:8) = 'CHPOINT '
  378. CALL ERREUR(37)
  379. GOTO 9999
  380. ELSE
  381. ICOND = 1
  382. CALL LIROBJ(MTYPR,IALUVC,ICOND,IRETOU)
  383. IF (IERR.NE.0) GOTO 9999
  384. ENDIF
  385. C
  386. C**** Control du CHPOINT: QUEPOI
  387. C
  388. INDIC = 1
  389. NBCOMP = IDIM
  390. NOMTOT(1) = 'P1'
  391. NOMTOT(2) = 'P2'
  392. IF(IDIM .EQ. 3) NOMTOT(3) = 'P3 '
  393. CALL QUEPOI(IALUVC, ICEN, INDIC, NBCOMP, NOMTOT)
  394. IF(IERR .NE. 0)THEN
  395. C
  396. C******* Message d'erreur standard
  397. C -301 0 %m1:40
  398. C
  399. MOTERR(1:40) = 'CHPO6 = ??? '
  400. CALL ERREUR(-301)
  401.  
  402. GOTO 9999
  403. ENDIF
  404. C
  405. C**** Lecture du CHPOINT IULC, LIQUID VELOCITY
  406. C
  407. ICOND = 1
  408. CALL QUETYP(MTYPR,ICOND,IRETOU)
  409. IF(IERR .NE. 0)GOTO 9999
  410. IF(MTYPR .NE. 'CHPOINT ')THEN
  411. C
  412. C******* Message d'erreur standard
  413. C 37 2
  414. C On ne trouve pas d'objet de type %m1:8
  415. C
  416. MOTERR(1:8) = 'CHPOINT '
  417. CALL ERREUR(37)
  418. GOTO 9999
  419. ELSE
  420. ICOND = 1
  421. CALL LIROBJ(MTYPR,IULC,ICOND,IRETOU)
  422. IF (IERR.NE.0) GOTO 9999
  423. ENDIF
  424. C
  425. C**** Control du CHPOINT
  426. C
  427. INDIC = 1
  428. NBCOMP = IDIM
  429. NOMTOT(1) = 'ULX '
  430. NOMTOT(2) = 'ULY '
  431. IF(IDIM .EQ. 3) NOMTOT(3) = 'ULZ '
  432. CALL QUEPOI(IULC, ICEN, INDIC, NBCOMP, NOMTOT)
  433. IF(IERR .NE. 0)THEN
  434. C
  435. C******* Message d'erreur standard
  436. C -301 0 %m1:40
  437. C
  438. MOTERR(1:40) = 'CHPO4 = ??? '
  439. CALL ERREUR(-301)
  440.  
  441. GOTO 9999
  442. ENDIF
  443. C
  444. C**** Lecture du CHPOINT GRADULC, liquid velocity gradient
  445. C
  446. ICOND = 1
  447. CALL QUETYP(MTYPR,ICOND,IRETOU)
  448. IF(IERR .NE. 0)GOTO 9999
  449. IF(MTYPR .NE. 'CHPOINT ')THEN
  450. C
  451. C******* Message d'erreur standard
  452. C 37 2
  453. C On ne trouve pas d'objet de type %m1:8
  454. C
  455. MOTERR(1:8) = 'CHPOINT '
  456. CALL ERREUR(37)
  457. GOTO 9999
  458. ELSE
  459. ICOND = 1
  460. CALL LIROBJ(MTYPR,IGRULC,ICOND,IRETOU)
  461. IF (IERR.NE.0) GOTO 9999
  462. ENDIF
  463. C
  464. C**** Control du CHPOINT: QUEPOI
  465. C
  466. INDIC = 1
  467. IF(IDIM .EQ.2)THEN
  468. NBCOMP = 4
  469. NOMTOT(1) = 'P1DX'
  470. NOMTOT(2) = 'P1DY'
  471. NOMTOT(3) = 'P2DX'
  472. NOMTOT(4) = 'P2DY'
  473. ELSE
  474. NBCOMP = 9
  475. NOMTOT(1) = 'P1DX'
  476. NOMTOT(2) = 'P1DY'
  477. NOMTOT(3) = 'P1DZ'
  478. NOMTOT(4) = 'P2DX'
  479. NOMTOT(5) = 'P2DY'
  480. NOMTOT(6) = 'P2DZ'
  481. NOMTOT(7) = 'P3DX'
  482. NOMTOT(8) = 'P3DY'
  483. NOMTOT(9) = 'P3DZ'
  484. ENDIF
  485. CALL QUEPOI(IGRULC, ICEN, INDIC, NBCOMP, NOMTOT)
  486. IF(IERR .NE. 0)THEN
  487. C
  488. C******* Message d'erreur standard
  489. C -301 0 %m1:40
  490. C
  491. MOTERR(1:40) = 'CHPO5 = ??? '
  492. CALL ERREUR(-301)
  493.  
  494. GOTO 9999
  495. ENDIF
  496. C
  497. C**** Lecture du CHPOINT IALULC, limited vapour velocity
  498. C
  499. ICOND = 1
  500. CALL QUETYP(MTYPR,ICOND,IRETOU)
  501. IF(IERR .NE. 0)GOTO 9999
  502. IF(MTYPR .NE. 'CHPOINT ')THEN
  503. C
  504. C******* Message d'erreur standard
  505. C 37 2
  506. C On ne trouve pas d'objet de type %m1:8
  507. C
  508. MOTERR(1:8) = 'CHPOINT '
  509. CALL ERREUR(37)
  510. GOTO 9999
  511. ELSE
  512. ICOND = 1
  513. CALL LIROBJ(MTYPR,IALULC,ICOND,IRETOU)
  514. IF (IERR.NE.0) GOTO 9999
  515. ENDIF
  516. C
  517. C**** Control du CHPOINT: QUEPOI
  518. C
  519. INDIC = 1
  520. NBCOMP = IDIM
  521. NOMTOT(1) = 'P1'
  522. NOMTOT(2) = 'P2'
  523. IF(IDIM .EQ. 3) NOMTOT(3) = 'P3 '
  524. CALL QUEPOI(IALULC, ICEN, INDIC, NBCOMP, NOMTOT)
  525. IF(IERR .NE. 0)THEN
  526. C
  527. C******* Message d'erreur standard
  528. C -301 0 %m1:40
  529. C
  530. MOTERR(1:40) = 'CHPO6 = ??? '
  531. CALL ERREUR(-301)
  532.  
  533. GOTO 9999
  534. ENDIF
  535. C
  536. C**** Lecture du CHPOINT IPC, PRESSURE
  537. C
  538. ICOND = 1
  539. CALL QUETYP(MTYPR,ICOND,IRETOU)
  540. IF(IERR .NE. 0)GOTO 9999
  541. IF(MTYPR .NE. 'CHPOINT ')THEN
  542. C
  543. C******* Message d'erreur standard
  544. C 37 2
  545. C On ne trouve pas d'objet de type %m1:8
  546. C
  547. MOTERR(1:8) = 'CHPOINT '
  548. CALL ERREUR(37)
  549. GOTO 9999
  550. ELSE
  551. ICOND = 1
  552. CALL LIROBJ(MTYPR,IPC,ICOND,IRETOU)
  553. IF (IERR.NE.0) GOTO 9999
  554. ENDIF
  555. C
  556. C**** Control du CHPOINT
  557. C
  558. INDIC = 1
  559. NBCOMP = 1
  560. NOMTOT(1) = 'SCAL'
  561. CALL QUEPOI(IPC, ICEN, INDIC, NBCOMP, NOMTOT)
  562. IF(IERR .NE. 0)THEN
  563. C
  564. C******* Message d'erreur standard
  565. C -301 0 %m1:40
  566. C
  567. MOTERR(1:40) = 'CHPO7 = ??? '
  568. CALL ERREUR(-301)
  569.  
  570. GOTO 9999
  571. ENDIF
  572. C
  573. C**** Lecture du CHPOINT IGRPC, pressure gradient
  574. C
  575. ICOND = 1
  576. CALL QUETYP(MTYPR,ICOND,IRETOU)
  577. IF(IERR .NE. 0)GOTO 9999
  578. IF(MTYPR .NE. 'CHPOINT ')THEN
  579. C
  580. C******* Message d'erreur standard
  581. C 37 2
  582. C On ne trouve pas d'objet de type %m1:8
  583. C
  584. MOTERR(1:8) = 'CHPOINT '
  585. CALL ERREUR(37)
  586. GOTO 9999
  587. ELSE
  588. ICOND = 1
  589. CALL LIROBJ(MTYPR,IGRPC,ICOND,IRETOU)
  590. IF (IERR.NE.0) GOTO 9999
  591. ENDIF
  592. C
  593. C**** Control du CHPOINT: QUEPOI
  594. C
  595. C
  596. INDIC = 1
  597. NBCOMP = IDIM
  598. NOMTOT(1) = 'P1DX'
  599. NOMTOT(2) = 'P1DY'
  600. IF( IDIM .EQ. 3) NOMTOT(3) = 'P1DZ'
  601. CALL QUEPOI(IGRPC, ICEN, INDIC, NBCOMP, NOMTOT)
  602. IF(IERR .NE. 0)THEN
  603. C
  604. C******* Message d'erreur standard
  605. C -301 0 %m1:40
  606. C
  607. MOTERR(1:40) = 'CHPO8 = ??? '
  608. CALL ERREUR(-301)
  609.  
  610. GOTO 9999
  611. ENDIF
  612. C
  613. C**** Lecture du CHPOINT IALPC, limited pressure gradient
  614. C
  615. ICOND = 1
  616. CALL QUETYP(MTYPR,ICOND,IRETOU)
  617. IF(IERR .NE. 0)GOTO 9999
  618. IF(MTYPR .NE. 'CHPOINT ')THEN
  619. C
  620. C******* Message d'erreur standard
  621. C 37 2
  622. C On ne trouve pas d'objet de type %m1:8
  623. C
  624. MOTERR(1:8) = 'CHPOINT '
  625. CALL ERREUR(37)
  626. GOTO 9999
  627. ELSE
  628. ICOND = 1
  629. CALL LIROBJ(MTYPR,IALPC,ICOND,IRETOU)
  630. IF (IERR.NE.0) GOTO 9999
  631. ENDIF
  632. C
  633. C**** Control du CHPOINT: QUEPOI
  634. C
  635. INDIC = 1
  636. NBCOMP = 1
  637. NOMTOT(1) = 'P1'
  638. CALL QUEPOI(IALPC, ICEN, INDIC, NBCOMP, NOMTOT)
  639. IF(IERR .NE. 0)THEN
  640. C
  641. C******* Message d'erreur standard
  642. C -301 0 %m1:40
  643. C
  644. MOTERR(1:40) = 'CHPO9 = ??? '
  645. CALL ERREUR(-301)
  646.  
  647. GOTO 9999
  648. ENDIF
  649. C
  650. C**** Lecture du CHPOINT ITVC, VAPOUR TEMPERATURE
  651. C
  652. ICOND = 1
  653. CALL QUETYP(MTYPR,ICOND,IRETOU)
  654. IF(IERR .NE. 0)GOTO 9999
  655. IF(MTYPR .NE. 'CHPOINT ')THEN
  656. C
  657. C******* Message d'erreur standard
  658. C 37 2
  659. C On ne trouve pas d'objet de type %m1:8
  660. C
  661. MOTERR(1:8) = 'CHPOINT '
  662. CALL ERREUR(37)
  663. GOTO 9999
  664. ELSE
  665. ICOND = 1
  666. CALL LIROBJ(MTYPR,ITVC,ICOND,IRETOU)
  667. IF (IERR.NE.0) GOTO 9999
  668. ENDIF
  669. C
  670. C**** Control du CHPOINT
  671. C
  672. INDIC = 1
  673. NBCOMP = 1
  674. NOMTOT(1) = 'SCAL'
  675. CALL QUEPOI(ITVC, ICEN, INDIC, NBCOMP, NOMTOT)
  676. IF(IERR .NE. 0)THEN
  677. C
  678. C******* Message d'erreur standard
  679. C -301 0 %m1:40
  680. C
  681. MOTERR(1:40) = 'CHPO10 = ??? '
  682. CALL ERREUR(-301)
  683.  
  684. GOTO 9999
  685. ENDIF
  686. C
  687. C**** Lecture du CHPOINT IGRTVC, vapour temprerature gradient
  688. C
  689. ICOND = 1
  690. CALL QUETYP(MTYPR,ICOND,IRETOU)
  691. IF(IERR .NE. 0)GOTO 9999
  692. IF(MTYPR .NE. 'CHPOINT ')THEN
  693. C
  694. C******* Message d'erreur standard
  695. C 37 2
  696. C On ne trouve pas d'objet de type %m1:8
  697. C
  698. MOTERR(1:8) = 'CHPOINT '
  699. CALL ERREUR(37)
  700. GOTO 9999
  701. ELSE
  702. ICOND = 1
  703. CALL LIROBJ(MTYPR,IGRTVC,ICOND,IRETOU)
  704. IF (IERR.NE.0) GOTO 9999
  705. ENDIF
  706. C
  707. C**** Control du CHPOINT: QUEPOI
  708. C
  709. C
  710. INDIC = 1
  711. NBCOMP = IDIM
  712. NOMTOT(1) = 'P1DX'
  713. NOMTOT(2) = 'P1DY'
  714. IF( IDIM .EQ. 3) NOMTOT(3) = 'P1DZ'
  715. CALL QUEPOI(IGRTVC, ICEN, INDIC, NBCOMP, NOMTOT)
  716. IF(IERR .NE. 0)THEN
  717. C
  718. C******* Message d'erreur standard
  719. C -301 0 %m1:40
  720. C
  721. MOTERR(1:40) = 'CHPO11 = ??? '
  722. CALL ERREUR(-301)
  723.  
  724. GOTO 9999
  725. ENDIF
  726. C
  727. C**** Lecture du CHPOINT IALTVC, limited vapour temperature gradient
  728. C
  729. ICOND = 1
  730. CALL QUETYP(MTYPR,ICOND,IRETOU)
  731. IF(IERR .NE. 0)GOTO 9999
  732. IF(MTYPR .NE. 'CHPOINT ')THEN
  733. C
  734. C******* Message d'erreur standard
  735. C 37 2
  736. C On ne trouve pas d'objet de type %m1:8
  737. C
  738. MOTERR(1:8) = 'CHPOINT '
  739. CALL ERREUR(37)
  740. GOTO 9999
  741. ELSE
  742. ICOND = 1
  743. CALL LIROBJ(MTYPR,IALTVC,ICOND,IRETOU)
  744. IF (IERR.NE.0) GOTO 9999
  745. ENDIF
  746. C
  747. C**** Control du CHPOINT: QUEPOI
  748. C
  749. INDIC = 1
  750. NBCOMP = 1
  751. NOMTOT(1) = 'P1'
  752. CALL QUEPOI(IALTVC, ICEN, INDIC, NBCOMP, NOMTOT)
  753. IF(IERR .NE. 0)THEN
  754. C
  755. C******* Message d'erreur standard
  756. C -301 0 %m1:40
  757. C
  758. MOTERR(1:40) = 'CHPO12 = ??? '
  759. CALL ERREUR(-301)
  760.  
  761. GOTO 9999
  762. ENDIF
  763. C
  764. C**** Lecture du CHPOINT ITLC, LIQUID TEMPERATURE
  765. C
  766. ICOND = 1
  767. CALL QUETYP(MTYPR,ICOND,IRETOU)
  768. IF(IERR .NE. 0)GOTO 9999
  769. IF(MTYPR .NE. 'CHPOINT ')THEN
  770. C
  771. C******* Message d'erreur standard
  772. C 37 2
  773. C On ne trouve pas d'objet de type %m1:8
  774. C
  775. MOTERR(1:8) = 'CHPOINT '
  776. CALL ERREUR(37)
  777. GOTO 9999
  778. ELSE
  779. ICOND = 1
  780. CALL LIROBJ(MTYPR,ITLC,ICOND,IRETOU)
  781. IF (IERR.NE.0) GOTO 9999
  782. ENDIF
  783. C
  784. C**** Control du CHPOINT
  785. C
  786. INDIC = 1
  787. NBCOMP = 1
  788. NOMTOT(1) = 'SCAL'
  789. CALL QUEPOI(ITLC, ICEN, INDIC, NBCOMP, NOMTOT)
  790. IF(IERR .NE. 0)THEN
  791. C
  792. C******* Message d'erreur standard
  793. C -301 0 %m1:40
  794. C
  795. MOTERR(1:40) = 'CHPO10 = ??? '
  796. CALL ERREUR(-301)
  797.  
  798. GOTO 9999
  799. ENDIF
  800. C
  801. C**** Lecture du CHPOINT IGRTLC, liquid temprerature gradient
  802. C
  803. ICOND = 1
  804. CALL QUETYP(MTYPR,ICOND,IRETOU)
  805. IF(IERR .NE. 0)GOTO 9999
  806. IF(MTYPR .NE. 'CHPOINT ')THEN
  807. C
  808. C******* Message d'erreur standard
  809. C 37 2
  810. C On ne trouve pas d'objet de type %m1:8
  811. C
  812. MOTERR(1:8) = 'CHPOINT '
  813. CALL ERREUR(37)
  814. GOTO 9999
  815. ELSE
  816. ICOND = 1
  817. CALL LIROBJ(MTYPR,IGRTLC,ICOND,IRETOU)
  818. IF (IERR.NE.0) GOTO 9999
  819. ENDIF
  820. C
  821. C**** Control du CHPOINT: QUEPOI
  822. C
  823. C
  824. INDIC = 1
  825. NBCOMP = IDIM
  826. NOMTOT(1) = 'P1DX'
  827. NOMTOT(2) = 'P1DY'
  828. IF( IDIM .EQ. 3) NOMTOT(3) = 'P1DZ'
  829. CALL QUEPOI(IGRTLC, ICEN, INDIC, NBCOMP, NOMTOT)
  830. IF(IERR .NE. 0)THEN
  831. C
  832. C******* Message d'erreur standard
  833. C -301 0 %m1:40
  834. C
  835. MOTERR(1:40) = 'CHPO13 = ??? '
  836. CALL ERREUR(-301)
  837.  
  838. GOTO 9999
  839. ENDIF
  840. C
  841. C**** Lecture du CHPOINT IALTLC, limited liquid temperature gradient
  842. C
  843. ICOND = 1
  844. CALL QUETYP(MTYPR,ICOND,IRETOU)
  845. IF(IERR .NE. 0)GOTO 9999
  846. IF(MTYPR .NE. 'CHPOINT ')THEN
  847. C
  848. C******* Message d'erreur standard
  849. C 37 2
  850. C On ne trouve pas d'objet de type %m1:8
  851. C
  852. MOTERR(1:8) = 'CHPOINT '
  853. CALL ERREUR(37)
  854. GOTO 9999
  855. ELSE
  856. ICOND = 1
  857. CALL LIROBJ(MTYPR,IALTLC,ICOND,IRETOU)
  858. IF (IERR.NE.0) GOTO 9999
  859. ENDIF
  860. C
  861. C**** Control du CHPOINT: QUEPOI
  862. C
  863. INDIC = 1
  864. NBCOMP = 1
  865. NOMTOT(1) = 'P1'
  866. CALL QUEPOI(IALTLC, ICEN, INDIC, NBCOMP, NOMTOT)
  867. IF(IERR .NE. 0)THEN
  868. C
  869. C******* Message d'erreur standard
  870. C -301 0 %m1:40
  871. C
  872. MOTERR(1:40) = 'CHPO14 = ??? '
  873. CALL ERREUR(-301)
  874.  
  875. GOTO 9999
  876. ENDIF
  877. C
  878. C**** Lecture du CHPOINT IRVC, VAPOUR DENSITY
  879. C
  880. ICOND = 1
  881. CALL QUETYP(MTYPR,ICOND,IRETOU)
  882. IF(IERR .NE. 0)GOTO 9999
  883. IF(MTYPR .NE. 'CHPOINT ')THEN
  884. C
  885. C******* Message d'erreur standard
  886. C 37 2
  887. C On ne trouve pas d'objet de type %m1:8
  888. C
  889. MOTERR(1:8) = 'CHPOINT '
  890. CALL ERREUR(37)
  891. GOTO 9999
  892. ELSE
  893. ICOND = 1
  894. CALL LIROBJ(MTYPR,IRVC,ICOND,IRETOU)
  895. IF (IERR.NE.0) GOTO 9999
  896. ENDIF
  897.  
  898. INDIC = 1
  899. NBCOMP = 1
  900. NOMTOT(1) = 'SCAL'
  901. CALL QUEPOI(IRVC, ICEN, INDIC, NBCOMP, NOMTOT)
  902. IF(IERR .NE. 0)THEN
  903. C
  904. C******* Message d'erreur standard
  905. C -301 0 %m1:40
  906. C
  907. MOTERR(1:40) = 'CHPO15 = ??? '
  908. CALL ERREUR(-301)
  909.  
  910. GOTO 9999
  911. ENDIF
  912. C
  913. C**** Lecture du CHPOINT IRLC, LIQUID DENSITY
  914. C
  915. ICOND = 1
  916. CALL QUETYP(MTYPR,ICOND,IRETOU)
  917. IF(IERR .NE. 0)GOTO 9999
  918. IF(MTYPR .NE. 'CHPOINT ')THEN
  919. C
  920. C******* Message d'erreur standard
  921. C 37 2
  922. C On ne trouve pas d'objet de type %m1:8
  923. C
  924. MOTERR(1:8) = 'CHPOINT '
  925. CALL ERREUR(37)
  926. GOTO 9999
  927. ELSE
  928. ICOND = 1
  929. CALL LIROBJ(MTYPR,IRLC,ICOND,IRETOU)
  930. IF (IERR.NE.0) GOTO 9999
  931. ENDIF
  932.  
  933. INDIC = 1
  934. NBCOMP = 1
  935. NOMTOT(1) = 'SCAL'
  936. CALL QUEPOI(IRLC, ICEN, INDIC, NBCOMP, NOMTOT)
  937. IF(IERR .NE. 0)THEN
  938. C
  939. C******* Message d'erreur standard
  940. C -301 0 %m1:40
  941. C
  942. MOTERR(1:40) = 'CHPO16 = ??? '
  943. CALL ERREUR(-301)
  944.  
  945. GOTO 9999
  946. ENDIF
  947. IF(ORDTEM .EQ. 1)THEN
  948. C
  949. C******* Deux Dimensions, Une Espece, 2er ordre en espace, 1er ordre en
  950. C temps
  951. C
  952. LOGTEM = .FALSE.
  953. DELTAT = 0.0D0
  954. ELSE
  955. LOGTEM = .TRUE.
  956. ICOND = 1
  957. CALL LIRREE(DELTAT,ICOND,IRETOU)
  958. IF(IERR .NE. 0)GOTO 9999
  959. ENDIF
  960. IF(IDIM .EQ. 2)THEN
  961. C
  962. C******* Deux Dimensions, Une Espece, 1er ordre en espace, 1er ordre en
  963. C temps
  964. C
  965. CALL PRE52F(LOGTEM,
  966. & ICEN,IFACE,IFACEL,INORM,
  967. & IALPH, IGRALP, IALALP,
  968. & IUVC, IGRUVC, IALUVC,
  969. & IULC, IGRULC, IALULC,
  970. & IPC, IGRPC, IALPC,
  971. & ITVC, IGRTVC, IALTVC,
  972. & ITLC, IGRTLC, IALTLC,
  973. & IRVC, IRLC,
  974. & DELTAT,
  975. & IALPHF, IUVF, IULF, IPF, ITVF, ITLF,
  976. & IRVF, IRLF,
  977. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  978. ELSE
  979. C
  980. C******* Trois Dimensions, Une Espece, 1er ordre en espace, 1er ordre en
  981. C temps
  982. C
  983. CALL PRE62F(LOGTEM,
  984. & ICEN,IFACE,IFACEL,INORM,
  985. & IALPH, IGRALP, IALALP,
  986. & IUVC, IGRUVC, IALUVC,
  987. & IULC, IGRULC, IALULC,
  988. & IPC, IGRPC, IALPC,
  989. & ITVC, IGRTVC, IALTVC,
  990. & ITLC, IGRTLC, IALTLC,
  991. & IRVC, IRLC,
  992. & DELTAT,
  993. & IALPHF, IUVF, IULF, IPF, ITVF, ITLF,
  994. & IRVF, IRLF,
  995. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  996. ENDIF
  997. C
  998. C
  999. C**** Messages d'erreur
  1000. C
  1001. IF(LOGAN)THEN
  1002. C
  1003. C******* Anomalie detectée
  1004. C
  1005. C
  1006. C******* Message d'erreur standard
  1007. C -301 0
  1008. C %m1:40
  1009. C
  1010. MOTERR(1:40) = MESERR(1:40)
  1011. CALL ERREUR(-301)
  1012. C
  1013. C******* Message d'erreur standard
  1014. C 5 3
  1015. C Erreur anormale.contactez votre support
  1016. C
  1017. CALL ERREUR(5)
  1018. GOTO 9999
  1019. C
  1020. ELSEIF(LOGNEG)THEN
  1021. C
  1022. C******* Message d'erreur standard
  1023. C 41 2
  1024. C %m1:8 = %r1 inférieur à %r2
  1025. C
  1026. MOTERR(1:8) = MESERR(1:8)
  1027. REAERR(1) = REAL(VALER)
  1028. REAERR(2) = 0.0
  1029. CALL ERREUR(41)
  1030. GOTO 9999
  1031. ELSEIF(LOGBOR)THEN
  1032. C
  1033. C******* Message d'erreur standard
  1034. C 42 2
  1035. C %m1:8 = %r1 non compris entre %r2 et %r3
  1036. C
  1037. MOTERR(1:8) = MESERR(1:8)
  1038. REAERR(1) = REAL(VALER)
  1039. REAERR(2) = REAL(VAL1)
  1040. REAERR(3) = REAL(VAL2)
  1041. CALL ERREUR(42)
  1042. GOTO 9999
  1043. ELSE
  1044. C
  1045. C******* Ecriture de IALPHF, IUVF, IULF, IPF,
  1046. C ITVF, ITLF, IRVF, IRLF
  1047. MTYPR = 'MCHAML'
  1048. CALL ECROBJ(MTYPR, IALPHF)
  1049. CALL ECROBJ(MTYPR, IUVF)
  1050. CALL ECROBJ(MTYPR, IULF)
  1051. CALL ECROBJ(MTYPR, IPF)
  1052. CALL ECROBJ(MTYPR, ITVF)
  1053. CALL ECROBJ(MTYPR, ITLF)
  1054. CALL ECROBJ(MTYPR, IRVF)
  1055. CALL ECROBJ(MTYPR, IRLF)
  1056. ENDIF
  1057. C
  1058. 9999 CONTINUE
  1059. C
  1060. RETURN
  1061. END
  1062.  
  1063.  
  1064.  
  1065.  
  1066.  
  1067.  
  1068.  
  1069.  

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