Télécharger prim2f.eso

Retour à la liste

Numérotation des lignes :

  1. C PRIM2F SOURCE CB215821 19/07/31 21:16:36 10277
  2. SUBROUTINE PRIM2F()
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PRIM
  8. C
  9. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  10. C
  11. C AUTEUR : Jose R. Garcia-Cascales,
  12. C Universidad Politecnica de Cartagena,
  13. C jr.garcia@upct.es
  14. C
  15. C************************************************************************
  16. C
  17. C
  18. C APPELES (E/S) :
  19. C
  20. C APPELES (Calcul) :
  21. C
  22. C************************************************************************
  23. C
  24. C PHRASE D'APPEL (GIBIANE) :
  25. C
  26. IMPLICIT INTEGER(I-N)
  27. IMPLICIT REAL*8(A-H,O-Z)
  28.  
  29. C
  30. C**** Les variables
  31. C
  32. INTEGER ICOND, IRETOU, INDIC, NBCOMP,
  33. & ICEN, ICH1, ICH2, ICH3,
  34. & ICH4, ICH5, ICH6, ICH7,
  35. & ICH8, ICH9,
  36. & OCH1, OCH2, OCH3,
  37. & OCH4, OCH5, OCH6,
  38. & OCH7, OCH8, OCH9,
  39. & JGN, JGM
  40. REAL*8 VALER(2),VAL1,VAL2, Cp, Cvm
  41. CHARACTER*(40) MESERR(2),MESCEL
  42. CHARACTER*(6) NOMTRI
  43. LOGICAL LOGNEG, LOGBOR, LOGTRI
  44. C
  45. C**** Les Includes
  46. C
  47.  
  48. -INC PPARAM
  49. -INC CCOPTIO
  50. -INC SMCHPOI
  51. -INC SMLMOTS
  52. C
  53. C**** Initialisation des parametres d'erreur
  54. C
  55. LOGNEG = .FALSE.
  56. LOGBOR = .FALSE.
  57. LOGTRI = .FALSE.
  58. MESCEL = ' '
  59. MESERR(1) = MESCEL
  60. MESERR(2) = MESCEL
  61. MOTERR(1:40) = MESCEL
  62. VALER(1) = 0.0D0
  63. VALER(2) = 0.0D0
  64. VAL1 = 0.0D0
  65. VAL2 = 0.0D0
  66. C
  67. C**** Lecture du CHPOINT ICH1
  68. C
  69. ICOND = 1
  70. CALL LIROBJ('CHPOINT ',ICH1,ICOND,IRETOU)
  71. CALL ACTOBJ('CHPOINT ',ICH1,1)
  72. IF (IERR.NE.0) GOTO 9999
  73. C
  74. C**** On cherche le pointeur de son maillage et on l'impose sur les
  75. C autres CHPOINT
  76. C
  77. MCHPOI = ICH1
  78. SEGACT MCHPOI
  79. MSOUPO = MCHPOI.IPCHP(1)
  80. SEGACT MSOUPO
  81. ICEN = MSOUPO.IGEOC
  82. SEGDES MSOUPO
  83. SEGDES MCHPOI
  84. C
  85. C**** On recupere en QUEPO1 MLMOTS
  86. C
  87. JGN = 4
  88. JGM = 1
  89. SEGINI MLMOTS
  90. MLMOTS.MOTS(1) = 'SCAL'
  91. CALL QUEPO1(ICH1, ICEN, MLMOTS)
  92. C
  93. IF(IERR .NE. 0)THEN
  94. C
  95. C******** Message d'erreur standard
  96. C -301 0 %m1:40
  97. C
  98. MOTERR = 'CHPO1 = ??? '
  99. WRITE(IOIMP,*) MOTERR(1:40)
  100.  
  101. GOTO 9999
  102. ENDIF
  103. SEGSUP MLMOTS
  104. C
  105. C**** Lecture du CHPOINT ICH2
  106. C
  107. ICOND = 1
  108. CALL LIROBJ('CHPOINT ',ICH2,ICOND,IRETOU)
  109. CALL ACTOBJ('CHPOINT ',ICH2,1)
  110. IF (IERR.NE.0) GOTO 9999
  111. C
  112. C**** Control du CHPOINT ICH2
  113. C
  114. JGN = 4
  115. JGM = 1
  116. SEGINI MLMOTS
  117. MLMOTS.MOTS(1) = 'SCAL'
  118. CALL QUEPO1(ICH2, ICEN, MLMOTS)
  119. IF(IERR .NE. 0)THEN
  120. C
  121. C******** Message d'erreur standard
  122. C -301 0 %m1:40
  123. C
  124. MOTERR = 'CHPO2 = ??? '
  125. WRITE(IOIMP,*) MOTERR(1:40)
  126.  
  127. GOTO 9999
  128. ENDIF
  129. SEGSUP MLMOTS
  130. C
  131. C**** Lecture du CHPOINT ICH3
  132. C
  133. ICOND = 1
  134. CALL LIROBJ('CHPOINT',ICH3,ICOND,IRETOU)
  135. CALL ACTOBJ('CHPOINT',ICH3,1)
  136. IF (IERR.NE.0) GOTO 9999
  137. C
  138. C**** Control du CHPOINT ICH3
  139. C
  140. JGN = 4
  141. JGM = IDIM
  142. SEGINI MLMOTS
  143. MLMOTS.MOTS(1) = 'UVX'
  144. MLMOTS.MOTS(2) = 'UVY'
  145. IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UVZ'
  146. CALL QUEPO1(ICH3, ICEN, MLMOTS)
  147. IF(IERR .NE. 0)THEN
  148. C
  149. C******** Message d'erreur standard
  150. C -301 0 %m1:40
  151. C
  152. MOTERR = 'CHPO3 = ??? '
  153.  
  154. GOTO 9999
  155. ENDIF
  156. SEGSUP MLMOTS
  157. C
  158. C**** Lecture du CHPOINT ICH4
  159. C
  160. ICOND = 1
  161. CALL LIROBJ('CHPOINT',ICH4,ICOND,IRETOU)
  162. CALL ACTOBJ('CHPOINT',ICH4,1)
  163. IF (IERR.NE.0) GOTO 9999
  164. C
  165. C**** Control du CHPOINT ICH4
  166. C
  167. JGN = 4
  168. JGM = IDIM
  169. SEGINI MLMOTS
  170. MLMOTS.MOTS(1) = 'ULX'
  171. MLMOTS.MOTS(2) = 'ULY'
  172. IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'ULZ'
  173. CALL QUEPO1(ICH4, ICEN, MLMOTS)
  174. IF(IERR .NE. 0)THEN
  175. C
  176. C******** Message d'erreur standard
  177. C -301 0 %m1:40
  178. C
  179. MOTERR = 'CHPO4 = ??? '
  180. WRITE(IOIMP,*) MOTERR(1:40)
  181.  
  182. GOTO 9999
  183. ENDIF
  184. SEGSUP MLMOTS
  185. C
  186. C**** Lecture du CHPOINT ICH5
  187. C
  188. ICOND = 1
  189. CALL LIROBJ('CHPOINT',ICH5,ICOND,IRETOU)
  190. CALL ACTOBJ('CHPOINT',ICH5,1)
  191. IF (IERR.NE.0) GOTO 9999
  192. C
  193. C**** Control du CHPOINT ICH5
  194. C
  195. JGN = 4
  196. JGM = 1
  197. SEGINI MLMOTS
  198. MLMOTS.MOTS(1) = 'SCAL'
  199. CALL QUEPO1(ICH5, ICEN, MLMOTS)
  200. IF(IERR .NE. 0)THEN
  201. C
  202. C******** Message d'erreur standard
  203. C -301 0 %m1:40
  204. C
  205. MOTERR = 'CHPO5 = ??? '
  206. WRITE(IOIMP,*) MOTERR(1:40)
  207.  
  208. GOTO 9999
  209. ENDIF
  210. SEGSUP MLMOTS
  211. C
  212. C**** Lecture du CHPOINT ICH6
  213. C
  214. ICOND = 1
  215. CALL LIROBJ('CHPOINT',ICH6,ICOND,IRETOU)
  216. CALL ACTOBJ('CHPOINT',ICH6,1)
  217. IF (IERR.NE.0) GOTO 9999
  218. C
  219. C**** Control du CHPOINT ICH6
  220. C
  221. JGN = 4
  222. JGM = 1
  223. SEGINI MLMOTS
  224. MLMOTS.MOTS(1) = 'SCAL'
  225. CALL QUEPO1(ICH6, ICEN, MLMOTS)
  226. IF(IERR .NE. 0)THEN
  227. C
  228. C******** Message d'erreur standard
  229. C -301 0 %m1:40
  230. C
  231. MOTERR = 'CHPO6 = ??? '
  232. WRITE(IOIMP,*) MOTERR(1:40)
  233.  
  234. GOTO 9999
  235. ENDIF
  236. SEGSUP MLMOTS
  237. C
  238. C**** Lecture du CHPOINT ICH7
  239. C
  240. ICOND = 1
  241. CALL LIROBJ('CHPOINT',ICH7,ICOND,IRETOU)
  242. CALL ACTOBJ('CHPOINT',ICH7,1)
  243. IF (IERR.NE.0) GOTO 9999
  244. C
  245. C**** Control du CHPOINT ICH7
  246. C
  247. JGN = 4
  248. JGM = 1
  249. SEGINI MLMOTS
  250. MLMOTS.MOTS(1) = 'SCAL'
  251. CALL QUEPO1(ICH7, ICEN, MLMOTS)
  252. IF(IERR .NE. 0)THEN
  253. C
  254. C******** Message d'erreur standard
  255. C -301 0 %m1:40
  256. C
  257. MOTERR = 'CHPO7 = ??? '
  258. WRITE(IOIMP,*) MOTERR(1:40)
  259.  
  260. GOTO 9999
  261. ENDIF
  262. SEGSUP MLMOTS
  263. C
  264. C**** Lecture du CHPOINT ICH8
  265. C
  266. ICOND = 1
  267. CALL LIROBJ('CHPOINT',ICH8,ICOND,IRETOU)
  268. CALL ACTOBJ('CHPOINT',ICH8,1)
  269. IF (IERR.NE.0) GOTO 9999
  270. C
  271. C**** Control du CHPOINT ICH8
  272. C
  273. JGN = 4
  274. JGM = 1
  275. SEGINI MLMOTS
  276. MLMOTS.MOTS(1) = 'SCAL'
  277. CALL QUEPO1(ICH8, ICEN, MLMOTS)
  278. IF(IERR .NE. 0)THEN
  279. C
  280. C******** Message d'erreur standard
  281. C -301 0 %m1:40
  282. C
  283. MOTERR = 'CHPO8 = ??? '
  284. WRITE(IOIMP,*) MOTERR(1:40)
  285.  
  286. GOTO 9999
  287. ENDIF
  288. SEGSUP MLMOTS
  289. C
  290. C**** Lecture du CHPOINT ICH9
  291. C
  292. ICOND = 1
  293. CALL LIROBJ('CHPOINT',ICH9,ICOND,IRETOU)
  294. CALL ACTOBJ('CHPOINT',ICH9,1)
  295. IF (IERR.NE.0) GOTO 9999
  296. C
  297. C**** Control du CHPOINT ICH9
  298. C
  299. JGN = 4
  300. JGM = 1
  301. SEGINI MLMOTS
  302. MLMOTS.MOTS(1) = 'SCAL'
  303. CALL QUEPO1(ICH9, ICEN, MLMOTS)
  304. IF(IERR .NE. 0)THEN
  305. C
  306. C******** Message d'erreur standard
  307. C -301 0 %m1:40
  308. C
  309. MOTERR = 'CHPO9 = ??? '
  310. WRITE(IOIMP,*) MOTERR(1:40)
  311.  
  312. GOTO 9999
  313. ENDIF
  314. SEGSUP MLMOTS
  315. C
  316. C Lecture of the CATHARE pressure correction term
  317. C parameters
  318. C
  319. ICOND = 1
  320. CALL LIRREE(Cp,ICOND,IRETOU)
  321. IF(IERR .NE. 0) GOTO 9999
  322. IF((Cp .LT. 0) .OR. (Cp .GT. 7.d0))THEN
  323. C
  324. C******* Message d'erreur standard
  325. C -301 0 %m1:40
  326. C
  327. MOTERR(1:40) = 'Cp = ??? '
  328. CALL ERREUR(-301)
  329. C
  330. C******* Message d'erreur standard
  331. C Entier valant: %i1
  332. C -2 0
  333. C
  334. C INTERR(1) = Cp
  335. ENDIF
  336.  
  337. ICOND = 1
  338. CALL LIRREE(Cvm,ICOND,IRETOU)
  339. IF(IERR .NE. 0) GOTO 9999
  340. IF((Cvm .LT. 0) .OR. (Cvm .GT. 7.d0))THEN
  341. C
  342. C******* Message d'erreur standard
  343. C -301 0 %m1:40
  344. C
  345. MOTERR(1:40) = 'Cvm = ??? '
  346. CALL ERREUR(-301)
  347. C
  348. C******* Message d'erreur standard
  349. C Entier valant: %i1
  350. C -2 0
  351. C
  352. C INTERR(1) = Cvm
  353. ENDIF
  354. C
  355. C
  356. C**** Calcul des sorties.
  357. C
  358. CALL PR12f(ICEN, ICH1, ICH2, ICH3,
  359. & ICH4, ICH5, ICH6, ICH7,
  360. & ICH8, ICH9,
  361. & Cp, Cvm,
  362. & OCH1, OCH2, OCH3,
  363. & OCH4, OCH5, OCH6,
  364. & OCH7, OCH8, OCH9,
  365. & LOGNEG, LOGBOR, MESERR,
  366. & VALER, VAL1, VAL2)
  367. C
  368. IF(LOGNEG)THEN
  369. C
  370. C******* Pression (energie thermique) ou densité negative
  371. C
  372. C******* Message d'erreur standard
  373. C 41 2
  374. C %m1:8 = %r1 inférieur à %r2
  375. C
  376. MESCEL = MESERR(1)
  377. MOTERR(1:8) = MESCEL(1:8)
  378. REAERR(1) = REAL(VALER(1))
  379. REAERR(2) = 0.0
  380. CALL ERREUR(41)
  381. IF(LOGTRI)THEN
  382. * IERR = 0
  383. ELSE
  384. GOTO 9999
  385. ENDIF
  386. ENDIF
  387. IF(LOGBOR)THEN
  388. C
  389. C******* Message d'erreur standard
  390. C 42 2
  391. C %m1:8 = %r1 non compris entre %r2 et %r3
  392. C
  393. MESCEL = MESERR(2)
  394. MOTERR(1:8) = MESCEL(1:8)
  395. REAERR(1) = REAL(VALER(2))
  396. REAERR(2) = REAL(VAL1)
  397. REAERR(3) = REAL(VAL2)
  398. CALL ERREUR(42)
  399. IF(LOGTRI)THEN
  400. * IERR = 0
  401. ELSE
  402. GOTO 9999
  403. ENDIF
  404. ENDIF
  405. C
  406. C**** Ecriture du CHPOINT contenant la SUMA
  407. C
  408. CALL ACTOBJ('CHPOINT ', OCH1,1)
  409. CALL ACTOBJ('CHPOINT ', OCH2,1)
  410. CALL ACTOBJ('CHPOINT ', OCH3,1)
  411. CALL ACTOBJ('CHPOINT ', OCH4,1)
  412. CALL ACTOBJ('CHPOINT ', OCH5,1)
  413. CALL ACTOBJ('CHPOINT ', OCH6,1)
  414. CALL ACTOBJ('CHPOINT ', OCH7,1)
  415. CALL ACTOBJ('CHPOINT ', OCH8,1)
  416. CALL ACTOBJ('CHPOINT ', OCH9,1)
  417.  
  418. CALL ECROBJ('CHPOINT ', OCH1)
  419. CALL ECROBJ('CHPOINT ', OCH2)
  420. CALL ECROBJ('CHPOINT ', OCH3)
  421. CALL ECROBJ('CHPOINT ', OCH4)
  422. CALL ECROBJ('CHPOINT ', OCH5)
  423. CALL ECROBJ('CHPOINT ', OCH6)
  424. CALL ECROBJ('CHPOINT ', OCH7)
  425. CALL ECROBJ('CHPOINT ', OCH8)
  426. CALL ECROBJ('CHPOINT ', OCH9)
  427. C
  428. 9999 CONTINUE
  429.  
  430. END
  431.  
  432.  
  433.  

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