Télécharger prim2f.eso

Retour à la liste

Numérotation des lignes :

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

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