Télécharger la plaquette Cast3M


fr en

Télécharger xlap1a.eso

Retour à la liste

Numérotation des lignes : 

xlap1a

  1. C XLAP1A    SOURCE    CB215821  20/11/25    13:43:10     10792          
  2.       SUBROUTINE XLAP1A(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         : XLAP1A
  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          : XLAP1B |
  17. C                    XLAP1C | Calcul des contributions à la matrice
  18. C                    XLAP1D | jacobienne du résidu du laplacien VF 2D.
  19. C                    XLAP1E |
  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 2D.
  64. C SORTIES            : -
  65. C***********************************************************************
  66. C VERSION    : v1, 01/01/2002, version initiale
  67. C HISTORIQUE : v1, 01/01/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 xlap1a.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 xlap1c)
  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. *      var prenant successivement les valeurs :
  195. *      \rho,   \rho u,    \rho v,     \rho e_t )
  196. *
  197.       CALL XLAP1C(ICOGRV,MPROC,MPVITC,
  198.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  199.      $     KRFACE,KRCENT,LCLIMV,KRVIMP,LCLITO,KRTOIM,
  200.      $     NOMINC,
  201.      $     MPMUC,
  202.      $     IJACO,
  203.      $     IMPR,IRET)
  204.       IF (IRET.NE.0) GOTO 9999
  205. *
  206. * Calcul des contributions 'compliquées' à la matrice jacobienne faisant
  207. * intervenir les coefficients pour le calcul des gradients de vitesse
  208. * (ICOGRV)
  209. * (contributions à (d Res_{\rho e_t} / d var)
  210. *      var prenant successivement les valeurs :
  211. *      \rho,   \rho u,    \rho v,     \rho e_t )
  212. * Les contributions sont plus "compliquées" à calculer que les
  213. * simples car on a à dériver des produits de fonctions de la vitesse
  214. * d (f(u,v) * g(u,v)) / d var = f dg/dv + df/dv g
  215. *
  216.       CALL XLAP1E(ICOGRV,MPGRVF,MPROC,MPVITC,
  217.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  218.      $     KRFACE,KRCENT,
  219.      $     LCLIMV,KRVIMP,MPVIMP,
  220.      $     LCLITO,KRTOIM,
  221.      $     NOMINC,
  222.      $     MPMUC,
  223.      $     IJACO,
  224.      $     IMPR,IRET)
  225.       IF (IRET.NE.0) GOTO 9999
  226.       CALL XLAP1D(ICOGRV,MPGRVF,MPROC,MPVITC,
  227.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  228.      $     KRFACE,KRCENT,
  229.      $     LCLIMV,KRVIMP,
  230.      $     LCLITO,KRTOIM,MPTOIM,
  231.      $     NOMINC,
  232.      $     MPMUC,
  233.      $     IJACO,
  234.      $     IMPR,IRET)
  235.       IF (IRET.NE.0) GOTO 9999
  236. *
  237. * Calcul des contributions à la matrice jacobienne faisant intervenir
  238. * les coefficients pour le calcul des gradients de température (ICOGRT)
  239. * (contributions à d Res_{\rho e_t} / d var
  240. *      var prenant successivement les valeurs :
  241. *      \rho,   \rho u,    \rho v,     \rho e_t )
  242. *
  243.       CALL XLAP1B(ICOGRT,MPROC,MPVITC,MPTEMC,
  244.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  245.      $     KRFACE,KRCENT,LCLIMT,KRTIMP,LCLIMQ,KRQIMP,
  246.      $     NOMINC,
  247.      $     MPKAPC,MPCVC,
  248.      $     IJACO,
  249.      $     IMPR,IRET)
  250.       IF (IRET.NE.0) GOTO 9999
  251. *
  252. * Destruction des tableaux de travail
  253. *
  254.       SEGSUP KRCENT
  255.       SEGSUP KRFACE
  256.       IF (LCLIMQ) THEN
  257.          SEGSUP KRQIMP
  258.       ENDIF
  259.       IF (LCLIMT) THEN
  260.          SEGSUP KRTIMP
  261.       ENDIF
  262.       IF (LCLITO) THEN
  263.          SEGSUP KRTOIM
  264.       ENDIF
  265.       IF (LCLIMV) THEN
  266.          SEGSUP KRVIMP
  267.       ENDIF
  268. *
  269. * Normal termination
  270. *
  271.       IRET=0
  272.       RETURN
  273. *
  274. * Format handling
  275. *
  276. *
  277. * Error handling
  278. *
  279.  9999 CONTINUE
  280.       IRET=1
  281.       WRITE(IOIMP,*) 'An error was detected in subroutine xlap1a'
  282.       CALL ERREUR(5)
  283.       RETURN
  284. *
  285. * End of subroutine XLAP1A
  286. *
  287.       END
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  

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