Télécharger ccgtdi.eso

Retour à la liste

Numérotation des lignes :

  1. C CCGTDI SOURCE GOUNAND 07/07/05 21:15:15 5784
  2. SUBROUTINE CCGTDI(LCOF,
  3. $ FC,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : CCGTDI
  9. C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss :
  10. C Diamètre interne d'un élément suivant une direction donnée
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES :
  17. C APPELE PAR :
  18. C***********************************************************************
  19. C ENTREES :
  20. C ENTREES/SORTIES :
  21. C SORTIES : -
  22. C TRAVAIL :
  23. C***********************************************************************
  24. C VERSION : v1, 13/09/06, version initiale
  25. C HISTORIQUE : v1, 13/09/06, création
  26. C HISTORIQUE :
  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 PPARAM
  34. -INC CCOPTIO
  35. -INC CCREEL
  36. CBEGININCLUDE SMCHAEL
  37. SEGMENT MCHAEL
  38. POINTEUR IMACHE(N1).MELEME
  39. POINTEUR ICHEVA(N1).MCHEVA
  40. ENDSEGMENT
  41. SEGMENT MCHEVA
  42. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  43. ENDSEGMENT
  44. SEGMENT LCHEVA
  45. POINTEUR LISCHE(NBCHE).MCHEVA
  46. ENDSEGMENT
  47. CENDINCLUDE SMCHAEL
  48. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
  49. POINTEUR FC.MCHEVA
  50. POINTEUR LCOF.LCHEVA
  51. POINTEUR JMAJAC.MCHEVA
  52. POINTEUR JMIJAC.MCHEVA
  53. POINTEUR JDTJAC.MCHEVA
  54. POINTEUR JMAREG.MCHEVA
  55. POINTEUR JDIAMA.MCHEVA
  56. POINTEUR JPC.MCHEVA
  57. POINTEUR JVIT.MCHEVA
  58. CHARACTER*8 NOMLOI
  59. INTEGER ICOF
  60. *
  61. -INC TMXMAT
  62. POINTEUR A.MXMAT
  63. POINTEUR AP.MXMAT
  64. POINTEUR JMA.MXMAT
  65. POINTEUR KJMA.MXMAT
  66. POINTEUR JM1.MXMAT,J.MXMAT
  67. POINTEUR K.MXMAT
  68. *
  69. SEGMENT MVIT
  70. POINTEUR MVCOMP(IDIM).MCHEVA
  71. ENDSEGMENT
  72. *
  73. LOGICAL LREGP,LRELP
  74. INTEGER IMPR,IRET
  75. *
  76. * Executable statements
  77. *
  78. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgtdi'
  79. * XPETI=SQRT(XPETIT)
  80. NLFC=FC.VELCHE(/6)
  81. NPFC=FC.VELCHE(/5)
  82. ICOF=0
  83. *
  84. * Récupération des coefficients de la metrique
  85. *
  86. SEGINI MVIT
  87. DO IIDIM=1,IDIM
  88. ICOF=ICOF+1
  89. JVIT=LCOF.LISCHE(ICOF)
  90. IF (ICOF.EQ.1) THEN
  91. NLJV=JVIT.VELCHE(/6)
  92. NPJV=JVIT.VELCHE(/5)
  93. ELSE
  94. NLJV2=JVIT.VELCHE(/6)
  95. NPJV2=JVIT.VELCHE(/5)
  96. IF (NLJV2.NE.NLJV.OR.NPJV2.NE.NPJV) THEN
  97. WRITE(IOIMP,*) 'Erreur grave dims JVIT'
  98. GOTO 9999
  99. ENDIF
  100. ENDIF
  101. MVIT.MVCOMP(IIDIM)=JVIT
  102. ENDDO
  103. *
  104. ICOF=ICOF+1
  105. JMAJAC=LCOF.LISCHE(ICOF)
  106. C NLJA=JMAJAC.VELCHE(/6)
  107. C NPJA=JMAJAC.VELCHE(/5)
  108. IREF=JMAJAC.VELCHE(/4)
  109. IREL=JMAJAC.VELCHE(/3)
  110. *
  111. IF (IREL.NE.IDIM) THEN
  112. WRITE(IOIMP,*) 'Erreur dims JMAJAC'
  113. GOTO 9999
  114. ENDIF
  115. *
  116. ICOF=ICOF+1
  117. JMIJAC=LCOF.LISCHE(ICOF)
  118. IF (JMIJAC.EQ.0) THEN
  119. WRITE(IOIMP,*) 'Erreur JMIJAC=0'
  120. GOTO 9999
  121. ENDIF
  122. NLJI=JMIJAC.VELCHE(/6)
  123. NPJI=JMIJAC.VELCHE(/5)
  124. IREL2=JMIJAC.VELCHE(/4)
  125. IREF2=JMIJAC.VELCHE(/3)
  126. *
  127. IF (IREL2.NE.IREL.OR.IREF2.NE.IREF) THEN
  128. WRITE(IOIMP,*) 'Erreur dims JMIJAC'
  129. GOTO 9999
  130. ENDIF
  131. *
  132. ICOF=ICOF+1
  133. ICOF=ICOF+1
  134. JMAREG=LCOF.LISCHE(ICOF)
  135. NLJR=JMAREG.VELCHE(/6)
  136. NPJR=JMAREG.VELCHE(/5)
  137. I1 =JMAREG.VELCHE(/4)
  138. I2 =JMAREG.VELCHE(/3)
  139. IF ((NLJR.NE.1).OR.(NPJR.NE.1).OR.(I1.NE.IREF).OR.(I2.NE.IREF))
  140. $ THEN
  141. WRITE(IOIMP,*) 'Erreur dims JMAREG'
  142. GOTO 9999
  143. ENDIF
  144. ICOF=ICOF+1
  145. JDIAMA=LCOF.LISCHE(ICOF)
  146. NLJD=JDIAMA.VELCHE(/6)
  147. NPJD=JDIAMA.VELCHE(/5)
  148. I1 =JDIAMA.VELCHE(/4)
  149. I2 =JDIAMA.VELCHE(/3)
  150. IF ((NLJD.NE.1).OR.(NPJD.NE.1).OR.(I1.NE.1).OR.(I2.NE.1))
  151. $ THEN
  152. WRITE(IOIMP,*) 'Erreur dims JDIAMA'
  153. GOTO 9999
  154. ENDIF
  155. XDIAMA=JDIAMA.VELCHE(1,1,1,1,1,1)
  156. *
  157. * Objets temporaires
  158. *
  159. LDIM1=IREL
  160. LDIM2=1
  161. SEGINI,A
  162. SEGINI,AP
  163. LDIM1=IREF
  164. LDIM2=1
  165. SEGINI,JMA
  166. LDIM1=IREF
  167. LDIM2=1
  168. SEGINI,KJMA
  169. LDIM1=IREL
  170. LDIM2=IREF
  171. SEGINI,J
  172. LDIM1=IREF
  173. LDIM2=IREL
  174. SEGINI,JM1
  175. LDIM1=IREF
  176. LDIM2=IREF
  177. SEGINI,K
  178. * Copie de la matrice jacobienne ref -> regulier
  179. CALL MAMA(JMAREG.VELCHE,IREF,IREF,
  180. $ 'COPIE ',K.XMAT,IREF,IREF,
  181. $ IMPR,IRET)
  182. IF (IRET.NE.0) GOTO 9999
  183. * SEGPRT,H
  184. DO ILFC=1,NLFC
  185. IF (NLJV.EQ.1) THEN
  186. ILJV=1
  187. ELSE
  188. ILJV=ILFC
  189. ENDIF
  190. C IF (NLJA.EQ.1) THEN
  191. C ILJA=1
  192. C ELSE
  193. C ILJA=ILFC
  194. C ENDIF
  195. IF (NLJI.EQ.1) THEN
  196. ILJI=1
  197. ELSE
  198. ILJI=ILFC
  199. ENDIF
  200. *
  201. DO IPFC=1,NPFC
  202. IF (NPJV.EQ.1) THEN
  203. IPJV=1
  204. ELSE
  205. IPJV=IPFC
  206. ENDIF
  207. C IF (NPJA.EQ.1) THEN
  208. C IPJA=1
  209. C ELSE
  210. C IPJA=IPFC
  211. C ENDIF
  212. IF (NPJI.EQ.1) THEN
  213. IPJI=1
  214. ELSE
  215. IPJI=IPFC
  216. ENDIF
  217. *
  218. * Copie de la vitesse
  219. *
  220. DO IIDIM=1,IDIM
  221. JVIT=MVIT.MVCOMP(IIDIM)
  222. A.XMAT(IIDIM,1)=JVIT.VELCHE(1,1,1,1,IPJV,ILJV)
  223. ENDDO
  224. * SEGPRT,A
  225. *
  226. * Copie de l'inverse (ou pseudo-inverse) du jacobien ref->reel
  227. *
  228. CALL MAMA(JMIJAC.VELCHE(1,1,1,1,IPJI,ILJI),IREF,IREL,
  229. $ 'COPIE ',
  230. $ JM1.XMAT,IREF,IREL,
  231. $ IMPR,IRET)
  232. IF (IRET.NE.0) GOTO 9999
  233. C SEGPRT,JM1
  234. *
  235. * Copie du jacobien ref->reel
  236. *
  237. CALL MAMA(JMAJAC.VELCHE(1,1,1,1,IPJI,ILJI),IREL,IREF,
  238. $ 'COPIE ',
  239. $ J.XMAT,IREL,IREF,
  240. $ IMPR,IRET)
  241. IF (IRET.NE.0) GOTO 9999
  242. C SEGPRT,JM1
  243. *
  244. * Vecteur A dans le repère de référence
  245. *
  246. CALL MAMAMA(JM1.XMAT,IREF,IREL,A.XMAT,IREL,1,
  247. $ 'FOIS ',JMA.XMAT,IREF,1,
  248. $ IMPR,IRET)
  249. IF (IRET.NE.0) GOTO 9999
  250. *
  251. * Vecteur A' dans le repère réel (projection sur le domaine considéré)
  252. *
  253. CALL MAMAMA(J.XMAT,IREL,IREF,JMA.XMAT,IREF,1,
  254. $ 'FOIS ',AP.XMAT,IREL,1,
  255. $ IMPR,IRET)
  256. IF (IRET.NE.0) GOTO 9999
  257. *
  258. * Vecteur A dans le repère de l'élément régulier
  259. *
  260. CALL MAMAMA(K.XMAT,IREF,IREF,JMA.XMAT,IREF,1,
  261. $ 'FOIS ',KJMA.XMAT,IREF,1,
  262. $ IMPR,IRET)
  263. IF (IRET.NE.0) GOTO 9999
  264. *
  265. * Normes de A
  266. *
  267. XAREG2=XZERO
  268. DO IIREF=1,IREF
  269. XAREG2=XAREG2+(KJMA.XMAT(IIREF,1)**2)
  270. ENDDO
  271. XA2=XZERO
  272. DO IIDIM=1,IDIM
  273. XA2=XA2+(A.XMAT(IIDIM,1)**2)
  274. ENDDO
  275. XAP2=XZERO
  276. DO IIDIM=1,IDIM
  277. XAP2=XAP2+(AP.XMAT(IIDIM,1)**2)
  278. ENDDO
  279. XAPA=XZERO
  280. DO IIDIM=1,IDIM
  281. XAPA=XAPA+(AP.XMAT(IIDIM,1)*A.XMAT(IIDIM,1))
  282. ENDDO
  283. C WRITE(IOIMP,*) 'XA2=',XA2
  284. C WRITE(IOIMP,*) 'XAP2=',XAP2
  285. C WRITE(IOIMP,*) 'XAREG2=',XAREG2
  286. C WRITE(IOIMP,*) 'XDIAMA=',XDIAMA
  287. *
  288. IF (XA2.LT.XPETIT) THEN
  289. WRITE(IOIMP,*) 'The given direction is 0'
  290. GOTO 9999
  291. ENDIF
  292. IF (XAREG2.LT.XPETIT) THEN
  293. CONTRI=0.D0
  294. ELSE
  295. CONTRI=SQRT((XAP2*XAPA)/(XAREG2*XA2))*XDIAMA
  296. * CONTRI=SQRT(XA2/XAREG2)*XDIAMA
  297. ENDIF
  298. FC.VELCHE(1,1,1,1,IPFC,ILFC)=
  299. $ FC.VELCHE(1,1,1,1,IPFC,ILFC)+
  300. $ CONTRI
  301. ENDDO
  302. ENDDO
  303. SEGSUP,K
  304. SEGSUP,J
  305. SEGSUP,JM1
  306. SEGSUP,KJMA
  307. SEGSUP,JMA
  308. SEGSUP,AP
  309. SEGSUP,A
  310. SEGSUP,MVIT
  311. *
  312. * Normal termination
  313. *
  314. IRET=0
  315. RETURN
  316. *
  317. * Format handling
  318. *
  319. *
  320. * Error handling
  321. *
  322. 9999 CONTINUE
  323. IRET=1
  324. WRITE(IOIMP,*) 'An error was detected in subroutine ccgtdi'
  325. RETURN
  326. *
  327. * End of subroutine CCGTDI
  328. *
  329. END
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  

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