Esope source files

   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 : *     
 132 :       CALL MAMA(JMAREG.VELCHE,IREF,IREF,
 133 :      $     'JTJ     ',H.XMAT,IREF,IREF,
 134 :      $     IMPR,IRET)
 135 :       IF (IRET.NE.0) GOTO 9999
 136 : *      SEGPRT,H
 137 : *     
 138 :       DO ILFC=1,NLFC
 139 :          IF (NLJA.EQ.1) THEN
 140 :             ILJA=1
 141 :          ELSE
 142 :             ILJA=ILFC
 143 :          ENDIF
 144 :          DO IPFC=1,NPFC
 145 :             IF (NPJA.EQ.1) THEN
 146 :                IPJA=1
 147 :             ELSE
 148 :                IPJA=IPFC
 149 :             ENDIF
 150 : *     
 151 : * Copie du jacobien
 152 : *     
 152 :             CALL MAMA(JMAJAC.VELCHE(1,1,1,1,IPJA,ILJA),IREL,IREF,
 153 :      $           'COPIE   ',
 154 :      $           JAC.XMAT,IREL,IREF,
 155 :      $           IMPR,IRET)
 156 :             IF (IRET.NE.0) GOTO 9999
 157 : *            SEGPRT,JAC
 158 : *     
 159 : * Calcul de la métrique ME = J (JtJ)-1 h (JtJ)-1 Jt = J M Jt
 160 : *     
 161 : *     Calcul de Jt
 161 :             CALL MAMA(JAC.XMAT,IREL,IREF,
 162 :      $           'TRANSPOS',JT.XMAT,IREF,IREL,
 163 :      $           IMPR,IRET)
 164 :             IF (IRET.NE.0) GOTO 9999
 165 : *            SEGPRT,JT
 166 : *     Calcul de G=JtJ
 166 :             CALL MAMAMA(JT.XMAT,IREF,IREL,JAC.XMAT,IREL,IREF,
 167 :      $           'FOIS    ',G.XMAT,IREF,IREF,
 168 :      $           IMPR,IRET)
 169 :             IF (IRET.NE.0) GOTO 9999
 170 : *            SEGPRT,G
 171 : * Calcul de l'inverse, du déterminant et trace de l'inverse de g
 172 :             LBID=.FALSE.
 172 :             CALL GEOLI2(IREF,1,1,G.XMAT,IG.XMAT,DETG,
 173 :      $           LBID,IMPR,IRET)
 174 :             IF (IRET.NE.0) GOTO 9999
 175 : *            SEGPRT,IG
 176 : * Calcul de hg-1, de sa trace et de son déterminant
 176 :             CALL MAMAMA(H.XMAT,IREF,IREF,IG.XMAT,IREF,IREF,
 177 :      $           'FOIS    ',HIG.XMAT,IREF,IREF,IMPR,IRET)
 178 :             IF (IRET.NE.0) GOTO 9999
 178 :             CALL MAMAMA(IG.XMAT,IREF,IREF,HIG.XMAT,IREF,IREF,
 179 :      $           'FOIS    ',IGHIG.XMAT,IREF,IREF,IMPR,IRET)
 180 :             IF (IRET.NE.0) GOTO 9999
 180 :             CALL MAMAMA(IGHIG.XMAT,IREF,IREF,JT.XMAT,IREF,IREL,
 181 :      $           'FOIS    ',MJT.XMAT,IREF,IREL,IMPR,IRET)
 182 :             IF (IRET.NE.0) GOTO 9999
 182 :             CALL MAMAMA(JAC.XMAT,IREL,IREF,MJT.XMAT,IREF,IREL,
 183 :      $           'FOIS    ',ME.XMAT,IREL,IREL,IMPR,IRET)
 184 :             IF (IRET.NE.0) GOTO 9999
 185 : *     
 186 : * Calcul des la métrique inverse de l'élément
 187 : *     
 188 :             IF (NOMLOI(1:4).EQ.'IMET') THEN
 188 :                CALL CH2INT(NOMLOI(5:5),IDIM1,IMPR,IRET)
 189 :                IF (IRET.NE.0) GOTO 9999
 189 :                CALL CH2INT(NOMLOI(6:6),IDIM2,IMPR,IRET)
 190 :                IF (IRET.NE.0) GOTO 9999
 191 :                CONTRI=ME.XMAT(IDIM1,IDIM2)
 192 : *               WRITE(IOIMP,*) 'CONTRI=',CONTRI
 193 :             ELSE
 194 :                WRITE(IOIMP,*) 'NOMLOI=',NOMLOI
 195 :                WRITE(IOIMP,*) 'Erreur grave'
 196 :                GOTO 9999
 197 :             ENDIF
 198 :             FC.VELCHE(1,1,1,1,IPFC,ILFC)=
 199 :      $           FC.VELCHE(1,1,1,1,IPFC,ILFC)+
 200 :      $           CONTRI
 201 :          ENDDO
 202 :       ENDDO
 203 :       SEGSUP,ME
 204 :       SEGSUP,IGHIG
 205 :       SEGSUP,HIG
 206 :       SEGSUP,H
 207 :       SEGSUP,IG
 208 :       SEGSUP,G
 209 :       SEGSUP,MJT
 210 :       SEGSUP,JT
 211 :       SEGSUP,JAC
 212 : *     
 213 : * Normal termination
 214 : *     
 215 :       IRET=0
 216 :       RETURN
 217 : *     
 218 : * Format handling
 219 : *     
 220 : *     
 221 : * Error handling
 222 : *     
 223 :  9999 CONTINUE
 224 :       IRET=1
 225 :       WRITE(IOIMP,*) 'An error was detected in subroutine ccgime'
 226 :       RETURN
 227 : *     
 228 : * End of subroutine CCGIME
 229 : *     
 230 :       END
 231 : 
 232 :  
 233 :  
 234 :  
 235 :  
 236 :