Esope source files

   1 : C GEOMF1    SOURCE    GOUNAND   06/08/04    21:15:59     5520           
   2 :       SUBROUTINE GEOMF1(NDDL,IESREL,NBPOGO,NBELEV,NBELFV,NBELEF,
   3 :      $     NPJAC,
   4 :      $     JCOOR,FFPG,SSFACT,
   5 :      $     JDTJAC,LAXI,
   6 :      $     JDTJA2,
   7 :      $     IMPR,IRET)
   8 :       IMPLICIT REAL*8 (A-H,O-Z)
   9 :       IMPLICIT INTEGER (I-N)
  10 : C***********************************************************************
  11 : C NOM         : GEOMF1
  12 : C PROJET      : 
  13 : C DESCRIPTION : On multiplie le determinant de la matrice jacobienne aux
  14 : C      points de Gauss par 2PIR
  15 : C             
  16 : C LANGAGE     : Fortran 77 (sauf E/S)
  17 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  18 : C               mél : gounand@semt2.smts.cea.fr
  19 : C***********************************************************************
  20 : C APPELES          : -
  21 : C APPELE PAR       : GEOMFT
  22 : C***********************************************************************
  23 : C ENTREES            :
  24 : C ENTREES/SORTIES    :
  25 : C SORTIES            : -
  26 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27 : C***********************************************************************
  28 : C VERSION    : v1, 02/10/03, version initiale
  29 : C HISTORIQUE : v1, 02/10/03, création
  30 : C HISTORIQUE :
  31 : C HISTORIQUE :
  32 : C***********************************************************************
  33 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34 : C en cas de modification de ce sous-programme afin de faciliter
  35 : C la maintenance !
  36 : C***********************************************************************
  37 : -INC CCOPTIO      
  38 : -INC CCREEL
  39 :       INTEGER NDDL,IESREL,NBPOGO,NBELEV,NBELFV,NBELEF
  40 :       REAL*8 JCOOR(NDDL,IESREL,NBELEV)
  41 :       REAL*8 FFPG(NDDL,NBPOGO,NBELFV)
  42 :       REAL*8 JDTJAC(NPJAC,NBELEF)
  43 :       LOGICAL SSFACT(NBELFV,NBELEV)
  44 :       REAL*8 JDTJA2(NBPOGO,NBELEF)
  45 : *
  46 :       INTEGER IMPR,IRET
  47 :       INTEGER IPOGO,JESREL,IDDL
  48 :       REAL*8 DEPIER,IDEPIR
  49 : *     
  50 : * Executable statements
  51 : *
  52 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans geomf1'
  53 :       IF (LAXI.EQ.1) THEN
  54 :          IBELEF=0
  55 :          DO IBELEV=1,NBELEV
  56 :             DO IBELFV=1,NBELFV
  57 :                IF (SSFACT(IBELFV,IBELEV)) THEN
  58 :                   IBELEF=IBELEF+1
  59 :                   DO IPOGO=1,NBPOGO
  60 :                      IF (NPJAC.EQ.1) THEN
  61 :                         IPJAC=1
  62 :                      ELSE 
  63 :                         IPJAC=IPOGO
  64 :                      ENDIF
  65 :                      JESREL=1
  66 :                      DEPIER=XZERO
  67 :                      DO IDDL=1,NDDL
  68 :                         DEPIER=DEPIER
  69 :      $                       + (JCOOR(IDDL,JESREL,IBELEV)
  70 :      $                       * FFPG(IDDL,IPOGO,IBELFV))
  71 :                      ENDDO
  72 :                      DEPIER=2.D0*XPI*DEPIER
  73 :                      JDTJA2(IPOGO,IBELEF)=
  74 :      $                    JDTJAC(IPJAC,IBELEF)
  75 :      $                    * DEPIER
  76 :                   ENDDO
  77 :                ENDIF
  78 :             ENDDO
  79 :          ENDDO
  80 :       ELSEIF (LAXI.EQ.3) THEN
  81 :          IBELEF=0
  82 :          DO IBELEV=1,NBELEV
  83 :             DO IBELFV=1,NBELFV
  84 :                IF (SSFACT(IBELFV,IBELEV)) THEN
  85 :                   IBELEF=IBELEF+1
  86 :                   DO IPOGO=1,NBPOGO
  87 :                      IF (NPJAC.EQ.1) THEN
  88 :                         IPJAC=1
  89 :                      ELSE 
  90 :                         IPJAC=IPOGO
  91 :                      ENDIF
  92 :                      JESREL=1
  93 :                      IDEPIR=XZERO
  94 :                      DO IDDL=1,NDDL
  95 :                         IDEPIR=IDEPIR
  96 :      $                       + (JCOOR(IDDL,JESREL,IBELEV)
  97 :      $                       * FFPG(IDDL,IPOGO,IBELFV))
  98 :                      ENDDO
  99 :                      IDEPIR=2.D0*XPI*(1.D0/IDEPIR)
 100 :                      JDTJA2(IPOGO,IBELEF)=
 101 :      $                    JDTJAC(IPJAC,IBELEF)
 102 :      $              * IDEPIR
 103 :                   ENDDO
 104 :                ENDIF
 105 :             ENDDO
 106 :          ENDDO
 107 :       ELSE
 108 :          WRITE(IOIMP,*) 'LAXI=',LAXI,' incorrect'
 109 :       ENDIF
 110 : *
 111 : * Normal termination
 112 : *
 113 :       IRET=0
 114 :       RETURN
 115 : *
 116 : * Format handling
 117 : *
 118 : *
 119 : * Error handling
 120 : *
 121 :  9999 CONTINUE
 122 :       IRET=1
 123 :       WRITE(IOIMP,*) 'An error was detected in subroutine geomf1'
 124 :       RETURN
 125 : *
 126 : * End of subroutine GEOMF1
 127 : *
 128 :       END
 129 : 
 130 :