1 : C TESJA5 SOURCE GOUNAND 05/12/21 21:37:13 5281 2 : SUBROUTINE TESJA5(MYLRFS,MYPGS, 3 : $ IMPR,IRET) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : IMPLICIT INTEGER (I-N) 6 : C*********************************************************************** 7 : C NOM : TESJA5 8 : C PROJET : Noyau linéaire NLIN 9 : C DESCRIPTION : On vérifie le calcul de la matrice jacobienne et de son 10 : C déterminant sur un segment en 3D... 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 APPELES (E/S) : 18 : C APPELES (BLAS) : 19 : C APPELES (CALCUL) : 20 : C APPELE PAR : TESTJA 21 : C*********************************************************************** 22 : C SYNTAXE GIBIANE : 23 : C ENTREES : 24 : C ENTREES/SORTIES : 25 : C SORTIES : 26 : C*********************************************************************** 27 : C VERSION : v1, 16/08/99, version initiale 28 : C HISTORIQUE : v1, 16/08/99, création 29 : C HISTORIQUE : 30 : C HISTORIQUE : 31 : C*********************************************************************** 32 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 33 : C en cas de modification de ce sous-programme afin de faciliter 34 : C la maintenance ! 35 : C*********************************************************************** 36 : -INC CCOPTIO 37 : -INC CCREEL 38 : CBEGININCLUDE SELREF 39 : SEGMENT ELREF 40 : CHARACTER*(LNNOM) NOMLRF 41 : CHARACTER*(LNFORM) FORME 42 : CHARACTER*(LNTYPL) TYPEL 43 : CHARACTER*(LNESP) ESPACE 44 : INTEGER DEGRE 45 : REAL*8 XCONOD(NDIMEL,NBNOD) 46 : INTEGER NPQUAF(NBDDL) 47 : INTEGER NUMCMP(NBDDL) 48 : INTEGER QUENOD(NBDDL) 49 : INTEGER ORDDER(NDIMEL,NBDDL) 50 : POINTEUR MBPOLY.POLYNS 51 : ENDSEGMENT 52 : SEGMENT ELREFS 53 : POINTEUR LISEL(0).ELREF 54 : ENDSEGMENT 55 : CENDINCLUDE SELREF 56 : POINTEUR MYLRFS.ELREFS 57 : POINTEUR MYLRF.ELREF 58 : CBEGININCLUDE SPOGAU 59 : SEGMENT POGAU 60 : CHARACTER*(LNNPG) NOMPG 61 : CHARACTER*(LNTPG) TYPMPG 62 : CHARACTER*(LNFPG) FORLPG 63 : INTEGER NORDPG 64 : REAL*8 XCOPG(NDLPG,NBPG) 65 : REAL*8 XPOPG(NBPG) 66 : ENDSEGMENT 67 : SEGMENT POGAUS 68 : POINTEUR LISPG(0).POGAU 69 : ENDSEGMENT 70 : CENDINCLUDE SPOGAU 71 : POINTEUR MYPGS.POGAUS 72 : POINTEUR MYPG.POGAU 73 : CBEGININCLUDE SMCHAEL 74 : SEGMENT MCHAEL 75 : POINTEUR IMACHE(N1).MELEME 76 : POINTEUR ICHEVA(N1).MCHEVA 77 : ENDSEGMENT 78 : SEGMENT MCHEVA 79 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 80 : ENDSEGMENT 81 : SEGMENT LCHEVA 82 : POINTEUR LISCHE(NBCHE).MCHEVA 83 : ENDSEGMENT 84 : CENDINCLUDE SMCHAEL 85 : INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM 86 : POINTEUR JCOOR.MCHEVA 87 : POINTEUR JMAJAC.MCHEVA 88 : POINTEUR JMIJAC.MCHEVA 89 : POINTEUR JDTJAC.MCHEVA 90 : POINTEUR FFGPG.MCHEVA 91 : POINTEUR DFFGPG.MCHEVA 92 : * 93 : INTEGER IMPR,IRET 94 : * 95 : REAL*8 JXX(3,1) 96 : REAL*8 X1,X2 97 : REAL*8 Y1,Y2 98 : REAL*8 Z1,Z2 99 : REAL*8 DETJXX,DETA,JXXA,XERR 100 : REAL*8 XERREL 101 : INTEGER NPG,INPG,ILIG,INBTES 102 : LOGICAL LERJ 103 : * 104 : * Executable statements 105 : * 106 : WRITE(IOIMP,*) 'Entrée dans tesja5' 107 : * 108 : * On teste sur un segment à deux noeuds en 3D (D&T p.215 pour le 2D) 109 : * avec cinq points de Gauss (sens direct et indirect pour le segment). 110 : * Dimension des espaces de référence et réels : 1, 3 111 : * 111 : CALL FILRF('H1D1SE2',MYLRFS,MYLRF,IMPR,IRET) 112 : IF (IRET.NE.0) GOTO 9999 112 : CALL FIPG('GAC1-9-5',MYPGS,MYPG,IMPR,IRET) 113 : IF (IRET.NE.0) GOTO 9999 113 : CALL KFNREF(MYLRF,MYPG,FFGPG,DFFGPG,IMPR,IRET) 114 : IF (IRET.NE.0) GOTO 9999 115 : DO 3 INBTES=1,2 116 : IF (INBTES.EQ.1) THEN 117 : X1=2.D0*XPI 118 : Y1=XPI 119 : Z1=3.D0*XPI 120 : X2=-1.D0 121 : Y2=-2.D0 122 : Z2=-3.D0 123 : ELSEIF (INBTES.EQ.2) THEN 124 : X2=2.D0*XPI 125 : Y2=XPI 126 : Z2=3.D0*XPI 127 : X1=-1.D0 128 : Y1=-2.D0 129 : Z1=-3.D0 130 : ELSE 131 : WRITE(IOIMP,*) 'Erreur dans le nombre de tests' 132 : GOTO 9999 133 : ENDIF 134 : NBELM=1 135 : NBPOI=1 136 : N2COL=3 137 : N2LIG=1 138 : NBCOL=2 139 : NBLIG=1 140 : SEGINI JCOOR 141 : JCOOR.VELCHE(1,1,1,1,1,1)=X1 142 : JCOOR.VELCHE(1,1,1,2,1,1)=Y1 143 : JCOOR.VELCHE(1,1,1,3,1,1)=Z1 144 : JCOOR.VELCHE(1,2,1,1,1,1)=X2 145 : JCOOR.VELCHE(1,2,1,2,1,1)=Y2 146 : JCOOR.VELCHE(1,2,1,3,1,1)=Z2 147 : SEGDES JCOOR 148 : IF (IMPR.GT.3) THEN 149 : WRITE(IOIMP,*) 'JCOOR' 149 : CALL PRCHVA(JCOOR,IMPR,IRET) 150 : IF (IRET.NE.0) GOTO 9999 151 : ENDIF 152 : LERJ=.FALSE. 152 : CALL GEOLIN(DFFGPG,JCOOR,NBELM, 153 : $ JMAJAC,JMIJAC,JDTJAC,LERJ, 154 : $ IMPR,IRET) 155 : IF (IRET.NE.0) GOTO 9999 156 : * 157 : * Test sur les valeurs de la matrice jacobienne et de son 158 : * déterminant aux points de Gauss... 159 : * 160 : SEGACT MYPG 161 : SEGACT JMAJAC 162 : SEGACT JDTJAC 163 : NPG=MYPG.XCOPG(/2) 164 : JXX(1,1)=(X2-X1)/2.D0 165 : JXX(2,1)=(Y2-Y1)/2.D0 166 : JXX(3,1)=(Z2-Z1)/2.D0 167 : DETJXX=SQRT(JXX(1,1)*JXX(1,1) 168 : $ +JXX(2,1)*JXX(2,1)+JXX(3,1)*JXX(3,1)) 169 : DO INPG=1,JMAJAC.VELCHE(/5) 170 : DO 322 ILIG=1,3 171 : JXXA=JMAJAC.VELCHE(1,1,ILIG,1,INPG,1) 172 : XERR=XERREL(JXX(ILIG,1),JXXA) 173 : IF (XERR.GT.10.D0*XZPREC) THEN 174 : WRITE(IOIMP,*) 'Erreur calcul mat. jac.' 175 : WRITE(IOIMP,*) 'XERR=',XERR, ' XZPREC=',XZPREC 176 : WRITE(IOIMP,*) 'JXX=',JXX(ILIG,1) 177 : WRITE(IOIMP,*) 'JXXA=',JXXA 178 : GOTO 9999 179 : ENDIF 180 : 322 CONTINUE 181 : ENDDO 182 : DO INPG=1,JDTJAC.VELCHE(/5) 183 : DETA=JDTJAC.VELCHE(1,1,1,1,INPG,1) 184 : XERR=XERREL(DETJXX,DETA) 185 : IF (XERR.GT.0.1D0) THEN 186 : WRITE(IOIMP,*) 'Erreur calcul det. mat. jac.' 187 : WRITE(IOIMP,*) 'XERR=',XERR, ' XZPREC=',XZPREC 188 : WRITE(IOIMP,*) 'DETJXX=',DETJXX 189 : WRITE(IOIMP,*) 'DETA=',DETA 190 : GOTO 9999 191 : ENDIF 192 : ENDDO 193 : SEGDES MYPG 194 : SEGDES JDTJAC 195 : SEGDES JMAJAC 196 : IF (IMPR.GT.3) THEN 197 : WRITE(IOIMP,*) 'JMAJAC' 197 : CALL PRCHVA(JMAJAC,IMPR,IRET) 198 : IF (IRET.NE.0) GOTO 9999 199 : * WRITE(IOIMP,*) 'JMIJAC' 199 : * CALL PRCHVA(JMIJAC,IMPR,IRET) 200 : * IF (IRET.NE.0) GOTO 9999 201 : WRITE(IOIMP,*) 'JDTJAC' 201 : CALL PRCHVA(JDTJAC,IMPR,IRET) 202 : IF (IRET.NE.0) GOTO 9999 203 : ENDIF 204 : WRITE(IOIMP,*) 'Test',INBTES,' successful' 205 : 3 CONTINUE 206 : * 207 : * Normal termination 208 : * 209 : IRET=0 210 : RETURN 211 : * 212 : * Format handling 213 : * 214 : * 215 : * Error handling 216 : * 217 : 9999 CONTINUE 218 : IRET=1 219 : WRITE(IOIMP,*) 'An error was detected in subroutine tesja5' 220 : RETURN 221 : * 222 : * End of subroutine tesja5 223 : * 224 : END 225 : 226 :
© Cast3M 2003 - All rights reserved.
Disclaimer