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 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. POINTEUR JDIAMA.MCHEVA
  55. POINTEUR JPC.MCHEVA
  56. POINTEUR JVIT.MCHEVA
  57. CHARACTER*8 NOMLOI
  58. INTEGER ICOF
  59. *
  60. -INC TMXMAT
  61. POINTEUR A.MXMAT
  62. POINTEUR AP.MXMAT
  63. POINTEUR JMA.MXMAT
  64. POINTEUR KJMA.MXMAT
  65. POINTEUR JM1.MXMAT,J.MXMAT
  66. POINTEUR K.MXMAT
  67. *
  68. SEGMENT MVIT
  69. POINTEUR MVCOMP(IDIM).MCHEVA
  70. ENDSEGMENT
  71. *
  72. LOGICAL LREGP,LRELP
  73. INTEGER IMPR,IRET
  74. *
  75. * Executable statements
  76. *
  77. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgtdi'
  78. * XPETI=SQRT(XPETIT)
  79. NLFC=FC.VELCHE(/6)
  80. NPFC=FC.VELCHE(/5)
  81. ICOF=0
  82. *
  83. * Récupération des coefficients de la metrique
  84. *
  85. SEGINI MVIT
  86. DO IIDIM=1,IDIM
  87. ICOF=ICOF+1
  88. JVIT=LCOF.LISCHE(ICOF)
  89. IF (ICOF.EQ.1) THEN
  90. NLJV=JVIT.VELCHE(/6)
  91. NPJV=JVIT.VELCHE(/5)
  92. ELSE
  93. NLJV2=JVIT.VELCHE(/6)
  94. NPJV2=JVIT.VELCHE(/5)
  95. IF (NLJV2.NE.NLJV.OR.NPJV2.NE.NPJV) THEN
  96. WRITE(IOIMP,*) 'Erreur grave dims JVIT'
  97. GOTO 9999
  98. ENDIF
  99. ENDIF
  100. MVIT.MVCOMP(IIDIM)=JVIT
  101. ENDDO
  102. *
  103. ICOF=ICOF+1
  104. JMAJAC=LCOF.LISCHE(ICOF)
  105. C NLJA=JMAJAC.VELCHE(/6)
  106. C NPJA=JMAJAC.VELCHE(/5)
  107. IREF=JMAJAC.VELCHE(/4)
  108. IREL=JMAJAC.VELCHE(/3)
  109. *
  110. IF (IREL.NE.IDIM) THEN
  111. WRITE(IOIMP,*) 'Erreur dims JMAJAC'
  112. GOTO 9999
  113. ENDIF
  114. *
  115. ICOF=ICOF+1
  116. JMIJAC=LCOF.LISCHE(ICOF)
  117. IF (JMIJAC.EQ.0) THEN
  118. WRITE(IOIMP,*) 'Erreur JMIJAC=0'
  119. GOTO 9999
  120. ENDIF
  121. NLJI=JMIJAC.VELCHE(/6)
  122. NPJI=JMIJAC.VELCHE(/5)
  123. IREL2=JMIJAC.VELCHE(/4)
  124. IREF2=JMIJAC.VELCHE(/3)
  125. *
  126. IF (IREL2.NE.IREL.OR.IREF2.NE.IREF) THEN
  127. WRITE(IOIMP,*) 'Erreur dims JMIJAC'
  128. GOTO 9999
  129. ENDIF
  130. *
  131. ICOF=ICOF+1
  132. ICOF=ICOF+1
  133. JMAREG=LCOF.LISCHE(ICOF)
  134. NLJR=JMAREG.VELCHE(/6)
  135. NPJR=JMAREG.VELCHE(/5)
  136. I1 =JMAREG.VELCHE(/4)
  137. I2 =JMAREG.VELCHE(/3)
  138. IF ((NLJR.NE.1).OR.(NPJR.NE.1).OR.(I1.NE.IREF).OR.(I2.NE.IREF))
  139. $ THEN
  140. WRITE(IOIMP,*) 'Erreur dims JMAREG'
  141. GOTO 9999
  142. ENDIF
  143. ICOF=ICOF+1
  144. JDIAMA=LCOF.LISCHE(ICOF)
  145. NLJD=JDIAMA.VELCHE(/6)
  146. NPJD=JDIAMA.VELCHE(/5)
  147. I1 =JDIAMA.VELCHE(/4)
  148. I2 =JDIAMA.VELCHE(/3)
  149. IF ((NLJD.NE.1).OR.(NPJD.NE.1).OR.(I1.NE.1).OR.(I2.NE.1))
  150. $ THEN
  151. WRITE(IOIMP,*) 'Erreur dims JDIAMA'
  152. GOTO 9999
  153. ENDIF
  154. XDIAMA=JDIAMA.VELCHE(1,1,1,1,1,1)
  155. *
  156. * Objets temporaires
  157. *
  158. LDIM1=IREL
  159. LDIM2=1
  160. SEGINI,A
  161. SEGINI,AP
  162. LDIM1=IREF
  163. LDIM2=1
  164. SEGINI,JMA
  165. LDIM1=IREF
  166. LDIM2=1
  167. SEGINI,KJMA
  168. LDIM1=IREL
  169. LDIM2=IREF
  170. SEGINI,J
  171. LDIM1=IREF
  172. LDIM2=IREL
  173. SEGINI,JM1
  174. LDIM1=IREF
  175. LDIM2=IREF
  176. SEGINI,K
  177. * Copie de la matrice jacobienne ref -> regulier
  178. CALL MAMA(JMAREG.VELCHE,IREF,IREF,
  179. $ 'COPIE ',K.XMAT,IREF,IREF,
  180. $ IMPR,IRET)
  181. IF (IRET.NE.0) GOTO 9999
  182. * SEGPRT,H
  183. DO ILFC=1,NLFC
  184. IF (NLJV.EQ.1) THEN
  185. ILJV=1
  186. ELSE
  187. ILJV=ILFC
  188. ENDIF
  189. C IF (NLJA.EQ.1) THEN
  190. C ILJA=1
  191. C ELSE
  192. C ILJA=ILFC
  193. C ENDIF
  194. IF (NLJI.EQ.1) THEN
  195. ILJI=1
  196. ELSE
  197. ILJI=ILFC
  198. ENDIF
  199. *
  200. DO IPFC=1,NPFC
  201. IF (NPJV.EQ.1) THEN
  202. IPJV=1
  203. ELSE
  204. IPJV=IPFC
  205. ENDIF
  206. C IF (NPJA.EQ.1) THEN
  207. C IPJA=1
  208. C ELSE
  209. C IPJA=IPFC
  210. C ENDIF
  211. IF (NPJI.EQ.1) THEN
  212. IPJI=1
  213. ELSE
  214. IPJI=IPFC
  215. ENDIF
  216. *
  217. * Copie de la vitesse
  218. *
  219. DO IIDIM=1,IDIM
  220. JVIT=MVIT.MVCOMP(IIDIM)
  221. A.XMAT(IIDIM,1)=JVIT.VELCHE(1,1,1,1,IPJV,ILJV)
  222. ENDDO
  223. * SEGPRT,A
  224. *
  225. * Copie de l'inverse (ou pseudo-inverse) du jacobien ref->reel
  226. *
  227. CALL MAMA(JMIJAC.VELCHE(1,1,1,1,IPJI,ILJI),IREF,IREL,
  228. $ 'COPIE ',
  229. $ JM1.XMAT,IREF,IREL,
  230. $ IMPR,IRET)
  231. IF (IRET.NE.0) GOTO 9999
  232. C SEGPRT,JM1
  233. *
  234. * Copie du jacobien ref->reel
  235. *
  236. CALL MAMA(JMAJAC.VELCHE(1,1,1,1,IPJI,ILJI),IREL,IREF,
  237. $ 'COPIE ',
  238. $ J.XMAT,IREL,IREF,
  239. $ IMPR,IRET)
  240. IF (IRET.NE.0) GOTO 9999
  241. C SEGPRT,JM1
  242. *
  243. * Vecteur A dans le repère de référence
  244. *
  245. CALL MAMAMA(JM1.XMAT,IREF,IREL,A.XMAT,IREL,1,
  246. $ 'FOIS ',JMA.XMAT,IREF,1,
  247. $ IMPR,IRET)
  248. IF (IRET.NE.0) GOTO 9999
  249. *
  250. * Vecteur A' dans le repère réel (projection sur le domaine considéré)
  251. *
  252. CALL MAMAMA(J.XMAT,IREL,IREF,JMA.XMAT,IREF,1,
  253. $ 'FOIS ',AP.XMAT,IREL,1,
  254. $ IMPR,IRET)
  255. IF (IRET.NE.0) GOTO 9999
  256. *
  257. * Vecteur A dans le repère de l'élément régulier
  258. *
  259. CALL MAMAMA(K.XMAT,IREF,IREF,JMA.XMAT,IREF,1,
  260. $ 'FOIS ',KJMA.XMAT,IREF,1,
  261. $ IMPR,IRET)
  262. IF (IRET.NE.0) GOTO 9999
  263. *
  264. * Normes de A
  265. *
  266. XAREG2=XZERO
  267. DO IIREF=1,IREF
  268. XAREG2=XAREG2+(KJMA.XMAT(IIREF,1)**2)
  269. ENDDO
  270. XA2=XZERO
  271. DO IIDIM=1,IDIM
  272. XA2=XA2+(A.XMAT(IIDIM,1)**2)
  273. ENDDO
  274. XAP2=XZERO
  275. DO IIDIM=1,IDIM
  276. XAP2=XAP2+(AP.XMAT(IIDIM,1)**2)
  277. ENDDO
  278. XAPA=XZERO
  279. DO IIDIM=1,IDIM
  280. XAPA=XAPA+(AP.XMAT(IIDIM,1)*A.XMAT(IIDIM,1))
  281. ENDDO
  282. C WRITE(IOIMP,*) 'XA2=',XA2
  283. C WRITE(IOIMP,*) 'XAP2=',XAP2
  284. C WRITE(IOIMP,*) 'XAREG2=',XAREG2
  285. C WRITE(IOIMP,*) 'XDIAMA=',XDIAMA
  286. *
  287. IF (XA2.LT.XPETIT) THEN
  288. WRITE(IOIMP,*) 'The given direction is 0'
  289. GOTO 9999
  290. ENDIF
  291. IF (XAREG2.LT.XPETIT) THEN
  292. CONTRI=0.D0
  293. ELSE
  294. CONTRI=SQRT((XAP2*XAPA)/(XAREG2*XA2))*XDIAMA
  295. * CONTRI=SQRT(XA2/XAREG2)*XDIAMA
  296. ENDIF
  297. FC.VELCHE(1,1,1,1,IPFC,ILFC)=
  298. $ FC.VELCHE(1,1,1,1,IPFC,ILFC)+
  299. $ CONTRI
  300. ENDDO
  301. ENDDO
  302. SEGSUP,K
  303. SEGSUP,J
  304. SEGSUP,JM1
  305. SEGSUP,KJMA
  306. SEGSUP,JMA
  307. SEGSUP,AP
  308. SEGSUP,A
  309. SEGSUP,MVIT
  310. *
  311. * Normal termination
  312. *
  313. IRET=0
  314. RETURN
  315. *
  316. * Format handling
  317. *
  318. *
  319. * Error handling
  320. *
  321. 9999 CONTINUE
  322. IRET=1
  323. WRITE(IOIMP,*) 'An error was detected in subroutine ccgtdi'
  324. RETURN
  325. *
  326. * End of subroutine CCGTDI
  327. *
  328. END
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  

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