Télécharger la plaquette Cast3M


fr en

Télécharger cli151.eso

Retour à la liste

Numérotation des lignes : 

cli151

  1. C CLI151    SOURCE    CB215821  20/11/25    13:20:09     10792          
  2.       SUBROUTINE CLI151(MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,ICHPSU,
  3.      &     IROC,IVITC,IPC,IGAMC,ICHLIM,ICHRES,ICHRLI)
  4. C************************************************************************
  5. C
  6. C PROJET            :  CASTEM 2000
  7. C
  8. C NOM               :  CLI151
  9. C
  10. C DESCRIPTION       :  Subroutine appellée par CLIM11
  11. C
  12. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  13. C
  14. C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
  15. C
  16. C************************************************************************
  17. C
  18. C APPELES (Calcul)  :
  19. C
  20. C************************************************************************
  21. C
  22. C HISTORIQUE (Anomalies et modifications éventuelles)
  23. C
  24. C HISTORIQUE :
  25. C
  26. C************************************************************************
  27. C
  28.       IMPLICIT INTEGER(I-N)
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMLMOTS
  33. -INC SMELEME
  34.       POINTEUR MELEFC.MELEME
  35. -INC SMLENTI
  36.       POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  37. -INC SMCHPOI
  38.       POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
  39.      &     MPVC.MPOVAL, MPPC.MPOVAL, MPGAMC.MPOVAL, MPLIM.MPOVAL,
  40.      &     MPRES.MPOVAL,  MPRLI.MPOVAL
  41. C
  42. C**** Variables de COOPTIO
  43. C
  44. C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  45. C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  46. C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  47. C     &        ,IECHO,   IIMPI,  IOSPI
  48. C     &        ,IDIM,    IFICLE, IPREFI
  49. C     &        ,MCOORD
  50. C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  51. C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  52. C     &        ,NORINC,NORVAL,NORIND,NORVAD
  53. C     &        ,NUCROU, IPSAUV
  54. C
  55.       INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
  56.      &     ,IGAMC,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC
  57.      &     ,NGF,NGC,NLF,NLC,NLCB
  58.       REAL*8 VOLU,SURF,GAMC,CNX,CNY,CNZ,CTX,CTY,CTZ,USGM1
  59.      &     ,CT2X,CT2Y,CT2Z,RC,PC,UXC,UYC,UZC,PF
  60.      &     ,UNC,UTC,UT2C,CELL(1),FLUX2D(4),FLUX3D(5),CELLT
  61.       CHARACTER*(8) TYPE
  62. C
  63. C
  64. C**** KRIPAD pour la correspondance global/local
  65. C
  66.       CALL KRIPAD(MELEMC,MLEMC)
  67. C     SEGINI MLEMC
  68.       CALL KRIPAD(MELECB,MLEMCB)
  69. C     SEGINI MLEMCB
  70.       CALL KRIPAD(MELEMF,MLEMF)
  71. C     SEGINI MLEMF
  72. C
  73. C**** CHPOINTs de la table DOMAINE
  74. C
  75.       CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  76.       CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  77.       CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  78. C
  79. C**** LICHT active les MPOVALs en *MOD
  80. C
  81. C     SEGACT MPNORM*MOD
  82. C     SEGACT MPOVSU*MOD
  83. C     SEGACT MPOVOL*MOD
  84. C
  85. C
  86. C**** CHPOINTs des variables
  87. C
  88.       CALL LICHT(IROC,MPRC,TYPE,ICEL)
  89.       CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  90.       CALL LICHT(IPC,MPPC,TYPE,ICEL)
  91.       CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL)
  92.       CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  93.       CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
  94.       CALL LICHT(ICHRLI,MPRLI,TYPE,ICEL)
  95. C
  96. C     SEGACT *MOD
  97. C     SEGACT *MOD
  98. C     SEGACT *MOD
  99. C     SEGACT *MOD
  100. C     SEGACT *MOD
  101. C     SEGACT *MOD
  102. C     SEGACT *MOD
  103. C
  104. C
  105. C**** Boucle sur le face pour le calcul des invariants de
  106. C     Riemann et du flux
  107. C
  108.       SEGACT MELEFC
  109.       NFAC=MELEFC.NUM(/2)
  110.       UZC=0.0D0
  111.       CNZ=0.0D0
  112.       CTZ=0.0D0
  113.       CT2X=0.0D0
  114.       CT2Y=0.0D0
  115.       CT2Z=0.0D0
  116.       DO IFAC=1,NFAC,1
  117.          NGF=MELEFC.NUM(1,IFAC)
  118.          NGC=MELEFC.NUM(2,IFAC)
  119.          NLF=MLEMF.LECT(NGF)
  120.          NLC=MLEMC.LECT(NGC)
  121.          NLCB=MLEMCB.LECT(NGF)
  122.          VOLU=MPVOL.VPOCHA(NLC,1)
  123.          SURF=MPSURF.VPOCHA(NLF,1)
  124. C        In CASTEM les normales sont sortantes
  125.          CNX=MPNORM.VPOCHA(NLF,1)
  126.          CNY=MPNORM.VPOCHA(NLF,2)
  127.          IF(IDIM.EQ.2)THEN
  128.             CTX=-1.0D0*CNY
  129.             CTY=CNX
  130.          ELSE
  131.             CNZ=MPNORM.VPOCHA(NLF,3)
  132.             CTX=MPNORM.VPOCHA(NLF,4)
  133.             CTY=MPNORM.VPOCHA(NLF,5)
  134.             CTZ=MPNORM.VPOCHA(NLF,6)
  135.             CT2X=MPNORM.VPOCHA(NLF,7)
  136.             CT2Y=MPNORM.VPOCHA(NLF,8)
  137.             CT2Z=MPNORM.VPOCHA(NLF,9)
  138.          ENDIF
  139.          GAMC=MPGAMC.VPOCHA(NLC,1)
  140.          USGM1=GAMC-1.0D0
  141.          USGM1=1.0D0/USGM1
  142. C        Variables au centre
  143.          RC=MPRC.VPOCHA(NLC,1)
  144.          UXC=MPVC.VPOCHA(NLC,1)
  145.          UYC=MPVC.VPOCHA(NLC,2)
  146.          IF(IDIM.EQ.3)UZC=MPVC.VPOCHA(NLC,3)
  147.          PC=MPPC.VPOCHA(NLC,1)
  148. C        Variables à la face
  149.          PF=MPLIM.VPOCHA(NLCB,1)
  150. C
  151. C******* On calcule UN, UT, UT2
  152. C
  153.          UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  154.          UTC=(UXC*CTX)+(UYC*CTY)+(UZC*CTZ)
  155.          UT2C=(UXC*CT2X)+(UYC*CT2Y)+(UZC*CT2Z)
  156. C
  157. C******* Densite, vitesse, pression sur le bord
  158. C
  159.          MPRLI.VPOCHA(NLCB,1)=RC
  160.          MPRLI.VPOCHA(NLCB,2)=UXC
  161.          MPRLI.VPOCHA(NLCB,3)=UYC
  162.          IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZC
  163.          MPRLI.VPOCHA(NLCB,IDIM+2)=PF
  164. C
  165. C******* Probleme de Riemann entre l'etat gauche
  166. C        RC,UNC,UTC,UT2C,PC et l'etat droite
  167. C        RC,UNC,UTC,UT2C,PF
  168. C        On utilise AUSM+
  169. C        Flux dans le repaire normale
  170. C
  171.          IF(IDIM.EQ.2)THEN
  172.             CALL FAUSMP(0,
  173.      &           GAMC,RC,PC,UNC,UTC,
  174.      &           GAMC,RC,PF,UNC,UTC,
  175.      &           CELL,CELL,
  176.      &           FLUX2D,
  177.      &           CELLT)
  178. C
  179. C******* Residuum (son SPG a le meme ordre que MELEFC)
  180. C
  181.             MPRES.VPOCHA(IFAC,1)=-1*FLUX2D(1)*SURF/VOLU
  182.             MPRES.VPOCHA(IFAC,2)=-1*((FLUX2D(2)*CNX)+(FLUX2D(3)*CTX))
  183.      &           *SURF/VOLU
  184.             MPRES.VPOCHA(IFAC,3)=-1*((FLUX2D(2)*CNY)+(FLUX2D(3)*CTY))
  185.      &           *SURF/VOLU
  186.             MPRES.VPOCHA(IFAC,4)=-1*FLUX2D(4)*SURF/VOLU
  187.          ELSE
  188.             CALL FAUSM3(0,
  189.      &           GAMC,RC,PC,UNC,UTC,UT2C,
  190.      &           GAMC,RC,PF,UNC,UTC,UT2C,
  191.      &           CELL,CELL,
  192.      &           FLUX3D,
  193.      &           CELLT)
  194. C
  195. C******* Residuum (son SPG a le meme ordre que MELEFC)
  196. C
  197.             MPRES.VPOCHA(IFAC,1)=-1*FLUX3D(1)*SURF/VOLU
  198.             MPRES.VPOCHA(IFAC,2)=-1*((FLUX3D(2)*CNX)+(FLUX3D(3)*CTX)+
  199.      &           (FLUX3D(4)*CT2X))*SURF/VOLU
  200.             MPRES.VPOCHA(IFAC,3)=-1*((FLUX3D(2)*CNY)+(FLUX3D(3)*CTY)+
  201.      &           (FLUX3D(4)*CT2Z))*SURF/VOLU
  202.             MPRES.VPOCHA(IFAC,4)=-1*((FLUX3D(2)*CNZ)+(FLUX3D(3)*CTZ)+
  203.      &           (FLUX3D(4)*CT2Z))*SURF/VOLU
  204.             MPRES.VPOCHA(IFAC,5)=-1*FLUX3D(5)*SURF/VOLU
  205.          ENDIF
  206.       ENDDO
  207. C
  208. C
  209.       SEGSUP MLEMC
  210.       SEGSUP MLEMCB
  211.       SEGSUP MLEMF
  212. C
  213.  9999 CONTINUE
  214.       END
  215.  
  216.  
  217.  
  218.  

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