Télécharger prim1e.eso

Retour à la liste

Numérotation des lignes :

  1. C PRIM1E SOURCE CB215821 19/07/31 21:16:35 10277
  2. SUBROUTINE PRIM1E()
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : PRIM1E (OPERATEUR GIBIANE)
  8. C
  9. C DESCRIPTION : Voir PRIMIT
  10. C
  11. C Calcul des variables primitives (et du "gamma")
  12. C pour les gas "calorically perfect" monoespeces
  13. C
  14. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  15. C
  16. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
  17. C
  18. C************************************************************************
  19. C
  20. C
  21. C APPELES (E/S) : LIROBJ, QUEPOI, QUEPO1, ERREUR, ECROBJ, LIRCHA,
  22. C ECRCHA
  23. C
  24. C APPELES (Calcul) : PR1ECA
  25. C
  26. C
  27. C************************************************************************
  28. C
  29. C PHRASE D'APPEL (GIBIANE) :
  30. C
  31. C 1) gaz ideal mono-espece
  32. C
  33. C RCHPO1 RCHPO2 = 'PRIM' MCLE1 CHPO1 CHPO2 CHPO3 CHPO4 (MCLE2) ;
  34. C
  35. C
  36. C ENTREES :
  37. C
  38. C MCLE1 : mot clé, 'PERFMONO'
  39. C
  40. C CHPO1 : CHPOINT contenant la masse volumique
  41. C (une composante, 'SCAL').
  42. C
  43. C CHPO2 : CHPOINT contenant les dèbits
  44. C (2 composantes en 2D, 'UX ','UY ');
  45. C
  46. C CHPO3 : CHPOINT contenat l'énergie totale per
  47. C unité de volume (RHO Et),
  48. C (une composante, 'SCAL').
  49. C
  50. C i.e. CHPO1, CHPO2, CHPO3 sont les variables
  51. C conservatives des Equations d'Euler.
  52. C
  53. C CHPO4 : CHPOINT contenat les "gamma" du gaz
  54. C (une composante, 'SCAL').
  55. C
  56. C MCLE2 : Option personelle: pas dans la notice
  57. C officielle!!!
  58. C Mot clé, 'TRICHE' (s'il y a un erreur,
  59. C les objects RCHPO1 et RCHPO2 ne sont pas
  60. C des type ANNULLE et le programme
  61. C ne s'arrete pas!!!)
  62. C
  63. C SORTIES :
  64. C
  65. C RCHPO1 : CHPOINT contenant la vitesse
  66. C
  67. C RCHPO2 : CHPOINT contenant la pression du gaz;
  68. C
  69. C************************************************************************
  70. C
  71. C HISTORIQUE (Anomalies et modifications éventuelles)
  72. C
  73. C HISTORIQUE : Créée le 12.1.98.
  74. C
  75. C Modifie le 30.7.98 pour ajouter le mot clee personelle
  76. C 'TRICHE'
  77. C
  78. C Modifie le 28.09.00 pour control sur le noms de composantes
  79. C (subroutine QUEPO1)
  80. C Variables de CCOPTIO en commentaire
  81. C Elimination de ERREUR(-301)
  82. C
  83. C************************************************************************
  84. C
  85. C
  86. C**** Variables de COOPTIO
  87. C
  88. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  89. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  90. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  91. C & ,IECHO, IIMPI, IOSPI
  92. C & ,IDIM
  93. C & ,MCOORD
  94. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  95. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  96. C & ,NORINC,NORVAL,NORIND,NORVAD
  97. C & ,NUCROU, IPSAUV
  98. C
  99. C**** Les variables
  100. C
  101. IMPLICIT INTEGER(I-N)
  102. INTEGER ICOND, IRETOU, INDIC, NBCOMP, IERR0
  103. & , ICEN, IRO, IROVIT, IROET, IGAMMA
  104. & , IPRES, IVIT, JGN, JGM
  105. REAL*8 VALER(2),VAL1,VAL2
  106. CHARACTER*(40) MESERR(2),MESCEL
  107. CHARACTER*(4) MOT(1)
  108. CHARACTER*(6) NOMTRI
  109. LOGICAL LOGNEG, LOGBOR, LOGTRI
  110. C
  111. C**** Les Includes
  112. C
  113. -INC CCOPTIO
  114. -INC SMCHPOI
  115. -INC SMLMOTS
  116. C
  117. C**** Initialisation des parametres d'erreur
  118. C
  119. LOGNEG = .FALSE.
  120. LOGBOR = .FALSE.
  121. MESCEL = ' '
  122. MESERR(1) = MESCEL
  123. MESERR(2) = MESCEL
  124. MOTERR(1:40) = MESCEL
  125. VALER(1) = 0.0D0
  126. VALER(2) = 0.0D0
  127. VAL1 = 0.0D0
  128. VAL2 = 0.0D0
  129. C
  130. C**** Initialisation des MOT(1)
  131. C
  132. MOT(1) = ' '
  133. C
  134. C**** Lecture du CHPOINT RO
  135. C
  136. ICOND = 1
  137. CALL LIROBJ('CHPOINT ',IRO,ICOND,IRETOU)
  138. CALL ACTOBJ('CHPOINT ',IRO,1)
  139. IF (IERR.NE.0) GOTO 9999
  140. C
  141. C**** On cherche le pointeur de son maillage et on l'impose sur les
  142. C autres CHPOINT
  143. C
  144. MCHPOI = IRO
  145. SEGACT MCHPOI
  146. MSOUPO = MCHPOI.IPCHP(1)
  147. SEGACT MSOUPO
  148. ICEN = MSOUPO.IGEOC
  149. SEGDES MSOUPO
  150. SEGDES MCHPOI
  151. C
  152. C**** Control du CHPOINT: QUEPOI
  153. C
  154. C On controlle que le chpoint est non-partitione
  155. C
  156. C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
  157. C INDIC = 0 -> on ne fait que verifier le support geometrique (ICEN)
  158. C
  159. C NBCOMP > 0 -> numero des composantes
  160. C
  161. C MOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
  162. C
  163. INDIC = 1
  164. NBCOMP = 1
  165. MOT(1) = 'SCAL'
  166. CALL QUEPOI(IRO, ICEN, INDIC, NBCOMP, MOT)
  167. IF(IERR .NE. 0)THEN
  168. IERR0 = IERR
  169.  
  170. C
  171. C******** Message d'erreur standard
  172. C -301 0 %m1:40
  173. C
  174. MOTERR = 'CHPO1 = ??? '
  175. WRITE(IOIMP,*) MOTERR(1:40)
  176.  
  177. GOTO 9999
  178. ENDIF
  179. C
  180. C**** Lecture du CHPOINT DEBIT.
  181. C
  182. ICOND = 1
  183. CALL LIROBJ('CHPOINT',IROVIT,ICOND,IRETOU)
  184. CALL ACTOBJ('CHPOINT',IROVIT,1)
  185. IF (IERR.NE.0) GOTO 9999
  186. C
  187. C**** Control du CHPOINT
  188. C
  189. INDIC = 1
  190. NBCOMP = IDIM
  191. JGN = 4
  192. JGM = IDIM
  193. SEGINI MLMOTS
  194. MLMOTS.MOTS(1) = 'UX '
  195. MLMOTS.MOTS(2) = 'UY '
  196. IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UZ '
  197. CALL QUEPO1(IROVIT, ICEN, MLMOTS)
  198. IF(IERR .NE. 0)THEN
  199. IERR0 = IERR
  200.  
  201. C
  202. C******** Message d'erreur standard
  203. C -301 0 %m1:40
  204. C
  205. MOTERR = 'CHPO2 = ??? '
  206. WRITE(IOIMP,*) MOTERR(1:40)
  207.  
  208. GOTO 9999
  209. ENDIF
  210. SEGSUP MLMOTS
  211. C
  212. C**** Lecture du CHPOINT ROET
  213. C
  214. ICOND = 1
  215. CALL LIROBJ('CHPOINT',IROET,ICOND,IRETOU)
  216. CALL ACTOBJ('CHPOINT',IROET,1)
  217. IF (IERR.NE.0) GOTO 9999
  218. C
  219. C**** Control du CHPOINT
  220. C
  221. INDIC = 1
  222. NBCOMP = 1
  223. MOT(1) = 'SCAL'
  224. CALL QUEPOI(IROET, ICEN, INDIC, NBCOMP, MOT)
  225. IF(IERR .NE. 0)THEN
  226. IERR0 = IERR
  227.  
  228. C
  229. C******** Message d'erreur standard
  230. C -301 0 %m1:40
  231. C
  232. MOTERR = 'CHPO3 = ??? '
  233. WRITE(IOIMP,*) MOTERR(1:40)
  234.  
  235. GOTO 9999
  236. ENDIF
  237. C
  238. C**** Lecture du CHPOINT GAMMA
  239. C
  240. ICOND = 1
  241. CALL LIROBJ('CHPOINT',IGAMMA,ICOND,IRETOU)
  242. CALL ACTOBJ('CHPOINT',IGAMMA,1)
  243. IF(IERR .NE. 0)GOTO 9999
  244. C
  245. C**** Control du CHPOINT
  246. C
  247. INDIC = 1
  248. NBCOMP = 1
  249. MOT(1) = 'SCAL'
  250. CALL QUEPOI(IGAMMA, ICEN, INDIC, NBCOMP, MOT)
  251. IF(IERR .NE. 0)THEN
  252. IERR0 = IERR
  253.  
  254. C
  255. C******* Message d'erreur standard
  256. C -301 0 %m1:40
  257. C
  258. MOTERR = 'CHPO4 = ??? '
  259. WRITE(IOIMP,*) MOTERR(1:40)
  260.  
  261. GOTO 9999
  262. ENDIF
  263. C
  264. C******* Option TRICHE
  265. C
  266. ICOND = 0
  267. CALL LIRCHA(NOMTRI,ICOND,IRETOU)
  268. IF(IERR .NE. 0)GOTO 9999
  269. IF(IRETOU .EQ. 0)THEN
  270. LOGTRI = .FALSE.
  271. ELSEIF(NOMTRI .EQ. 'TRICHE')THEN
  272. LOGTRI = .TRUE.
  273. ELSE
  274. LOGTRI = .FALSE.
  275. CALL ECRCHA(NOMTRI)
  276. ENDIF
  277. C
  278. C**** Calcul des sorties.
  279. C
  280. CALL PR1ECA(
  281. & ICEN,IRO,IROVIT,IROET,IGAMMA,
  282. & IVIT,IPRES,
  283. & LOGNEG,LOGBOR,MESERR,
  284. & VALER,VAL1,VAL2)
  285. C
  286. IERR0 = 0
  287. IF(LOGNEG)THEN
  288. C
  289. C******* Pression (energie thermique) ou densité negative
  290. C
  291. C
  292. C******* Message d'erreur standard
  293. C 41 2
  294. C %m1:8 = %r1 inférieur à %r2
  295. C
  296. MESCEL = MESERR(1)
  297. MOTERR(1:8) = MESCEL(1:8)
  298. REAERR(1) = REAL(VALER(1))
  299. REAERR(2) = 0.0
  300. CALL ERREUR(41)
  301. IF(LOGTRI)THEN
  302. * IERR = 0
  303. ELSE
  304. GOTO 9999
  305. ENDIF
  306. ENDIF
  307. IF(LOGBOR)THEN
  308. C
  309. C******* GAMMA dehor GAMMIN, GAMMAX
  310. C
  311. C******* Message d'erreur standard
  312. C 42 2
  313. C %m1:8 = %r1 non compris entre %r2 et %r3
  314. C
  315. MESCEL = MESERR(2)
  316. MOTERR(1:8) = MESCEL(1:8)
  317. REAERR(1) = REAL(VALER(2))
  318. REAERR(2) = REAL(VAL1)
  319. REAERR(3) = REAL(VAL2)
  320. CALL ERREUR(42)
  321. IF(LOGTRI)THEN
  322. * IERR = 0
  323. ELSE
  324. GOTO 9999
  325. ENDIF
  326. ENDIF
  327.  
  328. C**** Ecriture du CHPOINT contenant la pression.
  329. CALL ACTOBJ('CHPOINT ',IPRES,1)
  330. CALL ECROBJ('CHPOINT ',IPRES)
  331.  
  332. C**** Ecriture du CHPOINT contenant la vitesse.
  333. CALL ACTOBJ('CHPOINT ',IVIT,1)
  334. CALL ECROBJ('CHPOINT ',IVIT)
  335.  
  336. C
  337. 9999 CONTINUE
  338. END
  339.  
  340.  
  341.  

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