Télécharger la plaquette Cast3M


fr en

Télécharger ccgtdi.eso

Retour à la liste

Numérotation des lignes : 

ccgtdi

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

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