Télécharger la plaquette Cast3M


fr en

Télécharger ylap1a.eso

Retour à la liste

Numérotation des lignes : 

ylap1a

  1. C YLAP1A    SOURCE    CB215821  20/11/25    13:44:04     10792          
  2.       SUBROUTINE YLAP1A(MU,KAPPA,CV,IROC,IVITC,ITEMC,
  3.      $     IGRVF,ICOGRV,ICOGRT,
  4.      $     IVIMP,ITOIM,ITIMP,IQIMP,IMIXT,ICLAU,
  5.      $     MELEMC,MELEMF,MELEFL,ISURF,INORM,IVOLU,NOMINC,
  6.      $     IJACO)
  7. C***********************************************************************
  8. C NOM         : YLAP1A
  9. C DESCRIPTION : Calcul de la matrice jacobienne du résidu du laplacien
  10. C               VF 2D.
  11. C
  12. C LANGAGE     : ESOPE
  13. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  14. C               mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES          : YLAP1B |
  17. C                    YLAP1C | Calcul des contributions à la matrice
  18. C                    YLAP1D | jacobienne du résidu du laplacien VF 2D.
  19. C                    YLAP1E |
  20. C APPELES (UTIL)   : LICHT2 : Lecture des pointeurs (maillages, valeurs)
  21. C                             d'un objet de type MCHPOI.
  22. C                    KRIPME : Création d'un tableau de repérage dans un
  23. C                             maillage de points.
  24. C                    ZERMAK : Création d'un objet de type MATRIK vide.
  25. C APPELES (STD)    : ERREUR : Gestion des erreurs par GIBI.
  26. C APPELE PAR       : YLAP11 : Chapeau de l'opérateur Gibiane 'LAPN'
  27. C                             option 'VF'.
  28. C***********************************************************************
  29. C ENTREES            : MU (type réel) : viscosité dynamique (SI).
  30. C                      KAPPA (type réel) : conductivité thermique (SI)
  31. C                      CV (type réel) : chaleur spécifique à volume
  32. C                                       constant (SI).
  33. C                      IROC (type MCHPOI) : masse volumique par élément.
  34. C                      IVITC (type MCHPOI) : vitesse par élément.
  35. C                      ITEMC (type MCHPOI) : température par élément.
  36. C                      IGRVF (type MCHPOI) : gradient de la vitesse
  37. C                                            aux interfaces.
  38. C                      ICOGRV (type MCHELM) : coefficients pour le
  39. C                        calcul du gradient de la vitesse aux
  40. C                        interfaces.
  41. C                      ICOGRT (type MCHELM) : coefficients pour le
  42. C                        calcul du gradient de la température aux
  43. C                        interfaces.
  44. C                      IVIMP (type MCHPOI) : CL de Dirichlet sur la
  45. C                                            vitesse.
  46. C                      ITOIM (type MCHPOI) : CL de Dirichlet sur le
  47. C                                            tenseur des contraintes.
  48. C                      ITIMP (type MCHPOI) : CL de Dirichlet sur la
  49. C                                            température.
  50. C                      IQIMP (type MCHPOI) : CL de Dirichlet sur le
  51. C                                            flux de chaleur.
  52. C                      IMIXT (type MCHPOI) : CL mixtes
  53. C                      ICLAU               : option pour ne calculer
  54. c                                            que la thermique
  55. C                      MELEMC (type MELEME) : maillage des centres des
  56. C                                             éléments.
  57. C                      MELEMF (type MELEME) : maillage des faces des
  58. C                                             éléments.
  59. C                      MELEFL (type MELEME) : connectivités face-(centre
  60. C                                             gauche, centre droit).
  61. C                      ISURF (type MCHPOI) : surface des faces.
  62. C                      INORM (type MCHPOI) : normale aux faces.
  63. C                      IVOLU (type MCHPOI) : volume des éléments.
  64. C                      NOMINC (type MLMOTS) : noms des inconnues.
  65. C ENTREES/SORTIES    : IJACO (type MATRIK) : matrice jacobienne du
  66. C                        résidu du laplacien VF 2D.
  67. C SORTIES            : -
  68. C***********************************************************************
  69. C VERSION    : v1, 01/08/2001, version initiale
  70. C HISTORIQUE : v1, 01/08/2001, création
  71. C HISTORIQUE : v2, 11/02/2003 Ajout de l'OPTION 'MIXT' pour la température
  72. C HISTORIQUE :
  73. C***********************************************************************
  74. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  75. C en cas de modification de ce sous-programme afin de faciliter
  76. C la maintenance !
  77. C***********************************************************************
  78.       IMPLICIT INTEGER(I-N)
  79.  
  80. -INC PPARAM
  81. -INC CCOPTIO
  82. -INC SMCOORD
  83. -INC SMCHPOI
  84.       POINTEUR IROC.MCHPOI  ,IVITC.MCHPOI ,ITEMC.MCHPOI
  85.       POINTEUR IGRVF.MCHPOI
  86.       POINTEUR IVIMP.MCHPOI ,ITOIM.MCHPOI
  87.       POINTEUR ITIMP.MCHPOI ,IQIMP.MCHPOI,IMIXT.MCHPOI
  88.       POINTEUR ISURF.MCHPOI ,INORM.MCHPOI ,IVOLU.MCHPOI
  89.       POINTEUR MPROC.MPOVAL ,MPVITC.MPOVAL,MPTEMC.MPOVAL
  90.       POINTEUR MPGRVF.MPOVAL
  91.       POINTEUR MPVIMP.MPOVAL,MPTOIM.MPOVAL
  92.       POINTEUR MPTIMP.MPOVAL,MPQIMP.MPOVAL,MPMIXT.MPOVAL
  93.       POINTEUR MPSURF.MPOVAL,MPNORM.MPOVAL,MPVOLU.MPOVAL
  94. -INC SMCHAML
  95.       POINTEUR ICOGRV.MCHELM,ICOGRT.MCHELM
  96. -INC SMELEME
  97.       POINTEUR MELEMC.MELEME,MELEMF.MELEME,MELEFL.MELEME
  98.       POINTEUR MELBID.MELEME
  99.       POINTEUR MLVIMP.MELEME,MLTOIM.MELEME
  100.       POINTEUR MLTIMP.MELEME,MLQIMP.MELEME,MLMIXT.MELEME
  101. -INC SMLENTI
  102.       POINTEUR KRVIMP.MLENTI,KRTOIM.MLENTI
  103.       POINTEUR KRTIMP.MLENTI,KRQIMP.MLENTI,KRMIXT.MLENTI
  104.       POINTEUR KRCENT.MLENTI,KRFACE.MLENTI
  105. -INC SMLMOTS
  106.       POINTEUR NOMINC.MLMOTS
  108.       POINTEUR IJACO.MATRIK
  109. *
  110.       REAL*8 MU,KAPPA,CV
  111. *
  112.       INTEGER IMPR,IRET,ICLAU
  113. *
  114.       LOGICAL LCLIMV,LCLITO
  115.       LOGICAL LCLIMT,LCLIMQ,LMIXT
  116. *
  117.       INTEGER NTOTPO
  118. C
  119. *
  120. * Executable statements
  121. *
  122.       IMPR=0
  123.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans ylap1a.eso'
  124. * Initialisation de la matrice jacobienne à zéro
  125.       CALL ZERMAK(IJACO,IMPR,IRET)
  126.       IF (IRET.NE.0) GOTO 9999
  127. * Lecture des données et initialisations de tableaux de travail
  128.       CALL LICHT2(IROC,MPROC,MELBID,IMPR,IRET)
  129.       IF (IRET.NE.0) GOTO 9999
  130.       CALL LICHT2(IVITC,MPVITC,MELBID,IMPR,IRET)
  131.       IF (IRET.NE.0) GOTO 9999
  132.       CALL LICHT2(ITEMC,MPTEMC,MELBID,IMPR,IRET)
  133.       IF (IRET.NE.0) GOTO 9999
  134.       CALL LICHT2(IGRVF,MPGRVF,MELBID,IMPR,IRET)
  135.       IF (IRET.NE.0) GOTO 9999
  136.       CALL LICHT2(ISURF,MPSURF,MELBID,IMPR,IRET)
  137.       IF (IRET.NE.0) GOTO 9999
  138.       CALL LICHT2(INORM,MPNORM,MELBID,IMPR,IRET)
  139.       IF (IRET.NE.0) GOTO 9999
  140.       CALL LICHT2(IVOLU,MPVOLU,MELBID,IMPR,IRET)
  141.       IF (IRET.NE.0) GOTO 9999
  142.       LCLIMV=(IVIMP.NE.0)
  143.       LCLITO=(ITOIM.NE.0)
  144.       LCLIMT=(ITIMP.NE.0)
  145.       LCLIMQ=(IQIMP.NE.0)
  146.       LMIXT=(IMIXT.NE.0)
  147.       NTOTPO=nbpts
  148.       IF (LCLIMV) THEN
  149.          CALL LICHT2(IVIMP,MPVIMP,MLVIMP,IMPR,IRET)
  150.          IF (IRET.NE.0) GOTO 9999
  151. *   In KRIPME : SEGINI KRVIMP
  152.          CALL KRIPME(MLVIMP,NTOTPO,KRVIMP,IMPR,IRET)
  153.          IF (IRET.NE.0) GOTO 9999
  154.       ENDIF
  155.       IF (LCLITO) THEN
  156.          CALL LICHT2(ITOIM,MPTOIM,MLTOIM,IMPR,IRET)
  157.          IF (IRET.NE.0) GOTO 9999
  158. *   In KRIPME : SEGINI KRTOIM
  159.          CALL KRIPME(MLTOIM,NTOTPO,KRTOIM,IMPR,IRET)
  160.          IF (IRET.NE.0) GOTO 9999
  161.       ENDIF
  162.       IF (LCLIMT) THEN
  163.          CALL LICHT2(ITIMP,MPTIMP,MLTIMP,IMPR,IRET)
  164.          IF (IRET.NE.0) GOTO 9999
  165. *   In KRIPME : SEGINI KRTIMP
  166.          CALL KRIPME(MLTIMP,NTOTPO,KRTIMP,IMPR,IRET)
  167.          IF (IRET.NE.0) GOTO 9999
  168.       ENDIF
  169.       IF (LCLIMQ) THEN
  170.          CALL LICHT2(IQIMP,MPQIMP,MLQIMP,IMPR,IRET)
  171.          IF (IRET.NE.0) GOTO 9999
  172. *   In KRIPME : SEGINI KRQIMP
  173.          CALL KRIPME(MLQIMP,NTOTPO,KRQIMP,IMPR,IRET)
  174.          IF (IRET.NE.0) GOTO 9999
  175.       ENDIF
  176. c ON EST ICI
  177.       IF (LMIXT) THEN
  178.          CALL LICHT2(IMIXT,MPMIXT,MLMIXT,IMPR,IRET)
  179.          IF (IRET.NE.0) GOTO 9999
  180. *   In KRIPME : SEGINI KRMIXT
  181.          CALL KRIPME(MLMIXT,NTOTPO,KRMIXT,IMPR,IRET)
  182.          IF (IRET.NE.0) GOTO 9999
  183.       ENDIF
  184. * Repérage dans les faces, les centres
  185. *   In KRIPME : SEGINI KRFACE
  186.       CALL KRIPME(MELEMF,NTOTPO,KRFACE,IMPR,IRET)
  187.       IF (IRET.NE.0) GOTO 9999
  188. *   In KRIPME : SEGINI KRCENT
  189.       CALL KRIPME(MELEMC,NTOTPO,KRCENT,IMPR,IRET)
  190.       IF (IRET.NE.0) GOTO 9999
  191. *
  192. * Note : on pourrait regrouper les subroutines suivantes en une
  193. *        seule pas trop longue, au prix d'un gros effort
  194. *        (voir aussi la NOTE: dans ylap1c)
  195. *
  196. * Calcul des contributions 'simples' à la matrice jacobienne faisant
  197. * intervenir les coefficients pour le calcul des gradients de vitesse
  198. * (ICOGRV)
  199. * (contributions à (d Res_{\rho u} / d var) et (d Res_{\rho v} / d var)
  200. *      var prenant successivement les valeurs :
  201. *      \rho,   \rho u,    \rho v,     \rho e_t )
  202. *
  203.       IF (ICLAU.EQ.0) THEN
  204.       CALL YLAP1C(ICOGRV,MPROC,MPVITC,
  205.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  206.      $     KRFACE,KRCENT,LCLIMV,KRVIMP,LCLITO,KRTOIM,
  207.      $     NOMINC,
  208.      $     MU,
  209.      $     IJACO,
  210.      $     IMPR,IRET)
  211.       IF (IRET.NE.0) GOTO 9999
  212.       ENDIF
  213. *
  214. * Calcul des contributions 'compliquées' à la matrice jacobienne faisant
  215. * intervenir les coefficients pour le calcul des gradients de vitesse
  216. * (ICOGRV)
  217. * (contributions à (d Res_{\rho e_t} / d var)
  218. *      var prenant successivement les valeurs :
  219. *      \rho,   \rho u,    \rho v,     \rho e_t )
  220. * Les contributions sont plus "compliquées" à calculer que les
  221. * simples car on a à dériver des produits de fonctions de la vitesse
  222. * d (f(u,v) * g(u,v)) / d var = f dg/dv + df/dv g
  223. *
  224.       IF (ICLAU.EQ.0) THEN
  225.       CALL YLAP1E(ICOGRV,MPGRVF,MPROC,MPVITC,
  226.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  227.      $     KRFACE,KRCENT,
  228.      $     LCLIMV,KRVIMP,MPVIMP,
  229.      $     LCLITO,KRTOIM,
  230.      $     NOMINC,
  231.      $     MU,
  232.      $     IJACO,
  233.      $     IMPR,IRET)
  234.       IF (IRET.NE.0) GOTO 9999
  235.       CALL YLAP1D(ICOGRV,MPGRVF,MPROC,MPVITC,
  236.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  237.      $     KRFACE,KRCENT,
  238.      $     LCLIMV,KRVIMP,
  239.      $     LCLITO,KRTOIM,MPTOIM,
  240.      $     NOMINC,
  241.      $     MU,
  242.      $     IJACO,
  243.      $     IMPR,IRET)
  244.       IF (IRET.NE.0) GOTO 9999
  245.       ENDIF
  246. *
  247. * Calcul des contributions à la matrice jacobienne faisant intervenir
  248. * les coefficients pour le calcul des gradients de température (ICOGRT)
  249. * (contributions à d Res_{\rho e_t} / d var
  250. *      var prenant successivement les valeurs :
  251. *      \rho,   \rho u,    \rho v,     \rho e_t )
  252. *
  253.       CALL YLAP1B(ICOGRT,MPROC,MPVITC,MPTEMC,
  254.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  255.      $     KRFACE,KRCENT,LCLIMT,KRTIMP,LCLIMQ,KRQIMP,
  256.      $     LMIXT,KRMIXT,
  257.      $     NOMINC,ICLAU,
  258.      $     KAPPA,CV,
  259.      $     IJACO,
  260.      $     IMPR,IRET)
  261.       IF (IRET.NE.0) GOTO 9999
  262. *
  263. * Destruction des tableaux de travail
  264. *
  265.       SEGSUP KRCENT
  266.       SEGSUP KRFACE
  267.       IF (LCLIMQ) THEN
  268.          SEGSUP KRQIMP
  269.       ENDIF
  270.       IF (LCLIMT) THEN
  271.          SEGSUP KRTIMP
  272.       ENDIF
  273.       IF (LMIXT) THEN
  274.          SEGSUP KRMIXT
  275.       ENDIF
  276.       IF (LCLITO) THEN
  277.          SEGSUP KRTOIM
  278.       ENDIF
  279.       IF (LCLIMV) THEN
  280.          SEGSUP KRVIMP
  281.       ENDIF
  282. *
  283. * Normal termination
  284. *
  285.       IRET=0
  286.       RETURN
  287. *
  288. * Format handling
  289. *
  290. *
  291. * Error handling
  292. *
  293.  9999 CONTINUE
  294.       IRET=1
  295.       WRITE(IOIMP,*) 'An error was detected in subroutine ylap1a'
  296.       CALL ERREUR(5)
  297.       RETURN
  298. *
  299. * End of subroutine YLAP1A
  300. *
  301.       END
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  

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