Télécharger prim1e.eso

Retour à la liste

Numérotation des lignes :

  1. C PRIM1E SOURCE CHAT 06/03/29 21:30:12 5360
  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. IF (IERR.NE.0) GOTO 9999
  139. C
  140. C**** On cherche le pointeur de son maillage et on l'impose sur les
  141. C autres CHPOINT
  142. C
  143. MCHPOI = IRO
  144. SEGACT MCHPOI
  145. MSOUPO = MCHPOI.IPCHP(1)
  146. SEGACT MSOUPO
  147. ICEN = MSOUPO.IGEOC
  148. SEGDES MSOUPO
  149. SEGDES MCHPOI
  150. C
  151. C**** Control du CHPOINT: QUEPOI
  152. C
  153. C On controlle que le chpoint est non-partitione
  154. C
  155. C INDIC = 1 -> on impose le pointeur du support geometrique (ICEN)
  156. C INDIC = 0 -> on ne fait que verifier le support geometrique (ICEN)
  157. C
  158. C NBCOMP > 0 -> numero des composantes
  159. C
  160. C MOT(1) = ' ' obligatoire s'on connais pas les noms des composantes
  161. C
  162. INDIC = 1
  163. NBCOMP = 1
  164. MOT(1) = 'SCAL'
  165. CALL QUEPOI(IRO, ICEN, INDIC, NBCOMP, MOT)
  166. IF(IERR .NE. 0)THEN
  167. IERR0 = IERR
  168.  
  169. C
  170. C******** Message d'erreur standard
  171. C -301 0 %m1:40
  172. C
  173. MOTERR = 'CHPO1 = ??? '
  174. WRITE(IOIMP,*) MOTERR(1:40)
  175.  
  176. GOTO 9999
  177. ENDIF
  178. C
  179. C**** Lecture du CHPOINT DEBIT.
  180. C
  181. ICOND = 1
  182. CALL LIROBJ('CHPOINT',IROVIT,ICOND,IRETOU)
  183. IF (IERR.NE.0) GOTO 9999
  184. C
  185. C**** Control du CHPOINT
  186. C
  187. INDIC = 1
  188. NBCOMP = IDIM
  189. JGN = 4
  190. JGM = IDIM
  191. SEGINI MLMOTS
  192. MLMOTS.MOTS(1) = 'UX '
  193. MLMOTS.MOTS(2) = 'UY '
  194. IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UZ '
  195. CALL QUEPO1(IROVIT, ICEN, MLMOTS)
  196. IF(IERR .NE. 0)THEN
  197. IERR0 = IERR
  198.  
  199. C
  200. C******** Message d'erreur standard
  201. C -301 0 %m1:40
  202. C
  203. MOTERR = 'CHPO2 = ??? '
  204. WRITE(IOIMP,*) MOTERR(1:40)
  205.  
  206. GOTO 9999
  207. ENDIF
  208. SEGSUP MLMOTS
  209. C
  210. C**** Lecture du CHPOINT ROET
  211. C
  212. ICOND = 1
  213. CALL LIROBJ('CHPOINT',IROET,ICOND,IRETOU)
  214. IF (IERR.NE.0) GOTO 9999
  215. C
  216. C**** Control du CHPOINT
  217. C
  218. INDIC = 1
  219. NBCOMP = 1
  220. MOT(1) = 'SCAL'
  221. CALL QUEPOI(IROET, ICEN, INDIC, NBCOMP, MOT)
  222. IF(IERR .NE. 0)THEN
  223. IERR0 = IERR
  224.  
  225. C
  226. C******** Message d'erreur standard
  227. C -301 0 %m1:40
  228. C
  229. MOTERR = 'CHPO3 = ??? '
  230. WRITE(IOIMP,*) MOTERR(1:40)
  231.  
  232. GOTO 9999
  233. ENDIF
  234. C
  235. C**** Lecture du CHPOINT GAMMA
  236. C
  237. ICOND = 1
  238. CALL LIROBJ('CHPOINT',IGAMMA,ICOND,IRETOU)
  239. IF(IERR .NE. 0)GOTO 9999
  240. C
  241. C**** Control du CHPOINT
  242. C
  243. INDIC = 1
  244. NBCOMP = 1
  245. MOT(1) = 'SCAL'
  246. CALL QUEPOI(IGAMMA, ICEN, INDIC, NBCOMP, MOT)
  247. IF(IERR .NE. 0)THEN
  248. IERR0 = IERR
  249.  
  250. C
  251. C******* Message d'erreur standard
  252. C -301 0 %m1:40
  253. C
  254. MOTERR = 'CHPO4 = ??? '
  255. WRITE(IOIMP,*) MOTERR(1:40)
  256.  
  257. GOTO 9999
  258. ENDIF
  259. C
  260. C******* Option TRICHE
  261. C
  262. ICOND = 0
  263. CALL LIRCHA(NOMTRI,ICOND,IRETOU)
  264. IF(IERR .NE. 0)GOTO 9999
  265. IF(IRETOU .EQ. 0)THEN
  266. LOGTRI = .FALSE.
  267. ELSEIF(NOMTRI .EQ. 'TRICHE')THEN
  268. LOGTRI = .TRUE.
  269. ELSE
  270. LOGTRI = .FALSE.
  271. CALL ECRCHA(NOMTRI)
  272. ENDIF
  273. C
  274. C**** Calcul des sorties.
  275. C
  276. CALL PR1ECA(
  277. & ICEN,IRO,IROVIT,IROET,IGAMMA,
  278. & IVIT,IPRES,
  279. & LOGNEG,LOGBOR,MESERR,
  280. & VALER,VAL1,VAL2)
  281. C
  282. IERR0 = 0
  283. IF(LOGNEG)THEN
  284. C
  285. C******* Pression (energie thermique) ou densité negative
  286. C
  287. C
  288. C******* Message d'erreur standard
  289. C 41 2
  290. C %m1:8 = %r1 inférieur à %r2
  291. C
  292. MESCEL = MESERR(1)
  293. MOTERR(1:8) = MESCEL(1:8)
  294. REAERR(1) = REAL(VALER(1))
  295. REAERR(2) = 0.0
  296. CALL ERREUR(41)
  297. IF(LOGTRI)THEN
  298. * IERR = 0
  299. ELSE
  300. GOTO 9999
  301. ENDIF
  302. ENDIF
  303. IF(LOGBOR)THEN
  304. C
  305. C******* GAMMA dehor GAMMIN, GAMMAX
  306. C
  307. C******* Message d'erreur standard
  308. C 42 2
  309. C %m1:8 = %r1 non compris entre %r2 et %r3
  310. C
  311. MESCEL = MESERR(2)
  312. MOTERR(1:8) = MESCEL(1:8)
  313. REAERR(1) = REAL(VALER(2))
  314. REAERR(2) = REAL(VAL1)
  315. REAERR(3) = REAL(VAL2)
  316. CALL ERREUR(42)
  317. IF(LOGTRI)THEN
  318. * IERR = 0
  319. ELSE
  320. GOTO 9999
  321. ENDIF
  322. ENDIF
  323. C
  324. C**** Ecriture du CHPOINT contenant la pression.
  325. C
  326. CALL ECROBJ('CHPOINT',IPRES)
  327. C
  328. C**** Ecriture du CHPOINT contenant la vitesse.
  329. C
  330. CALL ECROBJ('CHPOINT',IVIT)
  331. C
  332. C
  333. 9999 CONTINUE
  334. C
  335. RETURN
  336. END
  337.  
  338.  
  339.  
  340.  
  341.  
  342.  
  343.  
  344.  
  345.  

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