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

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