C TESTJA SOURCE GOUNAND 05/12/21 21:37:15 5281 SUBROUTINE TESTJA() IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : TESTJA C PROJET : Noyau linéaire NLIN C DESCRIPTION : On vérifie le calcul de la matrice jacobienne et de son C déterminant sur quelques exemples... C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : C APPELES (E/S) : C APPELES (BLAS) : C APPELES (CALCUL) : C APPELE PAR : PILOT C*********************************************************************** C SYNTAXE GIBIANE : C ENTREES : C ENTREES/SORTIES : C SORTIES : C*********************************************************************** C VERSION : v1, 12/08/99, version initiale C HISTORIQUE : v1, 12/08/99, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC CCOPTIO -INC CCREEL CBEGININCLUDE SELREF SEGMENT ELREF CHARACTER*(LNNOM) NOMLRF CHARACTER*(LNFORM) FORME CHARACTER*(LNTYPL) TYPEL CHARACTER*(LNESP) ESPACE INTEGER DEGRE REAL*8 XCONOD(NDIMEL,NBNOD) INTEGER NPQUAF(NBDDL) INTEGER NUMCMP(NBDDL) INTEGER QUENOD(NBDDL) INTEGER ORDDER(NDIMEL,NBDDL) POINTEUR MBPOLY.POLYNS ENDSEGMENT SEGMENT ELREFS POINTEUR LISEL(0).ELREF ENDSEGMENT CENDINCLUDE SELREF POINTEUR MYLRFS.ELREFS POINTEUR MYLRF.ELREF CBEGININCLUDE SPOGAU SEGMENT POGAU CHARACTER*(LNNPG) NOMPG CHARACTER*(LNTPG) TYPMPG CHARACTER*(LNFPG) FORLPG INTEGER NORDPG REAL*8 XCOPG(NDLPG,NBPG) REAL*8 XPOPG(NBPG) ENDSEGMENT SEGMENT POGAUS POINTEUR LISPG(0).POGAU ENDSEGMENT CENDINCLUDE SPOGAU POINTEUR MYPGS.POGAUS POINTEUR MYPG.POGAU * INTEGER IMPR,IRET * * Executable statements * IMPR=0 WRITE(IOIMP,*) 'Entrée dans testja' * * Initialisation du segment contenant les informations sur les * éléments de référence. * CALL INLRFS(MYLRFS,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * Initialisation du segment contenant les informations sur les * méthodes d'intégration (type Gauss). * CALL INPGS(MYPGS,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * On teste sur un élément quadrilatéral à quatre noeuds (D&T p.54-55) * avec sept points de Gauss, dans le cas rectangulaire, et dans le cas * où l'élément est illicite (les côtés opposés se croisent). * Dimension des espaces de référence et réels : 2, 2 * CALL TESJA1(MYLRFS,MYPGS, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * On teste sur un segment à deux noeuds (D&T p.96) * avec cinq points de Gauss (sens direct et indirect pour le segment). * Dimension des espaces de référence et réels : 1, 1 * CALL TESJA2(MYLRFS,MYPGS, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * On teste sur un triangle à trois noeuds (D&T p.108) * avec sept points de Gauss (sens direct et indirect pour le triangle). * Dimension des espaces de référence et réels : 2, 2 * CALL TESJA3(MYLRFS,MYPGS, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * On teste sur un tétraèdre à quatre noeuds (D&T p.131) * avec cinq points de Gauss (sens direct et indirect pour le tétraèdre). * Dimension des espaces de référence et réels : 3, 3 * CALL TESJA4(MYLRFS,MYPGS, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * On teste sur un segment à deux noeuds en 3D (D&T p.215 pour le 2D) * avec cinq points de Gauss (sens direct et indirect pour le segment). * Dimension des espaces de référence et réels : 1, 3 * CALL TESJA5(MYLRFS,MYPGS, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * Normal termination * IRET=0 CALL ECRLOG(.TRUE.) RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine testja' CALL ECRLOG(.FALSE.) RETURN * * End of subroutine testja * END