Télécharger la plaquette Cast3M


fr en

Télécharger xlap2a.eso

Retour à la liste

Numérotation des lignes : 

xlap2a

  1. C XLAP2A    SOURCE    CB215821  20/11/25    13:43:17     10792          
  2.       SUBROUTINE XLAP2A(IMUC,IKAPC,ICVC,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         : XLAP2A
  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          : XLAP2B |
  17. C                    XLAP2C | Calcul des contributions à la matrice
  18. C                    XLAP2D | jacobienne du résidu du laplacien VF 3D.
  19. C                    XLAP2E |
  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       : ZLAP11 : Chapeau de l'opérateur Gibiane 'LAPN'
  27. C                             option 'VF'.
  28. C***********************************************************************
  29. C ENTREES            : IMUC  (type MCHPOI) : viscosité dynamique (SI).
  30. C                      IKAPC (type MCHPOI) : conductivité thermique (SI)
  31. C                      ICVC  (type MCHPOI) : 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, 01/03/2002, version initiale
  67. C HISTORIQUE : v1, 01/03/2002, 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 IMUC.MCHPOI  ,IKAPC.MCHPOI ,ICVC.MCHPOI
  82.       POINTEUR IROC.MCHPOI  ,IVITC.MCHPOI ,ITEMC.MCHPOI
  83.       POINTEUR IGRVF.MCHPOI
  84.       POINTEUR IVIMP.MCHPOI ,ITOIM.MCHPOI
  85.       POINTEUR ITIMP.MCHPOI ,IQIMP.MCHPOI
  86.       POINTEUR ISURF.MCHPOI ,INORM.MCHPOI ,IVOLU.MCHPOI
  87.       POINTEUR MPMUC.MPOVAL ,MPKAPC.MPOVAL,MPCVC.MCHPOI
  88.       POINTEUR MPROC.MPOVAL ,MPVITC.MPOVAL,MPTEMC.MPOVAL
  89.       POINTEUR MPGRVF.MPOVAL
  90.       POINTEUR MPVIMP.MPOVAL,MPTOIM.MPOVAL
  91.       POINTEUR MPTIMP.MPOVAL,MPQIMP.MPOVAL
  92.       POINTEUR MPSURF.MPOVAL,MPNORM.MPOVAL,MPVOLU.MPOVAL
  93. -INC SMCHAML
  94.       POINTEUR ICOGRV.MCHELM,ICOGRT.MCHELM
  95. -INC SMELEME
  96.       POINTEUR MELEMC.MELEME,MELEMF.MELEME,MELEFL.MELEME
  97.       POINTEUR MELBID.MELEME
  98.       POINTEUR MLVIMP.MELEME,MLTOIM.MELEME
  99.       POINTEUR MLTIMP.MELEME,MLQIMP.MELEME
  100. -INC SMLENTI
  101.       POINTEUR KRVIMP.MLENTI,KRTOIM.MLENTI
  102.       POINTEUR KRTIMP.MLENTI,KRQIMP.MLENTI
  103.       POINTEUR KRCENT.MLENTI,KRFACE.MLENTI
  104. -INC SMLMOTS
  105.       POINTEUR NOMINC.MLMOTS
  107.       POINTEUR IJACO.MATRIK
  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 xlap2a.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(IMUC,MPMUC,MELBID,IMPR,IRET)
  126.       IF (IRET.NE.0) GOTO 9999
  127.       CALL LICHT2(IKAPC,MPKAPC,MELBID,IMPR,IRET)
  128.       IF (IRET.NE.0) GOTO 9999
  129.       CALL LICHT2(ICVC,MPCVC,MELBID,IMPR,IRET)
  130.       IF (IRET.NE.0) GOTO 9999
  131.       CALL LICHT2(IROC,MPROC,MELBID,IMPR,IRET)
  132.       IF (IRET.NE.0) GOTO 9999
  133.       CALL LICHT2(IVITC,MPVITC,MELBID,IMPR,IRET)
  134.       IF (IRET.NE.0) GOTO 9999
  135.       CALL LICHT2(ITEMC,MPTEMC,MELBID,IMPR,IRET)
  136.       IF (IRET.NE.0) GOTO 9999
  137.       CALL LICHT2(IGRVF,MPGRVF,MELBID,IMPR,IRET)
  138.       IF (IRET.NE.0) GOTO 9999
  139.       CALL LICHT2(ISURF,MPSURF,MELBID,IMPR,IRET)
  140.       IF (IRET.NE.0) GOTO 9999
  141.       CALL LICHT2(INORM,MPNORM,MELBID,IMPR,IRET)
  142.       IF (IRET.NE.0) GOTO 9999
  143.       CALL LICHT2(IVOLU,MPVOLU,MELBID,IMPR,IRET)
  144.       IF (IRET.NE.0) GOTO 9999
  145.       LCLIMV=(IVIMP.NE.0)
  146.       LCLITO=(ITOIM.NE.0)
  147.       LCLIMT=(ITIMP.NE.0)
  148.       LCLIMQ=(IQIMP.NE.0)
  149.       NTOTPO=nbpts
  150.       IF (LCLIMV) THEN
  151.          CALL LICHT2(IVIMP,MPVIMP,MLVIMP,IMPR,IRET)
  152.          IF (IRET.NE.0) GOTO 9999
  153. *   In KRIPME : SEGINI KRVIMP
  154.          CALL KRIPME(MLVIMP,NTOTPO,KRVIMP,IMPR,IRET)
  155.          IF (IRET.NE.0) GOTO 9999
  156.       ENDIF
  157.       IF (LCLITO) THEN
  158.          CALL LICHT2(ITOIM,MPTOIM,MLTOIM,IMPR,IRET)
  159.          IF (IRET.NE.0) GOTO 9999
  160. *   In KRIPME : SEGINI KRTOIM
  161.          CALL KRIPME(MLTOIM,NTOTPO,KRTOIM,IMPR,IRET)
  162.          IF (IRET.NE.0) GOTO 9999
  163.       ENDIF
  164.       IF (LCLIMT) THEN
  165.          CALL LICHT2(ITIMP,MPTIMP,MLTIMP,IMPR,IRET)
  166.          IF (IRET.NE.0) GOTO 9999
  167. *   In KRIPME : SEGINI KRTIMP
  168.          CALL KRIPME(MLTIMP,NTOTPO,KRTIMP,IMPR,IRET)
  169.          IF (IRET.NE.0) GOTO 9999
  170.       ENDIF
  171.       IF (LCLIMQ) THEN
  172.          CALL LICHT2(IQIMP,MPQIMP,MLQIMP,IMPR,IRET)
  173.          IF (IRET.NE.0) GOTO 9999
  174. *   In KRIPME : SEGINI KRQIMP
  175.          CALL KRIPME(MLQIMP,NTOTPO,KRQIMP,IMPR,IRET)
  176.          IF (IRET.NE.0) GOTO 9999
  177.       ENDIF
  178. * Repérage dans les faces, les centres
  179. *   In KRIPME : SEGINI KRFACE
  180.       CALL KRIPME(MELEMF,NTOTPO,KRFACE,IMPR,IRET)
  181.       IF (IRET.NE.0) GOTO 9999
  182. *   In KRIPME : SEGINI KRCENT
  183.       CALL KRIPME(MELEMC,NTOTPO,KRCENT,IMPR,IRET)
  184.       IF (IRET.NE.0) GOTO 9999
  185. *
  186. * Note : on pourrait regrouper les subroutines suivantes en une
  187. *        seule pas trop longue, au prix d'un gros effort
  188. *        (voir aussi la NOTE: dans xlap2c)
  189. *
  190. * Calcul des contributions 'simples' à la matrice jacobienne faisant
  191. * intervenir les coefficients pour le calcul des gradients de vitesse
  192. * (ICOGRV)
  193. * (contributions à (d Res_{\rho u} / d var) et (d Res_{\rho v} / d var)
  194. *               et (d Res_{\rho w} / d var)
  195. *      var prenant successivement les valeurs :
  196. *      \rho,   \rho u,    \rho v,  \rho w   \rho e_t )
  197. *
  198.       CALL XLAP2C(ICOGRV,MPROC,MPVITC,
  199.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  200.      $     KRFACE,KRCENT,LCLIMV,KRVIMP,LCLITO,KRTOIM,
  201.      $     NOMINC,
  202.      $     MPMUC,
  203.      $     IJACO,
  204.      $     IMPR,IRET)
  205.       IF (IRET.NE.0) GOTO 9999
  206. *
  207. * Calcul des contributions 'compliquées' à la matrice jacobienne faisant
  208. * intervenir les coefficients pour le calcul des gradients de vitesse
  209. * (ICOGRV)
  210. * (contributions à (d Res_{\rho e_t} / d var)
  211. *      var prenant successivement les valeurs :
  212. *      \rho,   \rho u,    \rho v,  \rho w,   \rho e_t )
  213. * Les contributions sont plus "compliquées" à calculer que les
  214. * simples car on a à dériver des produits de fonctions de la vitesse
  215. * d (f(u,v) * g(u,v)) / d var = f dg/dv + df/dv g
  216. *
  217.       CALL XLAP2E(ICOGRV,MPGRVF,MPROC,MPVITC,
  218.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  219.      $     KRFACE,KRCENT,
  220.      $     LCLIMV,KRVIMP,MPVIMP,
  221.      $     LCLITO,KRTOIM,
  222.      $     NOMINC,
  223.      $     MPMUC,
  224.      $     IJACO,
  225.      $     IMPR,IRET)
  226.       IF (IRET.NE.0) GOTO 9999
  227.       CALL XLAP2D(ICOGRV,MPGRVF,MPROC,MPVITC,
  228.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  229.      $     KRFACE,KRCENT,
  230.      $     LCLIMV,KRVIMP,
  231.      $     LCLITO,KRTOIM,MPTOIM,
  232.      $     NOMINC,
  233.      $     MPMUC,
  234.      $     IJACO,
  235.      $     IMPR,IRET)
  236.       IF (IRET.NE.0) GOTO 9999
  237. *
  238. * Calcul des contributions à la matrice jacobienne faisant intervenir
  239. * les coefficients pour le calcul des gradients de température (ICOGRT)
  240. * (contributions à d Res_{\rho e_t} / d var
  241. *      var prenant successivement les valeurs :
  242. *      \rho,   \rho u,    \rho v,     \rho w,     \rho e_t )
  243. *
  244.       CALL XLAP2B(ICOGRT,MPROC,MPVITC,MPTEMC,
  245.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  246.      $     KRFACE,KRCENT,LCLIMT,KRTIMP,LCLIMQ,KRQIMP,
  247.      $     NOMINC,
  248.      $     MPKAPC,MPCVC,
  249.      $     IJACO,
  250.      $     IMPR,IRET)
  251.       IF (IRET.NE.0) GOTO 9999
  252. *
  253. * Destruction des tableaux de travail
  254. *
  255.       SEGSUP KRCENT
  256.       SEGSUP KRFACE
  257.       IF (LCLIMQ) THEN
  258.          SEGSUP KRQIMP
  259.       ENDIF
  260.       IF (LCLIMT) THEN
  261.          SEGSUP KRTIMP
  262.       ENDIF
  263.       IF (LCLITO) THEN
  264.          SEGSUP KRTOIM
  265.       ENDIF
  266.       IF (LCLIMV) THEN
  267.          SEGSUP KRVIMP
  268.       ENDIF
  269. *
  270. * Normal termination
  271. *
  272.       IRET=0
  273.       RETURN
  274. *
  275. * Format handling
  276. *
  277. *
  278. * Error handling
  279. *
  280.  9999 CONTINUE
  281.       IRET=1
  282.       WRITE(IOIMP,*) 'An error was detected in subroutine xlap2a'
  283.       CALL ERREUR(5)
  284.       RETURN
  285. *
  286. * End of subroutine XLAP2A
  287. *
  288.       END
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  

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