Télécharger la plaquette Cast3M


fr en

Télécharger zlap2a.eso

Retour à la liste

Numérotation des lignes : 

zlap2a

  1. C ZLAP2A    SOURCE    CB215821  20/11/25    13:45:08     10792          
  2.       SUBROUTINE ZLAP2A(PROPHY,IROC,ITEMC,
  3.      $     ITIMP,IRIMP,
  4.      $     MELEMC,MELEMF,MELEFL,ISURF,INORM,IVOLU,NOMINC,
  5.      $     IJACO)
  6. C***********************************************************************
  7. C NOM         : ZLAP2A
  8. C DESCRIPTION : Calcul de la matrice jacobienne du résidu du laplacien
  9. C               VF 3D (termes multi-espèces).
  10. C
  11. C LANGAGE     : ESOPE
  12. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  13. C               mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES          : ZLAP2B | Calcul des contributions à la matrice
  16. C                    ZLAP2C | jacobienne du résidu du laplacien VF 3D.
  17. C APPELES (UTIL)   : LICHT2 : Lecture des pointeurs (maillages, valeurs)
  18. C                             d'un objet de type MCHPOI.
  19. C                    KRIPME : Création d'un tableau de repérage dans un
  20. C                             maillage de points.
  21. C                    ZERMAK : Création d'un objet de type MATRIK vide.
  22. C APPELES (STD)    : ERREUR : Gestion des erreurs par GIBI.
  23. C APPELE PAR       : ZLAP11 : Chapeau de l'opérateur Gibiane 'LAPN'
  24. C                             option 'VF'.
  25. C***********************************************************************
  26. C ENTREES            : PROPHY (type PROPHY) : propriétés des espèces
  27. C                      IROC (type MCHPOI) : masse volumique par élément.
  28. C                      ITEMC (type MCHPOI) : température par élément.
  29. C                      ITIMP (type MCHPOI) : CL de Dirichlet sur la
  30. C                                            température.
  31. C                      IRIMP (type MCHPOI) : CL de Dirichlet sur la
  32. C                                            densité.
  33. C                      MELEMC (type MELEME) : maillage des centres des
  34. C                                             éléments.
  35. C                      MELEMF (type MELEME) : maillage des faces des
  36. C                                             éléments.
  37. C                      MELEFL (type MELEME) : connectivités face-(centre
  38. C                                             gauche, centre droit).
  39. C                      ISURF (type MCHPOI) : surface des faces.
  40. C                      INORM (type MCHPOI) : normale aux faces.
  41. C                      IVOLU (type MCHPOI) : volume des éléments.
  42. C                      NOMINC (type MLMOTS) : noms des inconnues.
  43. C ENTREES/SORTIES    : IJACO (type MATRIK) : matrice jacobienne du
  44. C                        résidu du laplacien VF 3D.
  45. C SORTIES            : -
  46. C***********************************************************************
  47. C VERSION    : v1, 08/03/2002, version initiale
  48. C HISTORIQUE : v1, 08/03/2002, création
  49. C HISTORIQUE :
  50. C HISTORIQUE :
  51. C***********************************************************************
  52. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  53. C en cas de modification de ce sous-programme afin de faciliter
  54. C la maintenance !
  55. C***********************************************************************
  56.       IMPLICIT INTEGER(I-N)
  57.  
  58. -INC PPARAM
  59. -INC CCOPTIO
  60. -INC SMCOORD
  61. -INC SMCHPOI
  62.       POINTEUR IROC.MCHPOI,ITEMC.MCHPOI
  63.       POINTEUR ICDIFF.MCHPOI,IYKC.MCHPOI,IGRYKF.MCHPOI
  64.       POINTEUR ITIMP.MCHPOI ,IRIMP.MCHPOI,IYIMP.MCHPOI
  65.       POINTEUR ISURF.MCHPOI ,INORM.MCHPOI ,IVOLU.MCHPOI
  66.       POINTEUR MPROC.MPOVAL ,MPTEMC.MPOVAL
  67.       POINTEUR MPCDIF.MPOVAL,MPYK.MPOVAL,MPGRYK.MPOVAL
  68.       POINTEUR MPTIMP.MPOVAL,MPRIMP.MPOVAL,MPYIMP.MPOVAL
  69.       POINTEUR MPSURF.MPOVAL,MPNORM.MPOVAL,MPVOLU.MPOVAL
  70. -INC SMELEME
  71.       POINTEUR MELEMC.MELEME,MELEMF.MELEME,MELEFL.MELEME
  72.       POINTEUR MELBID.MELEME
  73.       POINTEUR MLTIMP.MELEME,MLRIMP.MELEME,MLYIMP.MELEME
  74. -INC SMLENTI
  75.       POINTEUR KRTIMP.MLENTI,KRRIMP.MLENTI,KRYIMP.MLENTI
  76.       POINTEUR KRCENT.MLENTI,KRFACE.MLENTI
  77. -INC SMLMOTS
  78.       POINTEUR NOMINC.MLMOTS
  80.       POINTEUR IJACO.MATRIK
  81. *
  82.       INTEGER IMPR,IRET
  83. *
  84.       LOGICAL LCLIMT,LCLIMR,LCLIMY
  85. *
  86.       INTEGER NTOTPO
  87.       INTEGER NESP
  88.       SEGMENT PROPHY
  89.          CHARACTER*4 NOMESP(NESP+1)
  90.          REAL*8 CV(NESP+1)
  91.          REAL*8 R(NESP+1)
  92.          REAL*8 H0K(NESP+1)
  93.          POINTEUR CDIFF(NESP+1).MCHPOI
  94.          POINTEUR YK(NESP+1).MCHPOI
  95.          POINTEUR GRADYK(NESP+1).MCHPOI
  96.          POINTEUR CGRYK(NESP+1).MCHELM
  97.          POINTEUR CLYK(NESP+1).MCHPOI
  98.       ENDSEGMENT
  99.       SEGMENT PROPH2
  100.          POINTEUR MPDIFF(NESP+1).MPOVAL
  101.          POINTEUR MPVALY(NESP+1).MPOVAL
  102.          POINTEUR MPGRAD(NESP+1).MPOVAL
  103.          LOGICAL LCLIM(NESP+1)
  104.          POINTEUR KRCLIM(NESP+1).MLENTI
  105.       ENDSEGMENT
  106. *
  107.       INTEGER IESP
  108. *
  109. * Executable statements
  110. *
  111.       IMPR=0
  112.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans zlap2a.eso'
  113. * Lecture des données et initialisations de tableaux de travail
  114.       CALL LICHT2(IROC,MPROC,MELBID,IMPR,IRET)
  115.       IF (IRET.NE.0) GOTO 9999
  116.       CALL LICHT2(ITEMC,MPTEMC,MELBID,IMPR,IRET)
  117.       IF (IRET.NE.0) GOTO 9999
  118.       CALL LICHT2(ISURF,MPSURF,MELBID,IMPR,IRET)
  119.       IF (IRET.NE.0) GOTO 9999
  120.       CALL LICHT2(INORM,MPNORM,MELBID,IMPR,IRET)
  121.       IF (IRET.NE.0) GOTO 9999
  122.       CALL LICHT2(IVOLU,MPVOLU,MELBID,IMPR,IRET)
  123.       IF (IRET.NE.0) GOTO 9999
  124.       LCLIMT=(ITIMP.NE.0)
  125.       LCLIMR=(IRIMP.NE.0)
  126.       NTOTPO=nbpts
  127.       IF (LCLIMT) THEN
  128.          CALL LICHT2(ITIMP,MPTIMP,MLTIMP,IMPR,IRET)
  129.          IF (IRET.NE.0) GOTO 9999
  130. *   In KRIPME : SEGINI KRTIMP
  131.          CALL KRIPME(MLTIMP,NTOTPO,KRTIMP,IMPR,IRET)
  132.          IF (IRET.NE.0) GOTO 9999
  133.       ENDIF
  134.       IF (LCLIMR) THEN
  135.          CALL LICHT2(IRIMP,MPRIMP,MLRIMP,IMPR,IRET)
  136.          IF (IRET.NE.0) GOTO 9999
  137. *   In KRIPME : SEGINI KRRIMP
  138.          CALL KRIPME(MLRIMP,NTOTPO,KRRIMP,IMPR,IRET)
  139.          IF (IRET.NE.0) GOTO 9999
  140.       ENDIF
  141. * Repérage dans les faces, les centres
  142. *   In KRIPME : SEGINI KRFACE
  143.       CALL KRIPME(MELEMF,NTOTPO,KRFACE,IMPR,IRET)
  144.       IF (IRET.NE.0) GOTO 9999
  145. *   In KRIPME : SEGINI KRCENT
  146.       CALL KRIPME(MELEMC,NTOTPO,KRCENT,IMPR,IRET)
  147.       IF (IRET.NE.0) GOTO 9999
  148.       SEGACT PROPHY
  149.       NESP=PROPHY.CV(/1)-1
  150.       SEGINI PROPH2
  151.       DO IESP=1,NESP+1
  152.          ICDIFF=PROPHY.CDIFF(IESP)
  153.          CALL LICHT2(ICDIFF,MPCDIF,MELBID,IMPR,IRET)
  154.          IF (IRET.NE.0) GOTO 9999
  155.          PROPH2.MPDIFF(IESP)=MPCDIF
  156.          IYKC=PROPHY.YK(IESP)
  157.          CALL LICHT2(IYKC,MPYK,MELBID,IMPR,IRET)
  158.          IF (IRET.NE.0) GOTO 9999
  159.          PROPH2.MPVALY(IESP)=MPYK
  160.          IGRYKF=PROPHY.GRADYK(IESP)
  161.          CALL LICHT2(IGRYKF,MPGRYK,MELBID,IMPR,IRET)
  162.          IF (IRET.NE.0) GOTO 9999
  163.          PROPH2.MPGRAD(IESP)=MPGRYK
  164.          IYIMP=PROPHY.CLYK(IESP)
  165.          LCLIMY=(IYIMP.NE.0)
  166.          PROPH2.LCLIM(IESP)=LCLIMY
  167.          IF (LCLIMY) THEN
  168.             CALL LICHT2(IYIMP,MPYIMP,MLYIMP,IMPR,IRET)
  169.             IF (IRET.NE.0) GOTO 9999
  170. *   In KRIPME : SEGINI KRYIMP
  171.             CALL KRIPME(MLYIMP,NTOTPO,KRYIMP,IMPR,IRET)
  172.             IF (IRET.NE.0) GOTO 9999
  173.             PROPH2.KRCLIM(IESP)=KRYIMP
  174.          ENDIF
  175.       ENDDO
  176.       SEGDES PROPH2
  177.       SEGDES PROPHY
  178. * Calcul des contributions suivantes à la matrice jacobienne faisant
  179. * intervenir les coefficients pour le calcul des gradients de Yk
  180. * (contributions à (d Res_{\rho Yk} / d var)
  181. *      var prenant successivement les valeurs :
  182. *      \rho,    \rho Yk )
  183. *
  184.       CALL ZLAP2B(PROPHY,PROPH2,MPROC,
  185.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  186.      $     KRFACE,KRCENT,LCLIMR,KRRIMP,MPRIMP,
  187.      $     NOMINC,
  188.      $     IJACO,
  189.      $     IMPR,IRET)
  190.       IF (IRET.NE.0) GOTO 9999
  191. * Calcul des contributions suivantes à la matrice jacobienne faisant
  192. * intervenir les coefficients pour le calcul des gradients de Yk
  193. * (contributions à (d Res_{\rho e_t} / d var)
  194. *      var prenant successivement les valeurs :
  195. *      \rho,    \rho Yk )
  196. *
  197.       CALL ZLAP2C(PROPHY,PROPH2,MPROC,MPTEMC,
  198.      $     MPVOLU,MPNORM,MPSURF,MELEFL,
  199.      $     KRFACE,KRCENT,
  200.      $     LCLIMR,KRRIMP,MPRIMP,
  201.      $     LCLIMT,KRTIMP,MPTIMP,
  202.      $     NOMINC,
  203.      $     IJACO,
  204.      $     IMPR,IRET)
  205.       IF (IRET.NE.0) GOTO 9999
  206. *
  207. * Destruction des tableaux de travail
  208. *
  209.       SEGACT PROPH2
  210.       DO IESP=1,NESP+1
  211.          LCLIMY=PROPH2.LCLIM(IESP)
  212.          IF (LCLIMY) THEN
  213.             KRYIMP=PROPH2.KRCLIM(IESP)
  214.             SEGSUP KRYIMP
  215.          ENDIF
  216.       ENDDO
  217.       SEGSUP PROPH2
  218.       SEGSUP KRCENT
  219.       SEGSUP KRFACE
  220.       IF (LCLIMR) THEN
  221.          SEGSUP KRRIMP
  222.       ENDIF
  223.       IF (LCLIMT) THEN
  224.          SEGSUP KRTIMP
  225.       ENDIF
  226. *
  227. * Normal termination
  228. *
  229.       IRET=0
  230.       RETURN
  231. *
  232. * Format handling
  233. *
  234. *
  235. * Error handling
  236. *
  237.  9999 CONTINUE
  238.       IRET=1
  239.       WRITE(IOIMP,*) 'An error was detected in subroutine zlap2a'
  240.       CALL ERREUR(5)
  241.       RETURN
  242. *
  243. * End of subroutine ZLAP2A
  244. *
  245.       END
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  

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