Télécharger la plaquette Cast3M


fr en

Télécharger kfmm2.eso

Retour à la liste

Numérotation des lignes : 

kfmm2

  1. C KFMM2     SOURCE    OF166741  24/12/13    21:16:10     12097          
  2.       SUBROUTINE KFMM2(IRN,IGN,IRETN,IGAMN,
  3.      &     ICHPSU,ICHPVO,INORM,
  4.      &     MELEMC,MELEMF,MELEFE,
  5.      &     MELLIM,ICHLIM,
  6.      &     ICHRES)
  7. C************************************************************************
  8. C
  9. C PROJET            :  CASTEM 2000
  10. C
  11. C NOM               :  KFMM2
  12. C
  13. C DESCRIPTION       :  Voir KFMM
  14. C
  15. C                      Cas deux dimensions, gaz "calorically perfect"
  16. C
  17. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  18. C
  19. C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF
  20. C
  21. C************************************************************************
  22. C ENTREES
  23. C
  24. C
  25. C
  26. C  1) Pointeurs des CHPOINTs
  27. C
  28. C     IRN     : CHPOINT 'CENTRE' contenant la masse volumique
  29. C
  30. C     IGN     : CHPOINT 'CENTRE' contenant la q.d.m.
  31. C
  32. C     IRETN   : CHPOINT 'CENTRE' contenant l'energie totale
  33. C
  34. C     IGAMN   : CHPOINT 'CENTRE' contenant le gamma
  35. C
  36. C     ICHLIM  : CHPOINT conditions aux bords
  37. C
  38. C  3) Pointeurs de CHPOINTs de la table DOMAINE
  39. C
  40. C     ICHPSU  : CHPOINT "FACE" contenant la surface des faces
  41. C
  42. C     ICHPVO  : CHPOINT "CENTRE" contenant le volume
  43. C               de chaque element
  44. C
  45. C
  46. C  4) Pointeurs de MELEME de la table DOMAINE
  47. C
  48. C     MELEMC  : MELEME 'CENTRE' du SPG des CENTRES
  49. C
  50. C     MELEMF  : MELEME 'FACE' du SPG des FACES
  51. C
  52. C     MELEFE  : MELEME 'FACEL' du connectivité FACES -> ELEM
  53. C
  54. C     MELLIM  : MELEME SPG conditions aux bords
  55. C
  56. C SORTIES
  57. C
  58. C     ICHRES  : resultat
  59. C
  60. C************************************************************************
  61. C
  62. C HISTORIQUE (Anomalies et modifications éventuelles)
  63. C
  64. C HISTORIQUE : Avril 2002  : creation
  65. C              Janvier 2003: implementation de condition aux limites
  66. C
  67. C************************************************************************
  68. C
  69. C
  70. C N.B.: On suppose qu'on a déjà controllé RO, P > 0
  71. C                                         GAMMA \in (1,3)
  72. C                                         Y \in (0,1)
  73. C       Si non il faut le faire!!!
  74. C
  75. C************************************************************************
  76. C
  77.       IMPLICIT INTEGER(I-N)
  78.       INTEGER IRN,IGN,IRETN,IGAMN,ICHPSU,ICHPVO,INORM
  79.      &     ,MELEMC,MELEMF,MELEFE,ICHRES,ISPG1,ISPG2,NFAC
  80.      &     ,IGEOMF,IGEOMC, NGCEG, NGCED, NGCF, NLCF, NLCF1, NLCEG, NLCED
  81.      &     ,MELLIM,ICHLIM,NLLIM
  82.       REAL*8 ROG, RUXG, RUYG, UNG, RETG, GAMG, REC, PG, VOLG, UTG
  83.      &     , ROD, RUXD, RUYD, UND, RETD, GAMD, PD, VOLD, UTD
  84.      &     , CNX, CNY, CTX, CTY
  85.      &     , SURF, SIGMAF
  86.      &     , UXG, UYG, RHTG
  87.      &     , UXD, UYD, RHTD, COEF
  88.      &     ,FR, FRUX, FRUY, FRET
  89.  
  90.       CHARACTER*8 TYPE
  91. C
  92. C**** LES INCLUDES
  93. C
  94.  
  95. -INC PPARAM
  96. -INC CCOPTIO
  97. -INC SMCHPOI
  98.       POINTEUR MPOVSU.MPOVAL
  99.      &        , MPORES.MPOVAL, MPOVOL.MPOVAL
  100.      &       , MPRN.MPOVAL, MPGN.MPOVAL, MPRETN.MPOVAL, MPGAMN.MPOVAL
  101.      &       , MPNORM.MPOVAL, MPLIM.MPOVAL
  102. -INC SMELEME
  103. -INC SMLMOTS
  104. -INC SMLENTI
  105.       POINTEUR MLELIM.MLENTI
  106. C
  107. C**** Initialisation des MLENTI des conditions aux limites
  108. C
  109. C
  110.       CALL KRIPAD(MELLIM,MLELIM)
  111. C     SEGINI MLELIM
  112. C
  113. C**** Initialisation des MELEMEs
  114. C
  115. C     'CENTRE', 'FACEL'
  116. C
  117.       IPT2 = MELEFE
  118.       SEGACT IPT2
  119.       NFAC = IPT2.NUM(/2)
  120. C
  121. C**** KRIPAD pour la correspondance global/local de centre
  122. C
  123.       CALL KRIPAD(MELEMC,MLENT1)
  124. C
  125. C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
  126. C
  127. C     Si i est le numero global d'un noeud de ICEN,
  128. C     MLENT1.LECT(i) contient sa position, i.e.
  129. C
  130. C     I              = numero global du noeud centre
  131. C     MLENT1.LECT(i) = numero local du noeud centre
  132. C
  133. C     MLENT1 déjà activé, i.e.
  134. C
  135. C     SEGINI MLENT1
  136. C
  137. C
  138. C**** KRIPAD pour la correspondance global/local de 'FACE'
  139. C
  140.       CALL KRIPAD(MELEMF,MLENT2)
  141. C     SEGINI MLENT2
  142. C
  143. C**** CHPOINTs de la table DOMAINE
  144. C
  145.       CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  146.       CALL LICHT(ICHPVO,MPOVOL,TYPE,IGEOMC)
  147.       CALL LICHT(INORM,MPNORM,TYPE,IGEOMC)
  148. C
  149. C**** LICHT active les MPOVALs en *MOD
  150. C
  151. C     i.e.
  152. C
  153. C     SEGACT MPOVSU*MOD
  154. C     SEGACT MPOVOL*MOD
  155. C     SEGACT MPNORM*MOD
  156. C
  157.       CALL LICHT(ICHRES,MPORES,TYPE,IGEOMC)
  158. C     SEGACT MPORES*MOD
  159. C
  160. C
  161.       CALL LICHT(IRN,MPRN,TYPE,IGEOMC)
  162.       CALL LICHT(IGN,MPGN,TYPE,IGEOMC)
  163.       CALL LICHT(IRETN,MPRETN,TYPE,IGEOMC)
  164.       CALL LICHT(IGAMN,MPGAMN,TYPE,IGEOMC)
  165.       CALL LICHT(ICHLIM,MPLIM,TYPE,MELLIM)
  166. C
  167. C     SEGACT MPRN*MOD
  168. C     SEGACT MPGN*MOD
  169. C     SEGACT MPRETN*MOD
  170. C     SEGACT MPGAMN*MOD
  171. C     SEGACT MPLIM*MOD
  172. C
  173.       IF(IGEOMF .NE. MELEMF)THEN
  174.          WRITE(IOIMP,*) 'Anomalie dedans kfmm1.eso'
  175.          WRITE(IOIMP,*) 'Probleme de SPG'
  176. C        21 2
  177. C        Données incompatibles
  178.          CALL ERREUR(21)
  179.          GOTO 9999
  180.       ENDIF
  181.       IF(IGEOMC .NE. MELEMC)THEN
  182.          WRITE(IOIMP,*) 'Anomalie dedans kfmm1.eso'
  183.          WRITE(IOIMP,*) 'Probleme de SPG'
  184. C        21 2
  185. C        Données incompatibles
  186.          CALL ERREUR(21)
  187.          GOTO 9999
  188.       ENDIF
  189. C
  190. C
  191. C**** BOUCLE SUR FACEL pour le calcul du FLUX
  192. C
  193.       DO NLCF = 1, NFAC
  194. C
  195. C******* NLCF  = numero local du centre de facel
  196. C        NGCF  = numero global du centre de facel
  197. C        NLCF1 = numero local du centre de face
  198. C        NGCEG = numero global du centre ELT "gauche"
  199. C        NLCEG = numero local du centre ELT "gauche"
  200. C        NGCED = numero global du centre ELT "droite"
  201. C        NLCED = numero local du centre ELT "droite"
  202. C
  203.          NGCEG = IPT2.NUM(1,NLCF)
  204.          NGCED = IPT2.NUM(3,NLCF)
  205.          NGCF  = IPT2.NUM(2,NLCF)
  206.          NLCF1 = MLENT2.LECT(NGCF)
  207.          NLCEG = MLENT1.LECT(NGCEG)
  208.          NLCED = MLENT1.LECT(NGCED)
  209. C
  210. C******* NLCF != NLCF1 -> l'auteur (MOI) n'a rien compris.
  211. C
  212.          IF(NLCF .NE. NLCF1)THEN
  213.             WRITE(IOIMP,*) 'Anomalie dedans kfmm1.eso'
  214.             WRITE(IOIMP,*) 'Probleme de SPG'
  215. C           21 2
  216. C           Données incompatibles
  217.             CALL ERREUR(21)
  218.             GOTO 9999
  219.          ENDIF
  220. C
  221.          CNX = MPNORM.VPOCHA(NLCF,1)
  222.          CNY = MPNORM.VPOCHA(NLCF,2)
  223.          CTX = -1.0D0 * CNY
  224.          CTY = CNX
  225. C
  226. C
  227. C******* Recuperation des Etats "gauche" et "droite"
  228. C
  229.          ROG = MPRN.VPOCHA(NLCEG,1)
  230.          RUXG = MPGN.VPOCHA(NLCEG,1)
  231.          RUYG = MPGN.VPOCHA(NLCEG,2)
  232.          UXG = RUXG / ROG
  233.          UYG = RUYG / ROG
  234.          UNG = (UXG * CNX) + (UYG * CNY)
  235.          UTG = (UXG * CTX) + (UYG * CTY)
  236.          RETG = MPRETN.VPOCHA(NLCEG,1)
  237.          GAMG = MPGAMN.VPOCHA(NLCEG,1)
  238.          REC = 0.5D0 * ((RUXG * RUXG) + (RUYG*RUYG))
  239.          REC = REC / ROG
  240.          PG = (GAMG - 1.0D0) * (RETG - REC)
  241.          VOLG = MPOVOL.VPOCHA(NLCEG,1)
  242. C
  243.          IF(NLCEG .NE. NLCED)THEN
  244.             ROD = MPRN.VPOCHA(NLCED,1)
  245.             RUXD = MPGN.VPOCHA(NLCED,1)
  246.             RUYD = MPGN.VPOCHA(NLCED,2)
  247.             UXD = RUXD / ROD
  248.             UYD = RUYD / ROD
  249.             UND = (UXD * CNX) + (UYD * CNY)
  250.             RETD = MPRETN.VPOCHA(NLCED,1)
  251.             GAMD = MPGAMN.VPOCHA(NLCED,1)
  252.             REC = 0.5D0 * ((RUXD * RUXD) + (RUYD*RUYD))
  253.             REC = REC / ROD
  254.             PD = (GAMD - 1.0D0) * (RETD - REC)
  255.             VOLD = MPOVOL.VPOCHA(NLCED,1)
  256.          ELSE
  257. C           Murs au condition aux limite
  258.             NLLIM=MLELIM.LECT(NGCF)
  259.             IF(NLLIM .EQ.0)THEN
  260. C              Mur
  261.                ROD = ROG
  262.                UND = -1.0D0 * UNG
  263.                UTD = UTG
  264.                UXD = UND * CNX + UTD * CTX
  265.                UYD = UND * CNY + UTD * CTY
  266.                RUXD = UXD * ROD
  267.                RUYD = UYD * ROD
  268.                GAMD = GAMG
  269.                RETD = RETG
  270.                PD = PG
  271.                VOLD = VOLG
  272.             ELSE
  273. C              Boundary
  274.                ROD = MPLIM.VPOCHA(NLLIM,1)
  275.                UXD = MPLIM.VPOCHA(NLLIM,2)
  276.                UYD = MPLIM.VPOCHA(NLLIM,3)
  277.                PD = MPLIM.VPOCHA(NLLIM,4)
  278.                GAMD = GAMG
  279.                UND = (UXD * CNX) + (UYD * CNY)
  280.                RETD = ((1.0D0/(GAMD - 1.0D0))*PD)+
  281.      &         (0.5D0*ROD*((UXD*UXD)+(UYD*UYD)))
  282.                VOLD = VOLG
  283.             ENDIF
  284.          ENDIF
  285. C
  286.          RHTG=RETG+PG
  287.          RHTD=RETD+PD
  288. C
  289.          SURF   = MPOVSU.VPOCHA(NLCF,1)
  290.          SIGMAF = (0.5D0 * (GAMG + GAMD)) * (PG + PD) / (ROG + ROD)
  291.          SIGMAF = SIGMAF ** 0.5D0
  292.          SIGMAF = (0.5D0 * (ABS(UNG) + ABS(UND))) + SIGMAF
  293. C
  294.          FR=(ROG*UNG)+(ROD*UND)
  295.          FRUX=(ROG*UNG*UXG)+(ROD*UND*UXD)+((PG+PD)*CNX)
  296.          FRUY=(ROG*UNG*UYG)+(ROD*UND*UYD)+((PG+PD)*CNY)
  297.          FRET=(UNG*RHTG)+(UND*RHTD)
  298. C
  299.          COEF=SURF/(2.0D0*VOLG)
  300.          MPORES.VPOCHA(NLCEG,1) = MPORES.VPOCHA(NLCEG,1) +
  301.      &        (COEF * (FR -  (SIGMAF * ROD)))
  302.          MPORES.VPOCHA(NLCEG,2) = MPORES.VPOCHA(NLCEG,2) +
  303.      &        (COEF * (FRUX - (SIGMAF * ROD * UXD)))
  304.          MPORES.VPOCHA(NLCEG,3) = MPORES.VPOCHA(NLCEG,3) +
  305.      &        (COEF *  (FRUY - (SIGMAF * ROD * UYD)))
  306.          MPORES.VPOCHA(NLCEG,4) = MPORES.VPOCHA(NLCEG,4) +
  307.      &        (COEF *  (FRET - (SIGMAF * RETD)))
  308. C
  309.          IF(NLCEG .NE. NLCED)THEN
  310. C
  311. C********** Domain interieur
  312. C
  313.             COEF=SURF/(2.0D0*VOLD)
  314.             MPORES.VPOCHA(NLCED,1) = MPORES.VPOCHA(NLCED,1) -
  315.      &           (COEF * (FR +  (SIGMAF * ROG)))
  316.             MPORES.VPOCHA(NLCED,2) = MPORES.VPOCHA(NLCED,2) -
  317.      &           (COEF * (FRUX + (SIGMAF * ROG * UXG)))
  318.             MPORES.VPOCHA(NLCED,3) = MPORES.VPOCHA(NLCED,3) -
  319.      &           (COEF *  (FRUY + (SIGMAF * ROG * UYG)))
  320.             MPORES.VPOCHA(NLCED,4) = MPORES.VPOCHA(NLCED,4) -
  321.      &           (COEF *  (FRET + (SIGMAF * RETG)))
  322.          ENDIF
  323.       ENDDO
  324. C
  325.       SEGDES MPOVSU
  326.       SEGDES MPOVOL
  327.       SEGDES MPNORM
  328. C
  329.       SEGDES MPORES
  330. C
  331.       SEGDES MPRN
  332.       SEGDES MPRETN
  333.       SEGDES MPGN
  334.       SEGDES MPGAMN
  335. C
  336.       SEGSUP MLENT1
  337.       SEGSUP MLENT2
  338.       SEGDES IPT2
  339. C
  340.       SEGSUP MLELIM
  341.       IF(MPLIM .GT. 0) SEGDES MPLIM
  342. C
  343. C
  344.  9999 CONTINUE
  345. C
  346.       RETURN
  347.       END
  348. C
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361.  
  362.  
  363.  

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