Télécharger fimaxi.eso

Retour à la liste

Numérotation des lignes :

fimaxi
  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.  
  61. -INC PPARAM
  62. -INC CCOPTIO
  63. -INC SMLMOTS
  64. C
  65. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  66. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  67. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  68. C & ,IECHO, IIMPI, IOSPI
  69. C & ,IDIM, IFICLE, IPREFI
  70. C & ,MCOORD
  71. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  72. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  73. C & ,NORINC,NORVAL,NORIND,NORVAD
  74. C & ,NUCROU, IPSAUV, IREFOR, ISAFOR
  75. C
  76. INTEGER NBOPT, IMET, IRET, MMODEL, ICOND, IDOMA, ICEN
  77. & , IX2D, IY2D, ILIINC, IPN, IGPN, ILGPN, IRES, NBCOMP
  78. & , JGN, JGM, INEFMD, IS2D, IVOL
  79. C
  80. PARAMETER (NBOPT=2)
  81. CHARACTER*8 LOPT(NBOPT), TYPI
  82. CHARACTER*4 MOT1
  83. C
  84. DATA LOPT/'RESI ','JACOCONS'/
  85. C
  86. CALL LIRMOT(LOPT,NBOPT,IMET,1)
  87. IF(IERR.NE.0)GOTO 9999
  88. IF(IFOMOD .NE. 0)THEN
  89. C
  90. C******* Message d'erreur standard
  91. C 251 2
  92. C Tentative d'utilisation d'une option non implémentée
  93. C
  94. CALL ERREUR(251)
  95. GOTO 9999
  96. ENDIF
  97. C
  98. C**** IMET = 1 -> residuu
  99. C IMET = 2 -> jacobienne
  100. C
  101. IF(IMET .NE. 1)THEN
  102. C
  103. C******* Message d'erreur standard
  104. C 251 2
  105. C Tentative d'utilisation d'une option non implémentée
  106. C
  107. CALL ERREUR(251)
  108. GOTO 9999
  109. ENDIF
  110. C
  111. C**** Table domaine
  112. C
  113. ICOND=1
  114. CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET)
  115. IF(IERR.NE.0)GOTO 9999
  116. CALL LEKMOD(MMODEL,IDOMA,INEFMD)
  117. IF(IERR.NE.0)GOTO 9999
  118. C
  119. C**** Lecture du MELEME SPG des points CENTRE et
  120. C des centres 2D
  121. C
  122. CALL LEKTAB(IDOMA,'CENTRE',ICEN)
  123. IF(IERR .NE. 0) GO TO 9999
  124. TYPI='CHPOINT '
  125. CALL ACMO(IDOMA,'XCEN2D',TYPI,IX2D)
  126. IF(IERR .NE. 0) GO TO 9999
  127. CALL ACMO(IDOMA,'YCEN2D',TYPI,IY2D)
  128. IF(IERR .NE. 0) GO TO 9999
  129. CALL ACMO(IDOMA,'XXSUR2D',TYPI,IS2D)
  130. IF(IERR .NE. 0) GO TO 9999
  131. CALL ACMO(IDOMA,'XXVOLUM',TYPI,IVOL)
  132. IF(IERR .NE. 0) GO TO 9999
  133. C
  134. C**** Noms de variables conservatives
  135. C
  136. CALL LIROBJ('LISTMOTS',ILIINC,1,IRET)
  137. IF(IERR .NE. 0) GOTO 9999
  138. MLMOTS = ILIINC
  139. SEGACT MLMOTS
  140. NBCOMP = MLMOTS.MOTS(/2)
  141. IF(NBCOMP .NE. 4)THEN
  142. MOTERR(1:40) = 'LISTINCO = ???'
  143. WRITE(IOIMP,*) MOTERR
  144. C
  145. C******* Message d'erreur standard
  146. C 21 2
  147. C Données incompatibles
  148. C
  149. CALL ERREUR(21)
  150. GOTO 9999
  151. ELSE
  152. MOT1=MLMOTS.MOTS(2)
  153. ENDIF
  154. SEGDES MLMOTS
  155. C
  156. C**** Lecture de PN
  157. C
  158. CALL LIROBJ('CHPOINT ',IPN,1,IRET)
  159. IF(IERR .NE. 0) GOTO 9999
  160. C
  161. C**** Control du CHPOINT
  162. C
  163. JGN=4
  164. JGM=1
  165. SEGINI MLMOT1
  166. MLMOT1.MOTS(1)='SCAL'
  167. CALL QUEPO1(IPN, ICEN, MLMOT1)
  168. IF (IERR .NE. 0) GOTO 9999
  169. SEGDES MLMOT1
  170. C
  171. C**** Lecture de GPN
  172. C
  173. CALL LIROBJ('CHPOINT ',IGPN,1,IRET)
  174. IF(IERR .NE. 0) GOTO 9999
  175. C
  176. C**** Control du CHPOINT
  177. C
  178. JGN=4
  179. JGM=2
  180. SEGINI MLMOT2
  181. MLMOT2.MOTS(1)='P1DX'
  182. MLMOT2.MOTS(2)='P1DY'
  183. CALL QUEPO1(IGPN, ICEN, MLMOT2)
  184. IF (IERR .NE. 0) GOTO 9999
  185. SEGSUP MLMOT2
  186. C
  187. C**** Lecture de LGPN
  188. C
  189. CALL LIROBJ('CHPOINT ',ILGPN,1,IRET)
  190. IF(IERR .NE. 0) GOTO 9999
  191. C
  192. C**** Control du CHPOINT
  193. C
  194. SEGACT MLMOT1*MOD
  195. MLMOT1.MOTS(1)='P1 '
  196. CALL QUEPO1(ILGPN, ICEN, MLMOT1)
  197. IF (IERR .NE. 0) GOTO 9999
  198. SEGDES MLMOT1
  199. C
  200. C**** Creation of RESI
  201. C
  202. SEGACT MLMOT1*MOD
  203. TYPI='CENTRE '
  204. MLMOT1.MOTS(1)=MOT1
  205. CALL KRCHP1(TYPI,ICEN,IRES,MLMOT1)
  206. IF(IERR.NE.0) GOTO 9999
  207. C
  208. SEGSUP MLMOT1
  209. C
  210. C**** Computation of the residual
  211. C
  212. CALL FIMAX2(ICEN,IX2D,IY2D,IS2D,IVOL,IPN,IGPN,ILGPN,IRES)
  213. IF(IERR.NE.0) GOTO 9999
  214. C
  215. IF(IRES .NE. 0) CALL ECROBJ('CHPOINT',IRES)
  216. C
  217. 9999 CONTINUE
  218. RETURN
  219. END
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  

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