Télécharger ccgime.eso

Retour à la liste

Numérotation des lignes :

ccgime
  1. C CCGIME SOURCE PV 22/04/22 21:15:03 11344
  2. SUBROUTINE CCGIME(LCOF,NOMLOI,
  3. $ FC,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : CCGIME
  9. C DESCRIPTION : Lois de comportement aux points de Gauss :
  10. C Inverse de la métrique par rapport à un
  11. C élément de référence régulier.
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES :
  18. C APPELE PAR :
  19. C***********************************************************************
  20. C ENTREES :
  21. C ENTREES/SORTIES :
  22. C SORTIES : -
  23. C TRAVAIL :
  24. C***********************************************************************
  25. C VERSION : v1, 22/09/10, version initiale
  26. C HISTORIQUE : v1, 22/09/10, création
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC CCREEL
  37. -INC TNLIN
  38. *-INC SMCHAEL
  39. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
  40. POINTEUR FC.MCHEVA
  41. POINTEUR LCOF.LCHEVA
  42. POINTEUR JMAJAC.MCHEVA
  43. POINTEUR JMIJAC.MCHEVA
  44. POINTEUR JDTJAC.MCHEVA
  45. POINTEUR JMAREG.MCHEVA
  46. CHARACTER*8 NOMLOI
  47. INTEGER ICOF
  48. *
  49. -INC TMXMAT
  50. * Objets temporaires
  51. POINTEUR JAC.MXMAT,JT.MXMAT,MJT.MXMAT
  52. POINTEUR G.MXMAT,IG.MXMAT,H.MXMAT,HIG.MXMAT,IGHIG.MXMAT
  53. POINTEUR ME.MXMAT
  54. *
  55. SEGMENT MCOF
  56. POINTEUR COEF(IDIM,IDIM).MCHEVA
  57. ENDSEGMENT
  58. *
  59. LOGICAL LBID
  60. INTEGER LAXSP
  61. REAL*8 DEUPI,XR
  62. REAL*8 XL,XM
  63. DIMENSION DETG(1)
  64. *
  65. INTEGER IMPR,IRET
  66. *
  67. * Executable statements
  68. *
  69. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgime'
  70. C IF (.NOT.(IDIM.EQ.1)) THEN
  71. C WRITE(IOIMP,*) 'IDIM=',IDIM,' ?'
  72. C GOTO 9999
  73. C ENDIF
  74. NLFC=FC.WELCHE(/6)
  75. NPFC=FC.WELCHE(/5)
  76. ICOF=0
  77. *
  78. ICOF=ICOF+1
  79. JMAJAC=LCOF.LISCHE(ICOF)
  80. NLJA=JMAJAC.WELCHE(/6)
  81. NPJA=JMAJAC.WELCHE(/5)
  82. IREF=JMAJAC.WELCHE(/4)
  83. IREL=JMAJAC.WELCHE(/3)
  84. *
  85. IF (IREL.NE.IDIM) THEN
  86. WRITE(IOIMP,*) 'Erreur dims JMAJAC'
  87. GOTO 9999
  88. ENDIF
  89. *
  90. ICOF=ICOF+1
  91. ICOF=ICOF+1
  92. ICOF=ICOF+1
  93. JMAREG=LCOF.LISCHE(ICOF)
  94. NLJR=JMAREG.WELCHE(/6)
  95. NPJR=JMAREG.WELCHE(/5)
  96. I1 =JMAREG.WELCHE(/4)
  97. I2 =JMAREG.WELCHE(/3)
  98. IF ((NLJR.NE.1).OR.(NPJR.NE.1).OR.(I1.NE.IREF).OR.(I2.NE.IREF))
  99. $ THEN
  100. WRITE(IOIMP,*) 'Erreur dims JMAREG'
  101. GOTO 9999
  102. ENDIF
  103. *
  104. * Objets temporaires et à préconditionner
  105. *
  106. LDIM1=IREL
  107. LDIM2=IREF
  108. SEGINI,JAC
  109. LDIM1=IREF
  110. LDIM2=IREL
  111. SEGINI,JT
  112. SEGINI,MJT
  113. LDIM1=IREF
  114. LDIM2=IREF
  115. SEGINI,G
  116. SEGINI,IG
  117. SEGINI,H
  118. SEGINI,HIG
  119. SEGINI,IGHIG
  120. LDIM1=IREL
  121. LDIM2=IREL
  122. SEGINI,ME
  123. *
  124. * Calcul de la métrique des éléments réguliers
  125. *
  126. CALL MAMA(JMAREG.WELCHE,IREF,IREF,
  127. $ 'JTJ ',H.XMAT,IREF,IREF,
  128. $ IMPR,IRET)
  129. IF (IRET.NE.0) GOTO 9999
  130. * SEGPRT,H
  131. *
  132. DO ILFC=1,NLFC
  133. IF (NLJA.EQ.1) THEN
  134. ILJA=1
  135. ELSE
  136. ILJA=ILFC
  137. ENDIF
  138. DO IPFC=1,NPFC
  139. IF (NPJA.EQ.1) THEN
  140. IPJA=1
  141. ELSE
  142. IPJA=IPFC
  143. ENDIF
  144. *
  145. * Copie du jacobien
  146. *
  147. CALL MAMA(JMAJAC.WELCHE(1,1,1,1,IPJA,ILJA),IREL,IREF,
  148. $ 'COPIE ',
  149. $ JAC.XMAT,IREL,IREF,
  150. $ IMPR,IRET)
  151. IF (IRET.NE.0) GOTO 9999
  152. * SEGPRT,JAC
  153. *
  154. * Calcul de la métrique ME = J (JtJ)-1 h (JtJ)-1 Jt = J M Jt
  155. *
  156. * Calcul de Jt
  157. CALL MAMA(JAC.XMAT,IREL,IREF,
  158. $ 'TRANSPOS',JT.XMAT,IREF,IREL,
  159. $ IMPR,IRET)
  160. IF (IRET.NE.0) GOTO 9999
  161. * SEGPRT,JT
  162. * Calcul de G=JtJ
  163. CALL MAMAMA(JT.XMAT,IREF,IREL,JAC.XMAT,IREL,IREF,
  164. $ 'FOIS ',G.XMAT,IREF,IREF,
  165. $ IMPR,IRET)
  166. IF (IRET.NE.0) GOTO 9999
  167. * SEGPRT,G
  168. * Calcul de l'inverse, du déterminant et trace de l'inverse de g
  169. LBID=.FALSE.
  170. CALL GEOLI2(IREF,1,1,G.XMAT,IG.XMAT,DETG,
  171. $ LBID,IMPR,IRET)
  172. IF (IRET.NE.0) GOTO 9999
  173. * SEGPRT,IG
  174. * Calcul de hg-1, de sa trace et de son déterminant
  175. CALL MAMAMA(H.XMAT,IREF,IREF,IG.XMAT,IREF,IREF,
  176. $ 'FOIS ',HIG.XMAT,IREF,IREF,IMPR,IRET)
  177. IF (IRET.NE.0) GOTO 9999
  178. CALL MAMAMA(IG.XMAT,IREF,IREF,HIG.XMAT,IREF,IREF,
  179. $ 'FOIS ',IGHIG.XMAT,IREF,IREF,IMPR,IRET)
  180. IF (IRET.NE.0) GOTO 9999
  181. CALL MAMAMA(IGHIG.XMAT,IREF,IREF,JT.XMAT,IREF,IREL,
  182. $ 'FOIS ',MJT.XMAT,IREF,IREL,IMPR,IRET)
  183. IF (IRET.NE.0) GOTO 9999
  184. CALL MAMAMA(JAC.XMAT,IREL,IREF,MJT.XMAT,IREF,IREL,
  185. $ 'FOIS ',ME.XMAT,IREL,IREL,IMPR,IRET)
  186. IF (IRET.NE.0) GOTO 9999
  187. *
  188. * Calcul des la métrique inverse de l'élément
  189. *
  190. IF (NOMLOI(1:4).EQ.'IMET') THEN
  191. CALL CH2INT(NOMLOI(5:5),IDIM1,IMPR,IRET)
  192. IF (IRET.NE.0) GOTO 9999
  193. CALL CH2INT(NOMLOI(6:6),IDIM2,IMPR,IRET)
  194. IF (IRET.NE.0) GOTO 9999
  195. CONTRI=ME.XMAT(IDIM1,IDIM2)
  196. * WRITE(IOIMP,*) 'CONTRI=',CONTRI
  197. ELSE
  198. WRITE(IOIMP,*) 'NOMLOI=',NOMLOI
  199. WRITE(IOIMP,*) 'Erreur grave'
  200. GOTO 9999
  201. ENDIF
  202. FC.WELCHE(1,1,1,1,IPFC,ILFC)=
  203. $ FC.WELCHE(1,1,1,1,IPFC,ILFC)+
  204. $ CONTRI
  205. ENDDO
  206. ENDDO
  207. SEGSUP,ME
  208. SEGSUP,IGHIG
  209. SEGSUP,HIG
  210. SEGSUP,H
  211. SEGSUP,IG
  212. SEGSUP,G
  213. SEGSUP,MJT
  214. SEGSUP,JT
  215. SEGSUP,JAC
  216. *
  217. * Normal termination
  218. *
  219. IRET=0
  220. RETURN
  221. *
  222. * Format handling
  223. *
  224. *
  225. * Error handling
  226. *
  227. 9999 CONTINUE
  228. IRET=1
  229. WRITE(IOIMP,*) 'An error was detected in subroutine ccgime'
  230. RETURN
  231. *
  232. * End of subroutine CCGIME
  233. *
  234. END
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  

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