Télécharger fimaxi.eso

Retour à la liste

Numérotation des lignes :

  1. C FIMAXI SOURCE CHAT 06/08/24 21:35:37 5529
  2. SUBROUTINE FIMAXI
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : FIMAXI
  8. C
  9. C DESCRIPTION : Subroutine appellée par FIMPVF
  10. C
  11. C Modelisation 2D axi du trem de pression
  12. C
  13. C Calcul du flux/residu
  14. C
  15. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  16. C
  17. C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF
  18. C
  19. C************************************************************************
  20. C
  21. C*** SYNTAXE
  22. C
  23. C Discrétisation en VF "cell-centered" des équations d'Euler pour
  24. C un gaz parfait polytropique, axi
  25. C Inconnues: densités, quantité de mouvement, énergie totale par
  26. C unité de volumes (variables conservatives)
  27. C
  28. C First order
  29. C
  30. C RESU = 'FIMP' 'VF' 'AXI'
  31. C 'RESI' MODE LMOTC PN GRADP LIMP ;
  32. C
  33. C MODE : MODELE 'EULER'
  34. C
  35. C LMOTC : LISTMOTS, noms des variables conservatives
  36. C
  37. C PN : pression (SPG = 'CENTRE', une seule
  38. C composante, 'SCAL')
  39. C
  40. C GRADP : gradient (SPG = 'CENTRE', 2 composantes,
  41. C 'PX', 'PY')
  42. C
  43. C LIMP : limiteur (SPG = 'CENTRE', 1 composante,
  44. C 'P1')
  45. C
  46. C SORTIES
  47. C
  48. C RESU : residu
  49. C
  50. C
  51. C************************************************************************
  52. C
  53. C HISTORIQUE (Anomalies et modifications éventuelles)
  54. C
  55. C Created the 24/02/04
  56. C
  57. C
  58. C************************************************************************
  59. IMPLICIT INTEGER(I-N)
  60. -INC CCOPTIO
  61. -INC SMLMOTS
  62. C
  63. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  64. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  65. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  66. C & ,IECHO, IIMPI, IOSPI
  67. C & ,IDIM, IFICLE, IPREFI
  68. C & ,MCOORD
  69. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  70. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  71. C & ,NORINC,NORVAL,NORIND,NORVAD
  72. C & ,NUCROU, IPSAUV, IREFOR, ISAFOR
  73. C
  74. INTEGER NBOPT, IMET, IRET, MMODEL, ICOND, IDOMA, ICEN
  75. & , IX2D, IY2D, ILIINC, IPN, IGPN, ILGPN, IRES, NBCOMP
  76. & , JGN, JGM, INEFMD, IS2D, IVOL
  77. C
  78. PARAMETER (NBOPT=2)
  79. CHARACTER*8 LOPT(NBOPT), TYPI
  80. CHARACTER*4 MOT1
  81. C
  82. DATA LOPT/'RESI ','JACOCONS'/
  83. C
  84. CALL LIRMOT(LOPT,NBOPT,IMET,1)
  85. IF(IERR.NE.0)GOTO 9999
  86. IF(IFOMOD .NE. 0)THEN
  87. C
  88. C******* Message d'erreur standard
  89. C 251 2
  90. C Tentative d'utilisation d'une option non implémentée
  91. C
  92. CALL ERREUR(251)
  93. GOTO 9999
  94. ENDIF
  95. C
  96. C**** IMET = 1 -> residuu
  97. C IMET = 2 -> jacobienne
  98. C
  99. IF(IMET .NE. 1)THEN
  100. C
  101. C******* Message d'erreur standard
  102. C 251 2
  103. C Tentative d'utilisation d'une option non implémentée
  104. C
  105. CALL ERREUR(251)
  106. GOTO 9999
  107. ENDIF
  108. C
  109. C**** Table domaine
  110. C
  111. ICOND=1
  112. CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET)
  113. IF(IERR.NE.0)GOTO 9999
  114. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  115. IF(IERR.NE.0)GOTO 9999
  116. C
  117. C**** Lecture du MELEME SPG des points CENTRE et
  118. C des centres 2D
  119. C
  120. CALL LEKTAB(IDOMA,'CENTRE',ICEN)
  121. IF(IERR .NE. 0) GO TO 9999
  122. TYPI='CHPOINT '
  123. CALL ACMO(IDOMA,'XCEN2D',TYPI,IX2D)
  124. IF(IERR .NE. 0) GO TO 9999
  125. CALL ACMO(IDOMA,'YCEN2D',TYPI,IY2D)
  126. IF(IERR .NE. 0) GO TO 9999
  127. CALL ACMO(IDOMA,'XXSUR2D',TYPI,IS2D)
  128. IF(IERR .NE. 0) GO TO 9999
  129. CALL ACMO(IDOMA,'XXVOLUM',TYPI,IVOL)
  130. IF(IERR .NE. 0) GO TO 9999
  131. C
  132. C**** Noms de variables conservatives
  133. C
  134. CALL LIROBJ('LISTMOTS',ILIINC,1,IRET)
  135. IF(IERR .NE. 0) GOTO 9999
  136. MLMOTS = ILIINC
  137. SEGACT MLMOTS
  138. NBCOMP = MLMOTS.MOTS(/2)
  139. IF(NBCOMP .NE. 4)THEN
  140. MOTERR(1:40) = 'LISTINCO = ???'
  141. WRITE(IOIMP,*) MOTERR
  142. C
  143. C******* Message d'erreur standard
  144. C 21 2
  145. C Données incompatibles
  146. C
  147. CALL ERREUR(21)
  148. GOTO 9999
  149. ELSE
  150. MOT1=MLMOTS.MOTS(2)
  151. ENDIF
  152. SEGDES MLMOTS
  153. C
  154. C**** Lecture de PN
  155. C
  156. CALL LIROBJ('CHPOINT ',IPN,1,IRET)
  157. IF(IERR .NE. 0) GOTO 9999
  158. C
  159. C**** Control du CHPOINT
  160. C
  161. JGN=4
  162. JGM=1
  163. SEGINI MLMOT1
  164. MLMOT1.MOTS(1)='SCAL'
  165. CALL QUEPO1(IPN, ICEN, MLMOT1)
  166. IF (IERR .NE. 0) GOTO 9999
  167. SEGDES MLMOT1
  168. C
  169. C**** Lecture de GPN
  170. C
  171. CALL LIROBJ('CHPOINT ',IGPN,1,IRET)
  172. IF(IERR .NE. 0) GOTO 9999
  173. C
  174. C**** Control du CHPOINT
  175. C
  176. JGN=4
  177. JGM=2
  178. SEGINI MLMOT2
  179. MLMOT2.MOTS(1)='P1DX'
  180. MLMOT2.MOTS(2)='P1DY'
  181. CALL QUEPO1(IGPN, ICEN, MLMOT2)
  182. IF (IERR .NE. 0) GOTO 9999
  183. SEGSUP MLMOT2
  184. C
  185. C**** Lecture de LGPN
  186. C
  187. CALL LIROBJ('CHPOINT ',ILGPN,1,IRET)
  188. IF(IERR .NE. 0) GOTO 9999
  189. C
  190. C**** Control du CHPOINT
  191. C
  192. SEGACT MLMOT1*MOD
  193. MLMOT1.MOTS(1)='P1 '
  194. CALL QUEPO1(ILGPN, ICEN, MLMOT1)
  195. IF (IERR .NE. 0) GOTO 9999
  196. SEGDES MLMOT1
  197. C
  198. C**** Creation of RESI
  199. C
  200. SEGACT MLMOT1*MOD
  201. TYPI='CENTRE '
  202. MLMOT1.MOTS(1)=MOT1
  203. CALL KRCHP1(TYPI,ICEN,IRES,MLMOT1)
  204. IF(IERR.NE.0) GOTO 9999
  205. C
  206. SEGSUP MLMOT1
  207. C
  208. C**** Computation of the residual
  209. C
  210. CALL FIMAX2(ICEN,IX2D,IY2D,IS2D,IVOL,IPN,IGPN,ILGPN,IRES)
  211. IF(IERR.NE.0) GOTO 9999
  212. C
  213. IF(IRES .NE. 0) CALL ECROBJ('CHPOINT',IRES)
  214. C
  215. 9999 CONTINUE
  216. RETURN
  217. END
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  

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