Télécharger ccgime.eso

Retour à la liste

Numérotation des lignes :

  1. C CCGIME SOURCE GOUNAND 11/04/29 21:15:16 6947
  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. -INC CCOPTIO
  34. -INC CCREEL
  35. CBEGININCLUDE SMCHAEL
  36. SEGMENT MCHAEL
  37. POINTEUR IMACHE(N1).MELEME
  38. POINTEUR ICHEVA(N1).MCHEVA
  39. ENDSEGMENT
  40. SEGMENT MCHEVA
  41. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  42. ENDSEGMENT
  43. SEGMENT LCHEVA
  44. POINTEUR LISCHE(NBCHE).MCHEVA
  45. ENDSEGMENT
  46. CENDINCLUDE SMCHAEL
  47. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
  48. POINTEUR FC.MCHEVA
  49. POINTEUR LCOF.LCHEVA
  50. POINTEUR JMAJAC.MCHEVA
  51. POINTEUR JMIJAC.MCHEVA
  52. POINTEUR JDTJAC.MCHEVA
  53. POINTEUR JMAREG.MCHEVA
  54. CHARACTER*8 NOMLOI
  55. INTEGER ICOF
  56. *
  57. -INC TMXMAT
  58. * Objets temporaires
  59. POINTEUR JAC.MXMAT,JT.MXMAT,MJT.MXMAT
  60. POINTEUR G.MXMAT,IG.MXMAT,H.MXMAT,HIG.MXMAT,IGHIG.MXMAT
  61. POINTEUR ME.MXMAT
  62. *
  63. SEGMENT MCOF
  64. POINTEUR COEF(IDIM,IDIM).MCHEVA
  65. ENDSEGMENT
  66. *
  67. LOGICAL LBID
  68. INTEGER LAXSP
  69. REAL*8 DEUPI,XR
  70. REAL*8 XL,XM
  71. *
  72. INTEGER IMPR,IRET
  73. *
  74. * Executable statements
  75. *
  76. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgime'
  77. C IF (.NOT.(IDIM.EQ.1)) THEN
  78. C WRITE(IOIMP,*) 'IDIM=',IDIM,' ?'
  79. C GOTO 9999
  80. C ENDIF
  81. NLFC=FC.VELCHE(/6)
  82. NPFC=FC.VELCHE(/5)
  83. ICOF=0
  84. *
  85. ICOF=ICOF+1
  86. JMAJAC=LCOF.LISCHE(ICOF)
  87. NLJA=JMAJAC.VELCHE(/6)
  88. NPJA=JMAJAC.VELCHE(/5)
  89. IREF=JMAJAC.VELCHE(/4)
  90. IREL=JMAJAC.VELCHE(/3)
  91. *
  92. IF (IREL.NE.IDIM) THEN
  93. WRITE(IOIMP,*) 'Erreur dims JMAJAC'
  94. GOTO 9999
  95. ENDIF
  96. *
  97. ICOF=ICOF+1
  98. ICOF=ICOF+1
  99. ICOF=ICOF+1
  100. JMAREG=LCOF.LISCHE(ICOF)
  101. NLJR=JMAREG.VELCHE(/6)
  102. NPJR=JMAREG.VELCHE(/5)
  103. I1 =JMAREG.VELCHE(/4)
  104. I2 =JMAREG.VELCHE(/3)
  105. IF ((NLJR.NE.1).OR.(NPJR.NE.1).OR.(I1.NE.IREF).OR.(I2.NE.IREF))
  106. $ THEN
  107. WRITE(IOIMP,*) 'Erreur dims JMAREG'
  108. GOTO 9999
  109. ENDIF
  110. *
  111. * Objets temporaires et à préconditionner
  112. *
  113. LDIM1=IREL
  114. LDIM2=IREF
  115. SEGINI,JAC
  116. LDIM1=IREF
  117. LDIM2=IREL
  118. SEGINI,JT
  119. SEGINI,MJT
  120. LDIM1=IREF
  121. LDIM2=IREF
  122. SEGINI,G
  123. SEGINI,IG
  124. SEGINI,H
  125. SEGINI,HIG
  126. SEGINI,IGHIG
  127. LDIM1=IREL
  128. LDIM2=IREL
  129. SEGINI,ME
  130. *
  131. * Calcul de la métrique des éléments réguliers
  132. *
  133. CALL MAMA(JMAREG.VELCHE,IREF,IREF,
  134. $ 'JTJ ',H.XMAT,IREF,IREF,
  135. $ IMPR,IRET)
  136. IF (IRET.NE.0) GOTO 9999
  137. * SEGPRT,H
  138. *
  139. DO ILFC=1,NLFC
  140. IF (NLJA.EQ.1) THEN
  141. ILJA=1
  142. ELSE
  143. ILJA=ILFC
  144. ENDIF
  145. DO IPFC=1,NPFC
  146. IF (NPJA.EQ.1) THEN
  147. IPJA=1
  148. ELSE
  149. IPJA=IPFC
  150. ENDIF
  151. *
  152. * Copie du jacobien
  153. *
  154. CALL MAMA(JMAJAC.VELCHE(1,1,1,1,IPJA,ILJA),IREL,IREF,
  155. $ 'COPIE ',
  156. $ JAC.XMAT,IREL,IREF,
  157. $ IMPR,IRET)
  158. IF (IRET.NE.0) GOTO 9999
  159. * SEGPRT,JAC
  160. *
  161. * Calcul de la métrique ME = J (JtJ)-1 h (JtJ)-1 Jt = J M Jt
  162. *
  163. * Calcul de Jt
  164. CALL MAMA(JAC.XMAT,IREL,IREF,
  165. $ 'TRANSPOS',JT.XMAT,IREF,IREL,
  166. $ IMPR,IRET)
  167. IF (IRET.NE.0) GOTO 9999
  168. * SEGPRT,JT
  169. * Calcul de G=JtJ
  170. CALL MAMAMA(JT.XMAT,IREF,IREL,JAC.XMAT,IREL,IREF,
  171. $ 'FOIS ',G.XMAT,IREF,IREF,
  172. $ IMPR,IRET)
  173. IF (IRET.NE.0) GOTO 9999
  174. * SEGPRT,G
  175. * Calcul de l'inverse, du déterminant et trace de l'inverse de g
  176. LBID=.FALSE.
  177. CALL GEOLI2(IREF,1,1,G.XMAT,IG.XMAT,DETG,
  178. $ LBID,IMPR,IRET)
  179. IF (IRET.NE.0) GOTO 9999
  180. * SEGPRT,IG
  181. * Calcul de hg-1, de sa trace et de son déterminant
  182. CALL MAMAMA(H.XMAT,IREF,IREF,IG.XMAT,IREF,IREF,
  183. $ 'FOIS ',HIG.XMAT,IREF,IREF,IMPR,IRET)
  184. IF (IRET.NE.0) GOTO 9999
  185. CALL MAMAMA(IG.XMAT,IREF,IREF,HIG.XMAT,IREF,IREF,
  186. $ 'FOIS ',IGHIG.XMAT,IREF,IREF,IMPR,IRET)
  187. IF (IRET.NE.0) GOTO 9999
  188. CALL MAMAMA(IGHIG.XMAT,IREF,IREF,JT.XMAT,IREF,IREL,
  189. $ 'FOIS ',MJT.XMAT,IREF,IREL,IMPR,IRET)
  190. IF (IRET.NE.0) GOTO 9999
  191. CALL MAMAMA(JAC.XMAT,IREL,IREF,MJT.XMAT,IREF,IREL,
  192. $ 'FOIS ',ME.XMAT,IREL,IREL,IMPR,IRET)
  193. IF (IRET.NE.0) GOTO 9999
  194. *
  195. * Calcul des la métrique inverse de l'élément
  196. *
  197. IF (NOMLOI(1:4).EQ.'IMET') THEN
  198. CALL CH2INT(NOMLOI(5:5),IDIM1,IMPR,IRET)
  199. IF (IRET.NE.0) GOTO 9999
  200. CALL CH2INT(NOMLOI(6:6),IDIM2,IMPR,IRET)
  201. IF (IRET.NE.0) GOTO 9999
  202. CONTRI=ME.XMAT(IDIM1,IDIM2)
  203. * WRITE(IOIMP,*) 'CONTRI=',CONTRI
  204. ELSE
  205. WRITE(IOIMP,*) 'NOMLOI=',NOMLOI
  206. WRITE(IOIMP,*) 'Erreur grave'
  207. GOTO 9999
  208. ENDIF
  209. FC.VELCHE(1,1,1,1,IPFC,ILFC)=
  210. $ FC.VELCHE(1,1,1,1,IPFC,ILFC)+
  211. $ CONTRI
  212. ENDDO
  213. ENDDO
  214. SEGSUP,ME
  215. SEGSUP,IGHIG
  216. SEGSUP,HIG
  217. SEGSUP,H
  218. SEGSUP,IG
  219. SEGSUP,G
  220. SEGSUP,MJT
  221. SEGSUP,JT
  222. SEGSUP,JAC
  223. *
  224. * Normal termination
  225. *
  226. IRET=0
  227. RETURN
  228. *
  229. * Format handling
  230. *
  231. *
  232. * Error handling
  233. *
  234. 9999 CONTINUE
  235. IRET=1
  236. WRITE(IOIMP,*) 'An error was detected in subroutine ccgime'
  237. RETURN
  238. *
  239. * End of subroutine CCGIME
  240. *
  241. END
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  

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