1 : C GEOME2 SOURCE GOUNAND 05/12/21 21:27:52 5281 2 : SUBROUTINE GEOME2(NPJAC,NBELEM, 3 : $ JDTJAC,LAXI, 4 : $ JDTJA2, 5 : $ IMPR,IRET) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : IMPLICIT INTEGER (I-N) 8 : C*********************************************************************** 9 : C NOM : GEOME2 10 : C PROJET : 11 : C DESCRIPTION : On multiplie le determinant de la matrice jacobienne aux 12 : C points de Gauss par 2PIR 13 : C 14 : C LANGAGE : Fortran 77 (sauf E/S) 15 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 16 : C mél : gounand@semt2.smts.cea.fr 17 : C*********************************************************************** 18 : C APPELES : - 19 : C APPELE PAR : GEOMET 20 : C*********************************************************************** 21 : C ENTREES : 22 : C ENTREES/SORTIES : 23 : C SORTIES : - 24 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 25 : C*********************************************************************** 26 : C VERSION : v2, 24/09/03, JDTJAC n'est plus E/S 27 : C VERSION : v1, 28/08/03, version initiale 28 : C HISTORIQUE : v1, 28/08/03, 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 : INTEGER NPJAC,NBELEM 39 : REAL*8 JDTJAC(NPJAC,NBELEM) 40 : REAL*8 JDTJA2(NPJAC,NBELEM) 41 : * 42 : INTEGER IMPR,IRET 43 : INTEGER IELEM,IPJAC 44 : REAL*8 DEPI 45 : * 46 : * Executable statements 47 : * 48 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans geome2' 49 : IF (LAXI.EQ.2) THEN 50 : DEPI=2.D0*XPI 51 : DO IELEM=1,NBELEM 52 : DO IPJAC=1,NPJAC 53 : JDTJA2(IPJAC,IELEM)= 54 : $ JDTJAC(IPJAC,IELEM) 55 : $ * DEPI 56 : ENDDO 57 : ENDDO 58 : ELSE 59 : WRITE(IOIMP,*) 'LAXI=',LAXI,' incorrect' 60 : ENDIF 61 : * 62 : * Normal termination 63 : * 64 : IRET=0 65 : RETURN 66 : * 67 : * Format handling 68 : * 69 : * 70 : * Error handling 71 : * 72 : 9999 CONTINUE 73 : IRET=1 74 : WRITE(IOIMP,*) 'An error was detected in subroutine geome2' 75 : RETURN 76 : * 77 : * End of subroutine GEOME2 78 : * 79 : END 80 : 81 :
© Cast3M 2003 - All rights reserved.
Disclaimer