Télécharger la plaquette Cast3M


fr en

Télécharger ccgmet.eso

Retour à la liste

Numérotation des lignes : 

ccgmet

  1. C CCGMET    SOURCE    GOUNAND   26/01/09    21:15:06     12441          
  2.       SUBROUTINE CCGMET(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         : CCGMET
  9. C DESCRIPTION : Lois de comportement aux points de Gauss :
  10. C               Métrique par rapport à un élément de référence régulier.
  11. C               (Copie de CCGIME)
  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, 2026/01/02, version initiale
  26. C HISTORIQUE : v1, 2026/01/02, 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,IHJT.MXMAT
  52.       POINTEUR H.MXMAT,IH.MXMAT
  53.       POINTEUR ME.MXMAT
  54. *
  55. *
  56.       INTEGER IMPR,IRET
  57. *
  58. * Executable statements
  59. *
  60.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgmet'
  61. C      IF (.NOT.(IDIM.EQ.1)) THEN
  62. C         WRITE(IOIMP,*) 'IDIM=',IDIM,' ?'
  63. C         GOTO 9999
  64. C      ENDIF
  65.       NLFC=FC.WELCHE(/6)
  66.       NPFC=FC.WELCHE(/5)
  67.       ICOF=0
  68. *
  69.       ICOF=ICOF+1
  70.       JMAJAC=LCOF.LISCHE(ICOF)
  71.       NLJA=JMAJAC.WELCHE(/6)
  72.       NPJA=JMAJAC.WELCHE(/5)
  73.       IREF=JMAJAC.WELCHE(/4)
  74.       IREL=JMAJAC.WELCHE(/3)
  75. *
  76.       IF (IREL.NE.IDIM) THEN
  77.          WRITE(IOIMP,*) 'Erreur dims JMAJAC'
  78.          GOTO 9999
  79.       ENDIF
  80. *
  81.       ICOF=ICOF+1
  82.       ICOF=ICOF+1
  83.       ICOF=ICOF+1
  84.       JMAREG=LCOF.LISCHE(ICOF)
  85.       NLJR=JMAREG.WELCHE(/6)
  86.       NPJR=JMAREG.WELCHE(/5)
  87.       I1  =JMAREG.WELCHE(/4)
  88.       I2  =JMAREG.WELCHE(/3)
  89.       IF ((NLJR.NE.1).OR.(NPJR.NE.1).OR.(I1.NE.IREF).OR.(I2.NE.IREF))
  90.      $     THEN
  91.          WRITE(IOIMP,*) 'Erreur dims JMAREG'
  92.          GOTO 9999
  93.       ENDIF
  94. *
  95. * Objets temporaires et à préconditionner
  96. *
  97.       LDIM1=IREL
  98.       LDIM2=IREF
  99.       SEGINI,JAC
  100.       LDIM1=IREF
  101.       LDIM2=IREL
  102.       SEGINI,JT
  103.       SEGINI,IHJT
  104.       LDIM1=IREF
  105.       LDIM2=IREF
  106.       SEGINI,H
  107.       SEGINI,IH
  108.       LDIM1=IREL
  109.       LDIM2=IREL
  110.       SEGINI,ME
  111. *
  112. * Calcul de la métrique des éléments réguliers
  113. *
  114.       CALL MAMA(JMAREG.WELCHE,IREF,IREF,
  115.      $     'JTJ     ',H.XMAT,IREF,IREF,
  116.      $     IMPR,IRET)
  117.       IF (IRET.NE.0) GOTO 9999
  118. *      SEGPRT,H
  119. * Calcul de l'inverse, du déterminant et trace de l'inverse de h
  120.       CALL GEOLI2(IREF,1,1,H.XMAT,IH.XMAT,DETH,
  121.      $     IMPR,IRET)
  122.       IF (IRET.NE.0) THEN
  123.          WRITE(IOIMP,*)
  124.      $        'Metrique des elements reguliers non inversible'
  125.          SEGPRT,JMAREG
  126.          SEGPRT,H
  127.          GOTO 9999
  128.       ENDIF
  129. *      SEGPRT,IH
  130. *
  131.       DO ILFC=1,NLFC
  132.          IF (NLJA.EQ.1) THEN
  133.             ILJA=1
  134.          ELSE
  135.             ILJA=ILFC
  136.          ENDIF
  137.          DO IPFC=1,NPFC
  138.             IF (NPJA.EQ.1) THEN
  139.                IPJA=1
  140.             ELSE
  141.                IPJA=IPFC
  142.             ENDIF
  143. *
  144. * Copie du jacobien
  145. *
  146.             CALL MAMA(JMAJAC.WELCHE(1,1,1,1,IPJA,ILJA),IREL,IREF,
  147.      $           'COPIE   ',
  148.      $           JAC.XMAT,IREL,IREF,
  149.      $           IMPR,IRET)
  150.             IF (IRET.NE.0) GOTO 9999
  151. *            SEGPRT,JAC
  152. *
  153. * Calcul de la métrique ME = J h-1 Jt
  154. *
  155. *     Calcul de Jt
  156.             CALL MAMA(JAC.XMAT,IREL,IREF,
  157.      $           'TRANSPOS',JT.XMAT,IREF,IREL,
  158.      $           IMPR,IRET)
  159.             IF (IRET.NE.0) GOTO 9999
  160. *            SEGPRT,JT
  161. *     Calcul de h-1 Jt
  162.             CALL MAMAMA(IH.XMAT,IREF,IREF,JT.XMAT,IREF,IREL,
  163.      $           'FOIS    ',IHJT.XMAT,IREF,IREL,
  164.      $           IMPR,IRET)
  165.             IF (IRET.NE.0) GOTO 9999
  166. *            SEGPRT,IHJT
  167. *     Calcul de J h-1 Jt
  168.             CALL MAMAMA(JAC.XMAT,IREL,IREF,IHJT.XMAT,IREF,IREL,
  169.      $           'FOIS    ',ME.XMAT,IREL,IREL,IMPR,IRET)
  170.             IF (IRET.NE.0) GOTO 9999
  171. *
  172. * Calcul des la métrique inverse de l'élément
  173. *
  174.             IF (NOMLOI(1:4).EQ.'METR') THEN
  175.                CALL CH2INT(NOMLOI(5:5),IDIM1,IMPR,IRET)
  176.                IF (IRET.NE.0) GOTO 9999
  177.                CALL CH2INT(NOMLOI(6:6),IDIM2,IMPR,IRET)
  178.                IF (IRET.NE.0) GOTO 9999
  179.                CONTRI=ME.XMAT(IDIM1,IDIM2)
  180. *               WRITE(IOIMP,*) 'CONTRI=',CONTRI
  181.             ELSE
  182.                WRITE(IOIMP,*) 'NOMLOI=',NOMLOI
  183.                WRITE(IOIMP,*) 'Erreur grave'
  184.                GOTO 9999
  185.             ENDIF
  186.             FC.WELCHE(1,1,1,1,IPFC,ILFC)=
  187.      $           FC.WELCHE(1,1,1,1,IPFC,ILFC)+
  188.      $           CONTRI
  189.          ENDDO
  190.       ENDDO
  191.       SEGSUP,ME
  192.       SEGSUP,IH
  193.       SEGSUP,H
  194.       SEGSUP,IHJT
  195.       SEGSUP,JT
  196.       SEGSUP,JAC
  197. *
  198. * Normal termination
  199. *
  200.       IRET=0
  201.       RETURN
  202. *
  203. * Format handling
  204. *
  205. *
  206. * Error handling
  207. *
  208.  9999 CONTINUE
  209.       IRET=1
  210.       WRITE(IOIMP,*) 'An error was detected in subroutine ccgmet'
  211.       RETURN
  212. *
  213. * End of subroutine CCGMET
  214. *
  215.       END
  216.  
  217.  

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