Télécharger la plaquette Cast3M


fr en

Télécharger kfmm1.eso

Retour à la liste

Numérotation des lignes : 

kfmm1

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

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