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

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