Télécharger pre12f.eso

Retour à la liste

Numérotation des lignes :

  1. C PRE12F SOURCE CB215821 19/07/31 21:16:18 10277
  2. SUBROUTINE PRE12F()
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PRE12F
  8. C
  9. C DESCRIPTION : Voir PRE2F
  10. C
  11. C 1st order in space and time
  12. C
  13. C Creation of the objects MCHAML IALPHF, IUVF, IULF,
  14. C IPF, ITVF, ITLF, IRVF, IRLF
  15. C
  16. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  17. C
  18. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  19. C Modified for two-fluid flow by
  20. C Jose R. Garcia Cascales
  21. C
  22. C************************************************************************
  23. C
  24. C
  25. C APPELES (Outils) : LIRTAB, ACMO, LEKTAB, QUETYP, ERREUR, LIROBJ,
  26. C QUEPOI, ECROBJ
  27. C
  28. C APPELES (Calcul) : PRE22F (2D), PRE32F (3D)
  29. C
  30. C
  31. C************************************************************************
  32. C
  33. C HISTORIQUE (Anomalies et modifications éventuelles)
  34. C
  35. C HISTORIQUE : Créée le 21/02/2002.
  36. C
  37. C************************************************************************
  38. C
  39. IMPLICIT INTEGER(I-N)
  40. IMPLICIT REAL*8(A-H,O-Z)
  41.  
  42. C
  43. C**** Les variables
  44. C
  45. INTEGER ICOND, IRETOU, IERR0, INDIC, NBCOMP,
  46. & IDOMA, ICEN, IFACE, IFACEL, INORM,
  47. & IALPH, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC,
  48. & IALPHF, IUVF, IULF, IPF, ITVF, ITLF, IRVF, IRLF
  49. REAL*8 VALER, VAL1, VAL2
  50. CHARACTER*(4) NOMTOT(3)
  51. CHARACTER*(8) MTYPR
  52. CHARACTER*(40) MESERR
  53. LOGICAL LOGAN,LOGNEG, LOGBOR
  54. C
  55. C**** Les Includes
  56. C
  57.  
  58. -INC PPARAM
  59. -INC CCOPTIO
  60. C
  61. C**** Initialisation des parametres d'erreur
  62. C
  63. LOGAN = .FALSE.
  64. LOGNEG = .FALSE.
  65. LOGBOR = .FALSE.
  66. MESERR = ' '
  67. MOTERR(1:40) = MESERR(1:40)
  68. VALER = 0.0D0
  69. VAL1 = 0.0D0
  70. VAL2 = 0.0D0
  71. C
  72. C**** Initialisation des NOMTOT
  73. C
  74. NOMTOT(1) = ' '
  75. NOMTOT(2) = ' '
  76. NOMTOT(3) = ' '
  77. C
  78. C**** Lecture de la TABLE domaine (IDOMA)
  79. C
  80. ICOND = 1
  81. CALL LIRTAB('DOMAINE',IDOMA,ICOND,IRETOU)
  82. IF (IERR .NE. 0) GOTO 9999
  83. C
  84. C**** Lecture du MELEME SPG des points CENTRE.
  85. C
  86. C
  87. C CALL LEKTAB(IDOMA,'CENTRE',IP)
  88. C
  89. C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
  90. C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
  91. C -> la correspondance global des noeuds saut!
  92. C
  93. C On peut utilizer ACCTAB ou ACMO
  94. C
  95. MTYPR = 'MAILLAGE'
  96. CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN)
  97. IF(IERR.NE.0)GOTO 9999
  98. C
  99. C**** Lecture du MELEME 'FACE'
  100. C
  101. MTYPR = 'MAILLAGE'
  102. CALL ACMO(IDOMA,'FACE',MTYPR,IFACE)
  103. IF(IERR.NE.0)GOTO 9999
  104. C
  105. C**** Lecture du MELEME 'FACEL'
  106. C
  107. MTYPR = 'MAILLAGE'
  108. CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL)
  109. IF(IERR.NE.0)GOTO 9999
  110. C
  111. C**** Lecture du CHPOINT contenant les normales aux faces
  112. C
  113. IF(IDIM .EQ. 2)THEN
  114. C Que les normales
  115. CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
  116. IF(IERR .NE. 0) GOTO 9999
  117. ELSE
  118. C Les normales et les tangentes
  119. MTYPR = ' '
  120. CALL ACMO(IDOMA,'MATROT',MTYPR,INORM)
  121. IF (MTYPR .NE. 'CHPOINT ') THEN
  122. CALL MATRAN(IDOMA,INORM)
  123. IF(IERR .NE. 0) GOTO 9999
  124. ENDIF
  125.  
  126. C
  127. ENDIF
  128. C
  129. C
  130. C**** Lecture du CHPOINT IALPH, VOID FRACTION
  131. C
  132. ICOND = 1
  133. CALL QUETYP(MTYPR,ICOND,IRETOU)
  134. IF(IERR .NE. 0)GOTO 9999
  135. IF(MTYPR .NE. 'CHPOINT ')THEN
  136. C
  137. C******* Message d'erreur standard
  138. C 37 2
  139. C On ne trouve pas d'objet de type %m1:8
  140. C
  141. MOTERR(1:8) = 'CHPOINT '
  142. CALL ERREUR(37)
  143. GOTO 9999
  144. ELSE
  145. ICOND = 1
  146. CALL LIROBJ(MTYPR,IALPH,ICOND,IRETOU)
  147. CALL ACTOBJ(MTYPR,IALPH,1)
  148. IF (IERR.NE.0) GOTO 9999
  149. ENDIF
  150. C
  151. C**** Control du CHPOINT: QUEPOI
  152. C
  153. C INDIC = 1 -> on impose le pointeur du support geometrique (IM1)
  154. C INDIC = 0 -> on ne fait que verifier le support geometrique (IM1)
  155. C
  156. C NBCOMP > 0 -> numero des composantes
  157. C
  158. C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
  159. C
  160. INDIC = 1
  161. NBCOMP = 1
  162. NOMTOT(1) = 'SCAL'
  163. CALL QUEPOI(IALPH, ICEN, INDIC, NBCOMP, NOMTOT)
  164. IF(IERR .NE. 0)THEN
  165. IERR0 = IERR
  166.  
  167. C
  168. C******* Message d'erreur standard
  169. C -301 0 %m1:40
  170. C
  171. MOTERR(1:40) = 'CHPO1 = ??? '
  172. CALL ERREUR(-301)
  173.  
  174. GOTO 9999
  175. ENDIF
  176. C
  177. C**** Lecture du CHPOINT IUVC, VAPOUR VELOCITY
  178. C
  179. ICOND = 1
  180. CALL QUETYP(MTYPR,ICOND,IRETOU)
  181. IF(IERR .NE. 0)GOTO 9999
  182. IF(MTYPR .NE. 'CHPOINT ')THEN
  183. C
  184. C******* Message d'erreur standard
  185. C 37 2
  186. C On ne trouve pas d'objet de type %m1:8
  187. C
  188. MOTERR(1:8) = 'CHPOINT '
  189. CALL ERREUR(37)
  190. GOTO 9999
  191. ELSE
  192. ICOND = 1
  193. CALL LIROBJ('CHPOINT ',IUVC,ICOND,IRETOU)
  194. CALL ACTOBJ('CHPOINT ',IUVC,1)
  195. IF (IERR.NE.0) GOTO 9999
  196. ENDIF
  197. C
  198. C**** Control du CHPOINT
  199. C
  200. INDIC = 1
  201. NBCOMP = IDIM
  202. NOMTOT(1) = 'UVX'
  203. NOMTOT(2) = 'UVY'
  204. IF(IDIM .EQ. 3) NOMTOT(3) = 'UVZ'
  205. CALL QUEPOI(IUVC, ICEN, INDIC, NBCOMP, NOMTOT)
  206. IF(IERR .NE. 0)THEN
  207. IERR0 = IERR
  208.  
  209. C
  210. C******* Message d'erreur standard
  211. C -301 0 %m1:40
  212. C
  213. MOTERR(1:40) = 'CHPO2 = ??? '
  214. CALL ERREUR(-301)
  215.  
  216. GOTO 9999
  217. ENDIF
  218. C
  219. C**** Lecture du CHPOINT IULC, LIQUID VELOCITY
  220. C
  221. ICOND = 1
  222. CALL QUETYP(MTYPR,ICOND,IRETOU)
  223. IF(IERR .NE. 0)GOTO 9999
  224. IF(MTYPR .NE. 'CHPOINT ')THEN
  225. C
  226. C******* Message d'erreur standard
  227. C 37 2
  228. C On ne trouve pas d'objet de type %m1:8
  229. C
  230. MOTERR(1:8) = 'CHPOINT '
  231. CALL ERREUR(37)
  232. GOTO 9999
  233. ELSE
  234. ICOND = 1
  235. CALL LIROBJ('CHPOINT ',IULC,ICOND,IRETOU)
  236. CALL ACTOBJ('CHPOINT ',IULC,1)
  237. IF (IERR.NE.0) GOTO 9999
  238. ENDIF
  239. C
  240. C**** Control du CHPOINT
  241. C
  242. INDIC = 1
  243. NBCOMP = IDIM
  244. NOMTOT(1) = 'ULX'
  245. NOMTOT(2) = 'ULY'
  246. IF(IDIM .EQ. 3) NOMTOT(3) = 'ULZ'
  247. CALL QUEPOI(IULC, ICEN, INDIC, NBCOMP, NOMTOT)
  248. IF(IERR .NE. 0)THEN
  249. IERR0 = IERR
  250.  
  251. C
  252. C******* Message d'erreur standard
  253. C -301 0 %m1:40
  254. C
  255. MOTERR(1:40) = 'CHPO3 = ??? '
  256. CALL ERREUR(-301)
  257.  
  258. GOTO 9999
  259. ENDIF
  260. C
  261. C**** Lecture du CHPOINT IPC, PRESSURE
  262. C
  263. ICOND = 1
  264. CALL QUETYP(MTYPR,ICOND,IRETOU)
  265. IF(IERR .NE. 0)GOTO 9999
  266. IF(MTYPR .NE. 'CHPOINT ')THEN
  267. C
  268. C******* Message d'erreur standard
  269. C 37 2
  270. C On ne trouve pas d'objet de type %m1:8
  271. C
  272. MOTERR(1:8) = 'CHPOINT '
  273. CALL ERREUR(37)
  274. GOTO 9999
  275. ELSE
  276. ICOND = 1
  277. CALL LIROBJ('CHPOINT',IPC,ICOND,IRETOU)
  278. CALL ACTOBJ('CHPOINT',IPC,1)
  279. IF (IERR.NE.0) GOTO 9999
  280. ENDIF
  281. C
  282. C**** Control du CHPOINT
  283. C
  284. INDIC = 1
  285. NBCOMP = 1
  286. NOMTOT(1) = 'SCAL'
  287. CALL QUEPOI(IPC, ICEN, INDIC, NBCOMP, NOMTOT)
  288. IF(IERR .NE. 0)THEN
  289. IERR0 = IERR
  290.  
  291. C
  292. C******* Message d'erreur standard
  293. C -301 0 %m1:40
  294. C
  295. MOTERR(1:40) = 'CHPO4 = ??? '
  296. CALL ERREUR(-301)
  297.  
  298. GOTO 9999
  299. ENDIF
  300. C
  301. C**** Lecture du CHPOINT ITVC, VAPOUR TEMPERATURE
  302. C
  303. ICOND = 1
  304. CALL QUETYP(MTYPR,ICOND,IRETOU)
  305. IF(IERR .NE. 0)GOTO 9999
  306. IF(MTYPR .NE. 'CHPOINT ')THEN
  307. C
  308. C******* Message d'erreur standard
  309. C 37 2
  310. C On ne trouve pas d'objet de type %m1:8
  311. C
  312. MOTERR(1:8) = 'CHPOINT '
  313. CALL ERREUR(37)
  314. GOTO 9999
  315. ELSE
  316. ICOND = 1
  317. CALL LIROBJ('CHPOINT ',ITVC,ICOND,IRETOU)
  318. CALL ACTOBJ('CHPOINT ',ITVC,1)
  319. IF (IERR.NE.0) GOTO 9999
  320. ENDIF
  321. C
  322. C**** Control du CHPOINT
  323. C
  324. INDIC = 1
  325. NBCOMP = 1
  326. NOMTOT(1) = 'SCAL'
  327. CALL QUEPOI(ITVC, ICEN, INDIC, NBCOMP, NOMTOT)
  328. IF(IERR .NE. 0)THEN
  329. IERR0 = IERR
  330.  
  331. C
  332. C******* Message d'erreur standard
  333. C -301 0 %m1:40
  334. C
  335. MOTERR(1:40) = 'CHPO5 = ??? '
  336. CALL ERREUR(-301)
  337.  
  338. GOTO 9999
  339. ENDIF
  340. C
  341. C**** Lecture du CHPOINT ITLC, LIQUID TEMPERATURE
  342. C
  343. ICOND = 1
  344. CALL QUETYP(MTYPR,ICOND,IRETOU)
  345. IF(IERR .NE. 0)GOTO 9999
  346. IF(MTYPR .NE. 'CHPOINT ')THEN
  347. C
  348. C******* Message d'erreur standard
  349. C 37 2
  350. C On ne trouve pas d'objet de type %m1:8
  351. C
  352. MOTERR(1:8) = 'CHPOINT '
  353. CALL ERREUR(37)
  354. GOTO 9999
  355. ELSE
  356. ICOND = 1
  357. CALL LIROBJ('CHPOINT ',ITLC,ICOND,IRETOU)
  358. CALL ACTOBJ('CHPOINT ',ITLC,1)
  359. IF (IERR.NE.0) GOTO 9999
  360. ENDIF
  361. C
  362. C**** Control du CHPOINT
  363. C
  364. INDIC = 1
  365. NBCOMP = 1
  366. NOMTOT(1) = 'SCAL'
  367. CALL QUEPOI(ITLC, ICEN, INDIC, NBCOMP, NOMTOT)
  368. IF(IERR .NE. 0)THEN
  369. IERR0 = IERR
  370.  
  371. C
  372. C******* Message d'erreur standard
  373. C -301 0 %m1:40
  374. C
  375. MOTERR(1:40) = 'CHPO6 = ??? '
  376. CALL ERREUR(-301)
  377.  
  378. GOTO 9999
  379. ENDIF
  380. C
  381. C**** Lecture du CHPOINT IRVC, VAPOUR DENSITY
  382. C
  383. ICOND = 1
  384. CALL QUETYP(MTYPR,ICOND,IRETOU)
  385. IF(IERR .NE. 0)GOTO 9999
  386. IF(MTYPR .NE. 'CHPOINT ')THEN
  387. C
  388. C******* Message d'erreur standard
  389. C 37 2
  390. C On ne trouve pas d'objet de type %m1:8
  391. C
  392. MOTERR(1:8) = 'CHPOINT '
  393. CALL ERREUR(37)
  394. GOTO 9999
  395. ELSE
  396. ICOND = 1
  397. CALL LIROBJ(MTYPR,IRVC,ICOND,IRETOU)
  398. CALL ACTOBJ(MTYPR,IRVC,1)
  399. IF (IERR.NE.0) GOTO 9999
  400. ENDIF
  401.  
  402. INDIC = 1
  403. NBCOMP = 1
  404. NOMTOT(1) = 'SCAL'
  405. CALL QUEPOI(IRVC, ICEN, INDIC, NBCOMP, NOMTOT)
  406. IF(IERR .NE. 0)THEN
  407. IERR0 = IERR
  408.  
  409. C
  410. C******* Message d'erreur standard
  411. C -301 0 %m1:40
  412. C
  413. MOTERR(1:40) = 'CHPO7 = ??? '
  414. CALL ERREUR(-301)
  415.  
  416. GOTO 9999
  417. ENDIF
  418. C
  419. C**** Lecture du CHPOINT IRLC, LIQUID DENSITY
  420. C
  421. ICOND = 1
  422. CALL QUETYP(MTYPR,ICOND,IRETOU)
  423. IF(IERR .NE. 0)GOTO 9999
  424. IF(MTYPR .NE. 'CHPOINT ')THEN
  425. C
  426. C******* Message d'erreur standard
  427. C 37 2
  428. C On ne trouve pas d'objet de type %m1:8
  429. C
  430. MOTERR(1:8) = 'CHPOINT '
  431. CALL ERREUR(37)
  432. GOTO 9999
  433. ELSE
  434. ICOND = 1
  435. CALL LIROBJ(MTYPR,IRLC,ICOND,IRETOU)
  436. CALL ACTOBJ(MTYPR,IRLC,1)
  437. IF (IERR.NE.0) GOTO 9999
  438. ENDIF
  439.  
  440. INDIC = 1
  441. NBCOMP = 1
  442. NOMTOT(1) = 'SCAL'
  443. CALL QUEPOI(IRLC, ICEN, INDIC, NBCOMP, NOMTOT)
  444. IF(IERR .NE. 0)THEN
  445. IERR0 = IERR
  446.  
  447. C
  448. C******* Message d'erreur standard
  449. C -301 0 %m1:40
  450. C
  451. MOTERR(1:40) = 'CHPO8 = ??? '
  452. CALL ERREUR(-301)
  453. IERR = IERR0
  454. GOTO 9999
  455. ENDIF
  456. C
  457. C**** Centre -> Face
  458. C
  459. IF(IDIM .EQ. 2)THEN
  460. C
  461. C******* Two Dimensions, 1st order in time and space
  462. C
  463. CALL PRE22F(ICEN,IFACE,IFACEL,INORM,
  464. & IALPH, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC,
  465. & IALPHF, IUVF, IULF, IPF, ITVF, ITLF,
  466. & IRVF, IRLF,
  467. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  468. ELSE
  469. C
  470. C******* Three dimensions, 1st order in time and space
  471. C
  472. CALL PRE32F(ICEN,IFACE,IFACEL,INORM,
  473. & IALPH, IUVC, IULC, IPC, ITVC, ITLC, IRVC, IRLC,
  474. & IALPHF, IUVF, IULF, IPF, ITVF, ITLF,
  475. & IRVF, IRLF,
  476. & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2)
  477.  
  478. ENDIF
  479. C
  480. C**** Messages d'erreur
  481. C
  482. IF(LOGAN)THEN
  483. C
  484. C******* Anomalie detectée
  485. C
  486. C
  487. C******* Message d'erreur standard
  488. C -301 0
  489. C %m1:40
  490. C
  491. MOTERR(1:40) = MESERR(1:40)
  492. CALL ERREUR(-301)
  493. C
  494. C******* Message d'erreur standard
  495. C 5 3
  496. C Erreur anormale.contactez votre support
  497. C
  498. CALL ERREUR(5)
  499. GOTO 9999
  500. C
  501. ELSEIF(LOGNEG)THEN
  502. C
  503. C******* Message d'erreur standard
  504. C 41 2
  505. C %m1:8 = %r1 inférieur à %r2
  506. C
  507. MOTERR(1:8) = MESERR(1:8)
  508. REAERR(1) = REAL(VALER)
  509. REAERR(2) = 0.0
  510. CALL ERREUR(41)
  511. GOTO 9999
  512. ELSEIF(LOGBOR)THEN
  513. C
  514. C******* Message d'erreur standard
  515. C 42 2
  516. C %m1:8 = %r1 non compris entre %r2 et %r3
  517. C
  518. MOTERR(1:8) = MESERR(1:8)
  519. REAERR(1) = REAL(VALER)
  520. REAERR(2) = REAL(VAL1)
  521. REAERR(3) = REAL(VAL2)
  522. CALL ERREUR(42)
  523. GOTO 9999
  524. ELSE
  525. C
  526. C******* Ecriture de ROF, VITF, PF
  527. C
  528. MTYPR = 'MCHAML '
  529. CALL ACTOBJ(MTYPR, IALPHF,1)
  530. CALL ACTOBJ(MTYPR, IUVF,1)
  531. CALL ACTOBJ(MTYPR, IULF,1)
  532. CALL ACTOBJ(MTYPR, IPF,1)
  533. CALL ACTOBJ(MTYPR, ITVF,1)
  534. CALL ACTOBJ(MTYPR, ITLF,1)
  535. CALL ACTOBJ(MTYPR, IRVF,1)
  536. CALL ACTOBJ(MTYPR, IRLF,1)
  537.  
  538. CALL ECROBJ(MTYPR, IALPHF)
  539. CALL ECROBJ(MTYPR, IUVF)
  540. CALL ECROBJ(MTYPR, IULF)
  541. CALL ECROBJ(MTYPR, IPF)
  542. CALL ECROBJ(MTYPR, ITVF)
  543. CALL ECROBJ(MTYPR, ITLF)
  544. CALL ECROBJ(MTYPR, IRVF)
  545. CALL ECROBJ(MTYPR, IRLF)
  546. ENDIF
  547. C
  548. 9999 CONTINUE
  549. END
  550.  
  551.  
  552.  

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