Télécharger fimvf1.eso

Retour à la liste

Numérotation des lignes :

  1. C FIMVF1 SOURCE KK2000 14/04/10 21:15:07 8032
  2. SUBROUTINE FIMVF1
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : FIMVF1
  8. C
  9. C DESCRIPTION : Subroutine appellée par FIMPVF
  10. C
  11. C Modelisation 2D/3D des equations d'Euler
  12. C Gravité
  13. C
  14. C Calcul du flux/residu
  15. C
  16. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  17. C
  18. C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF
  19. C
  20. C************************************************************************
  21. C
  22. C*** SYNTAXE
  23. C
  24. C Discrétisation en VF "cell-centered" des équations d'Euler pour
  25. C un gaz parfait polytropique
  26. C Inconnues: densités, quantité de mouvement, énergie totale par
  27. C unité de volumes (variables conservatives)
  28. C Gravité
  29. C
  30. C RESU = 'FIMP' 'VF' 'GRAVMONO'
  31. C MOT1 LMOTC CHPRN CHPGN CHGRA ;
  32. C
  33. C MOT1 : MOT, 'RESI', 'JACOCONS'
  34. C
  35. C LMOTC : LISTMOTS, noms des variables conservatives
  36. C
  37. C CHPRN : densité (SPG = 'CENTRE', une seule
  38. C composante, 'SCAL')
  39. C
  40. C CHPGN : qdm (SPG = meme que CHPRN,
  41. C composantes: 'UX', 'UY', ('UZ'))
  42. C
  43. C CHPGRA : gravité (SPG = meme que CHPRN,
  44. C composantes: 'UX', 'UY', ('UZ'))
  45. C
  46. C
  47. C SORTIES
  48. C
  49. C RESU : residu ou matrice jacobienne
  50. C
  51. C
  52. C************************************************************************
  53. C
  54. C HISTORIQUE (Anomalies et modifications éventuelles)
  55. C
  56. C HISTORIQUE :
  57. C
  58. C************************************************************************
  59. IMPLICIT INTEGER(I-N)
  60. IMPLICIT REAL*8(A-H,O-Z)
  61.  
  62. -INC CCOPTIO
  63. -INC SMLMOTS
  64. -INC SMCHPOI
  65. C
  66. INTEGER NBOPT, IMET, IRET, IRO, ICEN, INDIC, NBCOMP
  67. & , IROVIT, JGN, JGM, IGRAV, ILIINC, IJAC, IRES
  68. C
  69. PARAMETER (NBOPT=2)
  70. CHARACTER*8 LOPT(NBOPT)
  71. CHARACTER*4 MOT(1)
  72. C
  73. DATA LOPT/'RESI ','JACOCONS'/
  74. C
  75. C**** IMET = 1 -> residuu
  76. C IMET = 2 -> jacobienne
  77. C
  78. CALL LIRMOT(LOPT,NBOPT,IMET,1)
  79. IF(IERR.NE.0)GOTO 9999
  80. C
  81. C**** Noms de variables conservatives
  82. C
  83. CALL LIROBJ('LISTMOTS',ILIINC,1,IRET)
  84. IF(IERR .NE. 0) GOTO 9999
  85. MLMOTS = ILIINC
  86. SEGACT MLMOTS
  87. NBCOMP = MLMOTS.MOTS(/2)
  88. SEGDES MLMOTS
  89. IF(NBCOMP .NE. (IDIM+2))THEN
  90. MOTERR(1:40) = 'LISTINCO = ???'
  91. WRITE(IOIMP,*) MOTERR
  92. C
  93. C******* Message d'erreur standard
  94. C 21 2
  95. C Données incompatibles
  96. C
  97. CALL ERREUR(21)
  98. GOTO 9999
  99. ENDIF
  100. C
  101. C**** Densité
  102. C
  103. CALL LIROBJ('CHPOINT',IRO,1,IRET)
  104. IF (IERR.NE.0) GOTO 9999
  105. C
  106. C**** On cherche le pointeur de son maillage et on l'impose sur les
  107. C autres CHPOINT
  108. C
  109. MCHPOI = IRO
  110. SEGACT MCHPOI
  111. MSOUPO = MCHPOI.IPCHP(1)
  112. SEGACT MSOUPO
  113. ICEN = MSOUPO.IGEOC
  114. SEGDES MSOUPO
  115. SEGDES MCHPOI
  116. C
  117. C**** Control du CHPOINT: QUEPOI
  118. C
  119. INDIC = 1
  120. NBCOMP = 1
  121. MOT(1) = 'SCAL'
  122. CALL QUEPOI(IRO, ICEN, INDIC, NBCOMP, MOT)
  123. IF(IERR .NE. 0) GOTO 9999
  124. C
  125. C**** Lecture du CHPOINT DEBIT.
  126. C
  127. CALL LIROBJ('CHPOINT',IROVIT,1,IRET)
  128. IF (IERR.NE.0) GOTO 9999
  129. C
  130. C**** Control du CHPOINT
  131. C
  132. JGN = 4
  133. JGM = IDIM
  134. SEGINI MLMOTS
  135. MLMOTS.MOTS(1) = 'UX '
  136. MLMOTS.MOTS(2) = 'UY '
  137. IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UZ '
  138. CALL QUEPO1(IROVIT, ICEN, MLMOTS)
  139. IF(IERR .NE. 0) GOTO 9999
  140. C
  141. C
  142. C**** Lecture du CHPOINT GRAVITE.
  143. C
  144. CALL LIROBJ('CHPOINT',IGRAV,1,IRET)
  145. IF (IERR.NE.0) GOTO 9999
  146. C
  147. C**** Control du CHPOINT
  148. C
  149. CALL QUEPO1(IGRAV, ICEN, MLMOTS)
  150. IF(IERR .NE. 0) GOTO 9999
  151. SEGSUP MLMOTS
  152. C
  153. C**** Results
  154. C
  155. IF(IMET.EQ.1)THEN
  156. C
  157. C******* On calcule le residu
  158. C
  159. IJAC=0
  160. CALL FIMVF2(ILIINC,ICEN,IRO,IROVIT,IGRAV,IRES)
  161. ELSE
  162. IRES=0
  163. CALL FIMVF3(ILIINC,ICEN,IGRAV,IJAC)
  164. ENDIF
  165. C
  166. IF(IRES .NE. 0) CALL ECROBJ('CHPOINT ',IRES)
  167. IF(IJAC .NE. 0) CALL ECROBJ('MATRIK ',IJAC)
  168. C
  169. 9999 CONTINUE
  170. RETURN
  171. END
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  

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