Télécharger la plaquette Cast3M


fr en

Télécharger ylap2a.eso

Retour à la liste

Numérotation des lignes : 

ylap2a

  1. C YLAP2A    SOURCE    CB215821  20/11/25    13:44:13     10792          
  2.       SUBROUTINE YLAP2A(MU,KAPPA,CV,IROC,IVITC,ITEMC,
  3.      $     IGRVF,ICOGRV,ICOGRT,
  4.      $     IVIMP,ITOIM,ITIMP,IQIMP,
  5.      $     MELEMC,MELEMF,MELEFL,ISURF,INORM,IVOLU,NOMINC,
  6.      $     IJACO)
  7. C***********************************************************************
  8. C NOM         : YLAP2A
  9. C DESCRIPTION : Calcul de la matrice jacobienne du résidu du laplacien
  10. C               VF 3D.
  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          : YLAP2B |
  17. C                    YLAP2C | Calcul des contributions à la matrice
  18. C                    YLAP2D | jacobienne du résidu du laplacien VF 3D.
  19. C                    YLAP2E |
  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                      MELEMC (type MELEME) : maillage des centres des
  53. C                                             éléments.
  54. C                      MELEMF (type MELEME) : maillage des faces des
  55. C                                             éléments.
  56. C                      MELEFL (type MELEME) : connectivités face-(centre
  57. C                                             gauche, centre droit).
  58. C                      ISURF (type MCHPOI) : surface des faces.
  59. C                      INORM (type MCHPOI) : normale aux faces.
  60. C                      IVOLU (type MCHPOI) : volume des éléments.
  61. C                      NOMINC (type MLMOTS) : noms des inconnues.
  62. C ENTREES/SORTIES    : IJACO (type MATRIK) : matrice jacobienne du
  63. C                        résidu du laplacien VF 3D.
  64. C SORTIES            : -
  65. C***********************************************************************
  66. C VERSION    : v1, 28/08/2001, version initiale
  67. C HISTORIQUE : v1, 28/08/2001, création
  68. C HISTORIQUE :
  69. C HISTORIQUE :
  70. C***********************************************************************
  71. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  72. C en cas de modification de ce sous-programme afin de faciliter
  73. C la maintenance !
  74. C***********************************************************************
  75.       IMPLICIT INTEGER(I-N)
  76.  
  77. -INC PPARAM
  78. -INC CCOPTIO
  79. -INC SMCOORD
  80. -INC SMCHPOI
  81.       POINTEUR IROC.MCHPOI  ,IVITC.MCHPOI ,ITEMC.MCHPOI
  82.       POINTEUR IGRVF.MCHPOI
  83.       POINTEUR IVIMP.MCHPOI ,ITOIM.MCHPOI
  84.       POINTEUR ITIMP.MCHPOI ,IQIMP.MCHPOI
  85.       POINTEUR ISURF.MCHPOI ,INORM.MCHPOI ,IVOLU.MCHPOI
  86.       POINTEUR MPROC.MPOVAL ,MPVITC.MPOVAL,MPTEMC.MPOVAL
  87.       POINTEUR MPGRVF.MPOVAL
  88.       POINTEUR MPVIMP.MPOVAL,MPTOIM.MPOVAL
  89.       POINTEUR MPTIMP.MPOVAL,MPQIMP.MPOVAL
  90.       POINTEUR MPSURF.MPOVAL,MPNORM.MPOVAL,MPVOLU.MPOVAL
  91. -INC SMCHAML
  92.       POINTEUR ICOGRV.MCHELM,ICOGRT.MCHELM
  93. -INC SMELEME
  94.       POINTEUR MELEMC.MELEME,MELEMF.MELEME,MELEFL.MELEME
  95.       POINTEUR MELBID.MELEME
  96.       POINTEUR MLVIMP.MELEME,MLTOIM.MELEME
  97.       POINTEUR MLTIMP.MELEME,MLQIMP.MELEME
  98. -INC SMLENTI
  99.       POINTEUR KRVIMP.MLENTI,KRTOIM.MLENTI
  100.       POINTEUR KRTIMP.MLENTI,KRQIMP.MLENTI
  101.       POINTEUR KRCENT.MLENTI,KRFACE.MLENTI
  102. -INC SMLMOTS
  103.       POINTEUR NOMINC.MLMOTS
  105.       POINTEUR IJACO.MATRIK
  106. *
  107.       REAL*8 MU,KAPPA,CV
  108. *
  109.       INTEGER IMPR,IRET
  110. *
  111.       LOGICAL LCLIMV,LCLITO
  112.       LOGICAL LCLIMT,LCLIMQ
  113. *
  114.       INTEGER NTOTPO
  115. C
  116. *
  117. * Executable statements
  118. *
  119.       IMPR=0
  120.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans ylap2a.eso'
  121. * Initialisation de la matrice jacobienne à zéro
  122.       CALL ZERMAK(IJACO,IMPR,IRET)
  123.       IF (IRET.NE.0) GOTO 9999
  124. * Lecture des données et initialisations de tableaux de travail
  125.       CALL LICHT2(IROC,MPROC,MELBID,IMPR,IRET)
  126.       IF (IRET.NE.0) GOTO 9999
  127.       CALL LICHT2(IVITC,MPVITC,MELBID,IMPR,IRET)
  128.       IF (IRET.NE.0) GOTO 9999
  129.       CALL LICHT2(ITEMC,MPTEMC,MELBID,IMPR,IRET)
  130.       IF (IRET.NE.0) GOTO 9999
  131.       CALL LICHT2(IGRVF,MPGRVF,MELBID,IMPR,IRET)
  132.       IF (IRET.NE.0) GOTO 9999
  133.       CALL LICHT2(ISURF,MPSURF,MELBID,IMPR,IRET)
  134.       IF (IRET.NE.0) GOTO 9999
  135.       CALL LICHT2(INORM,MPNORM,MELBID,IMPR,IRET)
  136.       IF (IRET.NE.0) GOTO 9999
  137.       CALL LICHT2(IVOLU,MPVOLU,MELBID,IMPR,IRET)
  138.       IF (IRET.NE.0) GOTO 9999
  139.       LCLIMV=(IVIMP.NE.0)
  140.       LCLITO=(ITOIM.NE.0)
  141.       LCLIMT=(ITIMP.NE.0)
  142.       LCLIMQ=(IQIMP.NE.0)
  143.       NTOTPO=nbpts
  144.       IF (LCLIMV) THEN
  145.          CALL LICHT2(IVIMP,MPVIMP,MLVIMP,IMPR,IRET)
  146.          IF (IRET.NE.0) GOTO 9999
  147. *   In KRIPME : SEGINI KRVIMP
  148.          CALL KRIPME(MLVIMP,NTOTPO,KRVIMP,IMPR,IRET)
  149.          IF (IRET.NE.0) GOTO 9999
  150.       ENDIF
  151.       IF (LCLITO) THEN
  152.          CALL LICHT2(ITOIM,MPTOIM,MLTOIM,IMPR,IRET)
  153.          IF (IRET.NE.0) GOTO 9999
  154. *   In KRIPME : SEGINI KRTOIM
  155.          CALL KRIPME(MLTOIM,NTOTPO,KRTOIM,IMPR,IRET)
  156.          IF (IRET.NE.0) GOTO 9999
  157.       ENDIF
  158.       IF (LCLIMT) THEN
  159.          CALL LICHT2(ITIMP,MPTIMP,MLTIMP,IMPR,IRET)
  160.          IF (IRET.NE.0) GOTO 9999
  161. *   In KRIPME : SEGINI KRTIMP
  162.          CALL KRIPME(MLTIMP,NTOTPO,KRTIMP,IMPR,IRET)
  163.          IF (IRET.NE.0) GOTO 9999
  164.       ENDIF
  165.       IF (LCLIMQ) THEN
  166.          CALL LICHT2(IQIMP,MPQIMP,MLQIMP,IMPR,IRET)
  167.          IF (IRET.NE.0) GOTO 9999
  168. *   In KRIPME : SEGINI KRQIMP
  169.          CALL KRIPME(MLQIMP,NTOTPO,KRQIMP,IMPR,IRET)
  170.          IF (IRET.NE.0) GOTO 9999
  171.       ENDIF
  172. * Repérage dans les faces, les centres
  173. *   In KRIPME : SEGINI KRFACE
  174.       CALL KRIPME(MELEMF,NTOTPO,KRFACE,IMPR,IRET)
  175.       IF (IRET.NE.0) GOTO 9999
  176. *   In KRIPME : SEGINI KRCENT
  177.       CALL KRIPME(MELEMC,NTOTPO,KRCENT,IMPR,IRET)
  178.       IF (IRET.NE.0) GOTO 9999
  179. *
  180. * Note : on pourrait regrouper les subroutines suivantes en une
  181. *        seule pas trop longue, au prix d'un gros effort
  182. *        (voir aussi la NOTE: dans ylap2c)
  183. *
  184. * Calcul des contributions 'simples' à la matrice jacobienne faisant
  185. * intervenir les coefficients pour le calcul des gradients de vitesse
  186. * (ICOGRV)
  187. * (contributions à (d Res_{\rho u} / d var), (d Res_{\rho v} / d var)
  188. *  et  (d Res_{\rho w} / d var)
  189. *      var prenant successivement les valeurs :
  190. *      \rho,   \rho u,    \rho v,  \rho w,    \rho e_t )
  191. *
  192.       CALL YLAP2C(ICOGRV,MPROC,MPVITC,
  193.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  194.      $     KRFACE,KRCENT,LCLIMV,KRVIMP,LCLITO,KRTOIM,
  195.      $     NOMINC,
  196.      $     MU,
  197.      $     IJACO,
  198.      $     IMPR,IRET)
  199.       IF (IRET.NE.0) GOTO 9999
  200. *
  201. * Calcul des contributions 'compliquées' à la matrice jacobienne faisant
  202. * intervenir les coefficients pour le calcul des gradients de vitesse
  203. * (ICOGRV)
  204. * (contributions à (d Res_{\rho e_t} / d var)
  205. *      var prenant successivement les valeurs :
  206. *      \rho,   \rho u,    \rho v,  \rho w,   \rho e_t )
  207. * Les contributions sont plus "compliquées" à calculer que les
  208. * simples car on a à dériver des produits de fonctions de la vitesse
  209. * d (f(u,v) * g(u,v)) / d var = f dg/dv + df/dv g
  210. *
  211.       CALL YLAP2E(ICOGRV,MPGRVF,MPROC,MPVITC,
  212.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  213.      $     KRFACE,KRCENT,
  214.      $     LCLIMV,KRVIMP,MPVIMP,
  215.      $     LCLITO,KRTOIM,
  216.      $     NOMINC,
  217.      $     MU,
  218.      $     IJACO,
  219.      $     IMPR,IRET)
  220.       IF (IRET.NE.0) GOTO 9999
  221.       CALL YLAP2D(ICOGRV,MPGRVF,MPROC,MPVITC,
  222.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  223.      $     KRFACE,KRCENT,
  224.      $     LCLIMV,KRVIMP,
  225.      $     LCLITO,KRTOIM,MPTOIM,
  226.      $     NOMINC,
  227.      $     MU,
  228.      $     IJACO,
  229.      $     IMPR,IRET)
  230.       IF (IRET.NE.0) GOTO 9999
  231. *
  232. * Calcul des contributions à la matrice jacobienne faisant intervenir
  233. * les coefficients pour le calcul des gradients de température (ICOGRT)
  234. * (contributions à d Res_{\rho e_t} / d var
  235. *      var prenant successivement les valeurs :
  236. *      \rho,   \rho u,    \rho v,    \rho w,    \rho e_t )
  237. *
  238.       CALL YLAP2B(ICOGRT,MPROC,MPVITC,MPTEMC,
  239.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  240.      $     KRFACE,KRCENT,LCLIMT,KRTIMP,LCLIMQ,KRQIMP,
  241.      $     NOMINC,
  242.      $     KAPPA,CV,
  243.      $     IJACO,
  244.      $     IMPR,IRET)
  245.       IF (IRET.NE.0) GOTO 9999
  246. *
  247. * Destruction des tableaux de travail
  248. *
  249.       SEGSUP KRCENT
  250.       SEGSUP KRFACE
  251.       IF (LCLIMQ) THEN
  252.          SEGSUP KRQIMP
  253.       ENDIF
  254.       IF (LCLIMT) THEN
  255.          SEGSUP KRTIMP
  256.       ENDIF
  257.       IF (LCLITO) THEN
  258.          SEGSUP KRTOIM
  259.       ENDIF
  260.       IF (LCLIMV) THEN
  261.          SEGSUP KRVIMP
  262.       ENDIF
  263. *
  264. * Normal termination
  265. *
  266.       IRET=0
  267.       RETURN
  268. *
  269. * Format handling
  270. *
  271. *
  272. * Error handling
  273. *
  274.  9999 CONTINUE
  275.       IRET=1
  276.       WRITE(IOIMP,*) 'An error was detected in subroutine ylap2a'
  277.       CALL ERREUR(5)
  278.       RETURN
  279. *
  280. * End of subroutine YLAP2A
  281. *
  282.       END
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  

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