Télécharger pre12f.eso

Retour à la liste

Numérotation des lignes :

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

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