Esope source files

   1 : C TESTJA    SOURCE    GOUNAND   05/12/21    21:37:15     5281           
   2 :       SUBROUTINE TESTJA()
   3 :       IMPLICIT REAL*8 (A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : C***********************************************************************
   6 : C NOM         : TESTJA
   7 : C PROJET      : Noyau linéaire NLIN
   8 : C DESCRIPTION : On vérifie le calcul de la matrice jacobienne et de son
   9 : C               déterminant sur quelques exemples...
  10 : C
  11 : C LANGAGE     : ESOPE
  12 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  13 : C               mél : gounand@semt2.smts.cea.fr
  14 : C***********************************************************************
  15 : C APPELES          : 
  16 : C APPELES (E/S)    : 
  17 : C APPELES (BLAS)   :
  18 : C APPELES (CALCUL) :
  19 : C APPELE PAR       : PILOT
  20 : C***********************************************************************
  21 : C SYNTAXE GIBIANE    :
  22 : C ENTREES            :
  23 : C ENTREES/SORTIES    :
  24 : C SORTIES            :
  25 : C***********************************************************************
  26 : C VERSION    : v1, 12/08/99, version initiale
  27 : C HISTORIQUE : v1, 12/08/99, création
  28 : C HISTORIQUE :
  29 : C HISTORIQUE :
  30 : C***********************************************************************
  31 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32 : C en cas de modification de ce sous-programme afin de faciliter
  33 : C la maintenance !
  34 : C***********************************************************************
  35 : -INC CCOPTIO
  36 : -INC CCREEL
  37 : CBEGININCLUDE SELREF
  38 :       SEGMENT ELREF
  39 :       CHARACTER*(LNNOM)  NOMLRF
  40 :       CHARACTER*(LNFORM) FORME 
  41 :       CHARACTER*(LNTYPL) TYPEL 
  42 :       CHARACTER*(LNESP)  ESPACE
  43 :       INTEGER DEGRE
  44 :       REAL*8 XCONOD(NDIMEL,NBNOD)
  45 :       INTEGER NPQUAF(NBDDL)
  46 :       INTEGER NUMCMP(NBDDL)
  47 :       INTEGER QUENOD(NBDDL)
  48 :       INTEGER ORDDER(NDIMEL,NBDDL)
  49 :       POINTEUR MBPOLY.POLYNS
  50 :       ENDSEGMENT
  51 :       SEGMENT ELREFS
  52 :       POINTEUR LISEL(0).ELREF
  53 :       ENDSEGMENT
  54 : CENDINCLUDE SELREF
  55 :       POINTEUR MYLRFS.ELREFS
  56 :       POINTEUR MYLRF.ELREF
  57 : CBEGININCLUDE SPOGAU
  58 :       SEGMENT POGAU
  59 :       CHARACTER*(LNNPG)  NOMPG
  60 :       CHARACTER*(LNTPG)  TYPMPG
  61 :       CHARACTER*(LNFPG)  FORLPG
  62 :       INTEGER NORDPG
  63 :       REAL*8 XCOPG(NDLPG,NBPG)
  64 :       REAL*8 XPOPG(NBPG)
  65 :       ENDSEGMENT
  66 :       SEGMENT POGAUS
  67 :       POINTEUR LISPG(0).POGAU
  68 :       ENDSEGMENT
  69 : CENDINCLUDE SPOGAU
  70 :       POINTEUR MYPGS.POGAUS
  71 :       POINTEUR MYPG.POGAU
  72 : *
  73 :       INTEGER IMPR,IRET
  74 : *
  75 : * Executable statements
  76 : *
  77 :       IMPR=0
  78 :       WRITE(IOIMP,*) 'Entrée dans testja'
  79 : *
  80 : * Initialisation du segment contenant les informations sur les
  81 : * éléments de référence.
  82 : *
  82 :       CALL INLRFS(MYLRFS,IMPR,IRET)
  83 :       IF (IRET.NE.0) GOTO 9999
  84 : *
  85 : * Initialisation du segment contenant les informations sur les
  86 : * méthodes d'intégration (type Gauss).
  87 : *
  87 :       CALL INPGS(MYPGS,IMPR,IRET)
  88 :       IF (IRET.NE.0) GOTO 9999
  89 : *
  90 : * On teste sur un élément quadrilatéral à quatre noeuds (D&T p.54-55)
  91 : * avec sept points de Gauss, dans le cas rectangulaire, et dans le cas
  92 : * où l'élément est illicite (les côtés opposés se croisent).
  93 : * Dimension des espaces de référence et réels : 2, 2
  94 : *
  94 :       CALL TESJA1(MYLRFS,MYPGS,
  95 :      $     IMPR,IRET)
  96 :       IF (IRET.NE.0) GOTO 9999
  97 : *
  98 : * On teste sur un segment à deux noeuds (D&T p.96)
  99 : * avec cinq points de Gauss (sens direct et indirect pour le segment). 
 100 : * Dimension des espaces de référence et réels : 1, 1
 101 : *
 101 :       CALL TESJA2(MYLRFS,MYPGS,
 102 :      $     IMPR,IRET)
 103 :       IF (IRET.NE.0) GOTO 9999
 104 : *
 105 : * On teste sur un triangle à trois noeuds (D&T p.108)
 106 : * avec sept points de Gauss (sens direct et indirect pour le triangle). 
 107 : * Dimension des espaces de référence et réels : 2, 2
 108 : *
 108 :       CALL TESJA3(MYLRFS,MYPGS,
 109 :      $     IMPR,IRET)
 110 :       IF (IRET.NE.0) GOTO 9999
 111 : *
 112 : * On teste sur un tétraèdre à quatre noeuds (D&T p.131)
 113 : * avec cinq points de Gauss (sens direct et indirect pour le tétraèdre). 
 114 : * Dimension des espaces de référence et réels : 3, 3
 115 : *
 115 :       CALL TESJA4(MYLRFS,MYPGS,
 116 :      $     IMPR,IRET)
 117 :       IF (IRET.NE.0) GOTO 9999
 118 : *
 119 : * On teste sur un segment à deux noeuds en 3D (D&T p.215 pour le 2D)
 120 : * avec cinq points de Gauss (sens direct et indirect pour le segment). 
 121 : * Dimension des espaces de référence et réels : 1, 3
 122 : *
 122 :       CALL TESJA5(MYLRFS,MYPGS,
 123 :      $     IMPR,IRET)
 124 :       IF (IRET.NE.0) GOTO 9999
 125 : *
 126 : * Normal termination
 127 : *
 128 :       IRET=0
 128 :       CALL ECRLOG(.TRUE.)
 129 :       RETURN
 130 : *
 131 : * Format handling
 132 : *
 133 : *
 134 : * Error handling
 135 : *
 136 :  9999 CONTINUE
 137 :       IRET=1
 138 :       WRITE(IOIMP,*) 'An error was detected in subroutine testja'
 138 :       CALL ECRLOG(.FALSE.)
 139 :       RETURN
 140 : *
 141 : * End of subroutine testja
 142 : *
 143 :       END
 144 : 
 145 :