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
  79. POINTEUR IJACO.MATRIK
  80. *
  81. INTEGER IMPR,IRET
  82. *
  83. LOGICAL LCLIMT,LCLIMR,LCLIMY
  84. *
  85. INTEGER NTOTPO
  86. INTEGER NESP
  87. SEGMENT PROPHY
  88. CHARACTER*4 NOMESP(NESP+1)
  89. REAL*8 CV(NESP+1)
  90. REAL*8 R(NESP+1)
  91. REAL*8 H0K(NESP+1)
  92. POINTEUR CDIFF(NESP+1).MCHPOI
  93. POINTEUR YK(NESP+1).MCHPOI
  94. POINTEUR GRADYK(NESP+1).MCHPOI
  95. POINTEUR CGRYK(NESP+1).MCHELM
  96. POINTEUR CLYK(NESP+1).MCHPOI
  97. ENDSEGMENT
  98. SEGMENT PROPH2
  99. POINTEUR MPDIFF(NESP+1).MPOVAL
  100. POINTEUR MPVALY(NESP+1).MPOVAL
  101. POINTEUR MPGRAD(NESP+1).MPOVAL
  102. LOGICAL LCLIM(NESP+1)
  103. POINTEUR KRCLIM(NESP+1).MLENTI
  104. ENDSEGMENT
  105. *
  106. INTEGER IESP
  107. *
  108. * Executable statements
  109. *
  110. IMPR=0
  111. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans zlap2a.eso'
  112. * Lecture des données et initialisations de tableaux de travail
  113. CALL LICHT2(IROC,MPROC,MELBID,IMPR,IRET)
  114. IF (IRET.NE.0) GOTO 9999
  115. CALL LICHT2(ITEMC,MPTEMC,MELBID,IMPR,IRET)
  116. IF (IRET.NE.0) GOTO 9999
  117. CALL LICHT2(ISURF,MPSURF,MELBID,IMPR,IRET)
  118. IF (IRET.NE.0) GOTO 9999
  119. CALL LICHT2(INORM,MPNORM,MELBID,IMPR,IRET)
  120. IF (IRET.NE.0) GOTO 9999
  121. CALL LICHT2(IVOLU,MPVOLU,MELBID,IMPR,IRET)
  122. IF (IRET.NE.0) GOTO 9999
  123. LCLIMT=(ITIMP.NE.0)
  124. LCLIMR=(IRIMP.NE.0)
  125. NTOTPO=nbpts
  126. IF (LCLIMT) THEN
  127. CALL LICHT2(ITIMP,MPTIMP,MLTIMP,IMPR,IRET)
  128. IF (IRET.NE.0) GOTO 9999
  129. * In KRIPME : SEGINI KRTIMP
  130. CALL KRIPME(MLTIMP,NTOTPO,KRTIMP,IMPR,IRET)
  131. IF (IRET.NE.0) GOTO 9999
  132. ENDIF
  133. IF (LCLIMR) THEN
  134. CALL LICHT2(IRIMP,MPRIMP,MLRIMP,IMPR,IRET)
  135. IF (IRET.NE.0) GOTO 9999
  136. * In KRIPME : SEGINI KRRIMP
  137. CALL KRIPME(MLRIMP,NTOTPO,KRRIMP,IMPR,IRET)
  138. IF (IRET.NE.0) GOTO 9999
  139. ENDIF
  140. * Repérage dans les faces, les centres
  141. * In KRIPME : SEGINI KRFACE
  142. CALL KRIPME(MELEMF,NTOTPO,KRFACE,IMPR,IRET)
  143. IF (IRET.NE.0) GOTO 9999
  144. * In KRIPME : SEGINI KRCENT
  145. CALL KRIPME(MELEMC,NTOTPO,KRCENT,IMPR,IRET)
  146. IF (IRET.NE.0) GOTO 9999
  147. SEGACT PROPHY
  148. NESP=PROPHY.CV(/1)-1
  149. SEGINI PROPH2
  150. DO IESP=1,NESP+1
  151. ICDIFF=PROPHY.CDIFF(IESP)
  152. CALL LICHT2(ICDIFF,MPCDIF,MELBID,IMPR,IRET)
  153. IF (IRET.NE.0) GOTO 9999
  154. PROPH2.MPDIFF(IESP)=MPCDIF
  155. IYKC=PROPHY.YK(IESP)
  156. CALL LICHT2(IYKC,MPYK,MELBID,IMPR,IRET)
  157. IF (IRET.NE.0) GOTO 9999
  158. PROPH2.MPVALY(IESP)=MPYK
  159. IGRYKF=PROPHY.GRADYK(IESP)
  160. CALL LICHT2(IGRYKF,MPGRYK,MELBID,IMPR,IRET)
  161. IF (IRET.NE.0) GOTO 9999
  162. PROPH2.MPGRAD(IESP)=MPGRYK
  163. IYIMP=PROPHY.CLYK(IESP)
  164. LCLIMY=(IYIMP.NE.0)
  165. PROPH2.LCLIM(IESP)=LCLIMY
  166. IF (LCLIMY) THEN
  167. CALL LICHT2(IYIMP,MPYIMP,MLYIMP,IMPR,IRET)
  168. IF (IRET.NE.0) GOTO 9999
  169. * In KRIPME : SEGINI KRYIMP
  170. CALL KRIPME(MLYIMP,NTOTPO,KRYIMP,IMPR,IRET)
  171. IF (IRET.NE.0) GOTO 9999
  172. PROPH2.KRCLIM(IESP)=KRYIMP
  173. ENDIF
  174. ENDDO
  175. SEGDES PROPH2
  176. SEGDES PROPHY
  177. * Calcul des contributions suivantes à la matrice jacobienne faisant
  178. * intervenir les coefficients pour le calcul des gradients de Yk
  179. * (contributions à (d Res_{\rho Yk} / d var)
  180. * var prenant successivement les valeurs :
  181. * \rho, \rho Yk )
  182. *
  183. CALL ZLAP2B(PROPHY,PROPH2,MPROC,
  184. $ MPVOLU,MPNORM,MPSURF,MELEFL,
  185. $ KRFACE,KRCENT,LCLIMR,KRRIMP,MPRIMP,
  186. $ NOMINC,
  187. $ IJACO,
  188. $ IMPR,IRET)
  189. IF (IRET.NE.0) GOTO 9999
  190. * Calcul des contributions suivantes à la matrice jacobienne faisant
  191. * intervenir les coefficients pour le calcul des gradients de Yk
  192. * (contributions à (d Res_{\rho e_t} / d var)
  193. * var prenant successivement les valeurs :
  194. * \rho, \rho Yk )
  195. *
  196. CALL ZLAP2C(PROPHY,PROPH2,MPROC,MPTEMC,
  197. $ MPVOLU,MPNORM,MPSURF,MELEFL,
  198. $ KRFACE,KRCENT,
  199. $ LCLIMR,KRRIMP,MPRIMP,
  200. $ LCLIMT,KRTIMP,MPTIMP,
  201. $ NOMINC,
  202. $ IJACO,
  203. $ IMPR,IRET)
  204. IF (IRET.NE.0) GOTO 9999
  205. *
  206. * Destruction des tableaux de travail
  207. *
  208. SEGACT PROPH2
  209. DO IESP=1,NESP+1
  210. LCLIMY=PROPH2.LCLIM(IESP)
  211. IF (LCLIMY) THEN
  212. KRYIMP=PROPH2.KRCLIM(IESP)
  213. SEGSUP KRYIMP
  214. ENDIF
  215. ENDDO
  216. SEGSUP PROPH2
  217. SEGSUP KRCENT
  218. SEGSUP KRFACE
  219. IF (LCLIMR) THEN
  220. SEGSUP KRRIMP
  221. ENDIF
  222. IF (LCLIMT) THEN
  223. SEGSUP KRTIMP
  224. ENDIF
  225. *
  226. * Normal termination
  227. *
  228. IRET=0
  229. RETURN
  230. *
  231. * Format handling
  232. *
  233. *
  234. * Error handling
  235. *
  236. 9999 CONTINUE
  237. IRET=1
  238. WRITE(IOIMP,*) 'An error was detected in subroutine zlap2a'
  239. CALL ERREUR(5)
  240. RETURN
  241. *
  242. * End of subroutine ZLAP2A
  243. *
  244. END
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  

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