C RESHPX    SOURCE    BP208322  16/11/18    21:20:58     9177           
C 20.04.2005
C
      SUBROUTINE RESHPX(NBG,NBSH,IELE,MELE,NPINT,IPT,IRT)
C
C=====================================================================
C     MET LES VALEURS DES FONCTIONS DE FORMES DANS SHPTOT
C      ET LES COORDOONEES REDUITES+LES POIDS D INTEGRATION
C      DANS QSIGAU ETAGAU DZEGAU POIGAU  ; LE TOUT EST
C      MIS DANS LE POINTEUR MINTE SON POINTEUR EST IPT
C     NNN   =NOMBRE DE POINTS DE GAUSS
C     NBSH  =NOMBRE DE FONCTIONS D'INTERPOLATION
C     IELE  =NUMERO DE L ELEMENT DANS NOMS (VOIR CCGEOME )
C     MELE  =NUMERO DE L ELEMENT DANS NOMTP
C    NPINT=NOMBRE DE POINTS D'INTEGRATION DONS LE CAS DES
C          ELEMENTS COQUES INTEGRES
C     IPT   = POINTEUR  SUR MINTE
C     IRET=1  OU  0  SUIVANT QUE MINTE A ETE CREEE OU PAS
C
C     CETTE ROUTINE GERE LES MESSAGES D ERREURS
C     PROVENANT DE L INCOMPATIBILTE ENTRE NOMS
C     D ELEMENTS,NOMBRE DE POINTS DE GAUSS,ET FONCTIONS DE FORME
C=====================================================================
C
      IMPLICIT REAL*8(A-H,O-Z)
C
-INC CCREEL
-INC CCGEOME
-INC SMINTE

-INC PPARAM
-INC CCOPTIO
c
c
      INTEGER     NBG,NBSH,IELE,MELE,NPINT,IRET
      INTEGER     NBNN,NBPGAU,NBNO,II,JJ,KK,KGAU,IENR,NBENR,INI
c      REAL*8      DELTAQSI,QSI0,ETA0
C
      PARAMETER   (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0)
      PARAMETER   (TROIS=3.D0,QUATRE=4.D0,HUIT=8.D0)
C
      PARAMETER   (NGAUMAX=8)
C
      REAL*8 QSIREF(NGAUMAX),ETAREF(NGAUMAX),POIREF(NGAUMAX)
      REAL*8 DZEREF(NGAUMAX)
      REAL*8 QSI,ETA,DELTAQSI,QSI0,ETA0
      REAL*8 DZE,DZE0
      REAL*8 SHP1,SHP2,SHP3,SHP4,SHP1Q,SHP2Q,SHP3Q,SHP4Q
      REAL*8 SHP5,SHP6,SHP7,SHP8,SHP5Q,SHP6Q,SHP7Q,SHP8Q
      REAL*8 SHP1E,SHP2E,SHP3E,SHP4E
      REAL*8 SHP5E,SHP6E,SHP7E,SHP8E
      REAL*8 SHP1D,SHP2D,SHP3D,SHP4D
      REAL*8 SHP5D,SHP6D,SHP7D,SHP8D
C
C

      DATA X577/.577350269189626D0/

C
      IF (IDIM.EQ.2) THEN
c
        if (MELE.eq.263) then
C++++++++ QUADRANGLE  A 4 NOEUDS
          NBNN = 4
          NGAU = 4
          QSIREF(1)=-X577
          QSIREF(2)= X577
          QSIREF(3)= X577
          QSIREF(4)=-X577
          ETAREF(1)=-X577
          ETAREF(2)=-X577
          ETAREF(3)= X577
          ETAREF(4)= X577
          POIREF(1)= UN
          POIREF(2)= UN
          POIREF(3)= UN
          POIREF(4)= UN
         endif
c
      ENDIF
c
C
      IF (IDIM.EQ.3) THEN
c
        if (MELE.eq.264) then
C++++++++ CUBE  A 8 NOEUDS
          NBNN = 8
          NGAU = 8
          QSIREF(1)=-X577
          QSIREF(2)= X577
          QSIREF(3)= X577
          QSIREF(4)=-X577
          QSIREF(5)=-X577
          QSIREF(6)= X577
          QSIREF(7)= X577
          QSIREF(8)=-X577
          ETAREF(1)=-X577
          ETAREF(2)=-X577
          ETAREF(3)= X577
          ETAREF(4)= X577
          ETAREF(5)=-X577
          ETAREF(6)=-X577
          ETAREF(7)= X577
          ETAREF(8)= X577
          DZEREF(1)=-X577
          DZEREF(2)=-X577
          DZEREF(3)=-X577
          DZEREF(4)=-X577
          DZEREF(5)= X577
          DZEREF(6)= X577
          DZEREF(7)= X577
          DZEREF(8)= X577
          POIREF(1)= UN
          POIREF(2)= UN
          POIREF(3)= UN
          POIREF(4)= UN
          POIREF(5)= UN
          POIREF(6)= UN
          POIREF(7)= UN
          POIREF(8)= UN
c
        endif
c
      ENDIF

C
C=====================================================================
C     INITIALISATIONS
C
      NBPGAU= NBG
      NBNO  = NBSH
      SEGINI,MINTE
      IPT  = MINTE
      IRET=1
C
      NBENR = NBSH/NBNN
C
C=====================================================================
C     EN 2D SOUS DECOUPAGE  EN  NBSSEF Q4  A 4 POINT DE GAUSS
C     EN 3D SOUS DECOUPAGE  EN  NBSSEF CUB8  A 8 POINT DE GAUSS
      IF(MOD(NBG,NBNN).NE.0)
     $ WRITE(*,*) 'NOMBRE DE PT DE GAUSS INDIVISIBLE PAR 4(2D) ou 8(3D)'
      XDIM = 1./IDIM
      NBSSEF =  NINT( (NBG / NBNN)**(XDIM) )
C     NBSSEF =  NINT( (NBG / NBNN)**(1/IDIM) )
C     WRITE(*,*) 'TY',IDIM,XDIM,NBG,NBNN,NBSSEF
      IF((NBNN*(NBSSEF**IDIM)).NE.NBG)
     $      WRITE(*,*) 'NOMBRE DE PT DE GAUSS INCORRECT'
C
        KGAU = 0
C        write(*,*) '--->boucle sur',NBSSEF,'^2 elements *',
C    $        NGAU,' pt de G'
C
          DELTAQSI = DEUX/(FLOAT(NBSSEF))
C         write(*,*) 'deltaqsi',deltaqsi
C
C=====================================================================
C     EN 2D SOUS DECOUPAGE  EN  NBSSEF Q4  A 4 POINT DE GAUSS
       IF (IDIM.EQ.2) THEN

C*********  boucle sur les lignes  *********
        DO JJ=1,NBSSEF
C********* boucle sur les colonnes *********
        DO II=1,NBSSEF
C
C         coordonnees au centre du sous element
          QSI0 = DELTAQSI*(FLOAT(II)-UNDEMI) - UN
          ETA0 = DELTAQSI*(FLOAT(JJ)-UNDEMI) - UN
C
C***** boucle sur les pts de gauss du Pseudo-sous element *****
        DO KK=1,NGAU
          KGAU = KGAU + 1
C         calcul des coordonnees + poids
          QSIGAU(KGAU) = (UNDEMI*DELTAQSI*QSIREF(KK)) + QSI0
          ETAGAU(KGAU) = (UNDEMI*DELTAQSI*ETAREF(KK)) + ETA0
          POIGAU(KGAU) = POIREF(KK) / (FLOAT(NBSSEF**IDIM))
c          WRITE(*,*) KGAU,QSIGAU(KGAU),ETAGAU(KGAU),POIGAU(KGAU)
        ENDDO
C** fin de boucle sur les points de gauss du sous element **
        ENDDO
C***** fin de boucle sur les colonnes ******
        ENDDO
C*******fin de boucle sur les lignes  ******

C=====================================================================
C     EN 3D SOUS DECOUPAGE  EN  NBSSEF CUB8  A 8 POINT DE GAUSS
       ELSE
c        (IDIM.EQ.3)

         JZMAX= NBSSEF
C********* boucle sur la 3eme direction *********
        DO JZ=1,JZMAX
C*********  boucle sur les lignes  *********
        DO JJ=1,NBSSEF
C********* boucle sur les colonnes *********
        DO II=1,NBSSEF
C
C         coordonnees au centre du sous element
          QSI0 = DELTAQSI*(FLOAT(II)-UNDEMI) - UN
          ETA0 = DELTAQSI*(FLOAT(JJ)-UNDEMI) - UN
          DZE0 = DELTAQSI*(FLOAT(JZ)-UNDEMI) - UN
C
C***** boucle sur les pts de gauss du Pseudo-sous element *****
        DO KK=1,NGAU
          KGAU = KGAU + 1
C         calcul des coordonnees + poids
          QSIGAU(KGAU) = (UNDEMI*DELTAQSI*QSIREF(KK)) + QSI0
          ETAGAU(KGAU) = (UNDEMI*DELTAQSI*ETAREF(KK)) + ETA0
          DZEGAU(KGAU) = (UNDEMI*DELTAQSI*DZEREF(KK)) + DZE0
          POIGAU(KGAU) = POIREF(KK) / (FLOAT(NBSSEF**IDIM))
c          WRITE(*,*) KGAU,QSIGAU(KGAU),ETAGAU(KGAU),POIGAU(KGAU)
        ENDDO
C** fin de boucle sur les points de gauss du sous element **
        ENDDO
C***** fin de boucle sur les colonnes ******
        ENDDO
C*******fin de boucle sur les lignes  ******
        ENDDO
C*******fin de boucle sur la  3eme direction  ******

       ENDIF
C
C=====================================================================

C
C=======================================================
C     ON MET LES Ni STD PARTOUT
C
C***** boucle sur les points de gauss *****
      DO 2001 KGAU=1,NBPGAU

      QSI = QSIGAU(KGAU)
      ETA = ETAGAU(KGAU)

      IF (IDIM.EQ.2) THEN

C     fonctions standards : Ni
      SHP1 = (UN-QSI)*(UN-ETA)/QUATRE
      SHP2 = (UN+QSI)*(UN-ETA)/QUATRE
      SHP3 = (UN+QSI)*(UN+ETA)/QUATRE
      SHP4 = (UN-QSI)*(UN+ETA)/QUATRE
C     dérivée des fonctions standards : Ni,qsi
      SHP1Q = (ETA-UN)/QUATRE
      SHP2Q = -SHP1Q
      SHP3Q = (ETA+UN)/QUATRE
      SHP4Q = -SHP3Q
C     dérivée des fonctions standards : Ni,eta
      SHP1E = (QSI-UN)/QUATRE
      SHP2E = -(UN+QSI)/QUATRE
      SHP3E = -SHP2E
      SHP4E = -SHP1E
C
      ELSE

      DZE = DZEGAU(KGAU)
C     fonctions standards : Ni
      SHP1 = (UN-QSI)*(UN-ETA)*(UN-DZE)/HUIT
      SHP2 = (UN+QSI)*(UN-ETA)*(UN-DZE)/HUIT
      SHP3 = (UN+QSI)*(UN+ETA)*(UN-DZE)/HUIT
      SHP4 = (UN-QSI)*(UN+ETA)*(UN-DZE)/HUIT
      SHP5 = (UN-QSI)*(UN-ETA)*(UN+DZE)/HUIT
      SHP6 = (UN+QSI)*(UN-ETA)*(UN+DZE)/HUIT
      SHP7 = (UN+QSI)*(UN+ETA)*(UN+DZE)/HUIT
      SHP8 = (UN-QSI)*(UN+ETA)*(UN+DZE)/HUIT
C     dérivée des fonctions standards : Ni,qsi
      SHP1Q = (ETA-UN)*(UN-DZE)/HUIT
      SHP2Q = -SHP1Q
      SHP3Q = (ETA+UN)*(UN-DZE)/HUIT
      SHP4Q = -SHP3Q
      SHP5Q = (ETA-UN)*(UN+DZE)/HUIT
      SHP6Q = -SHP5Q
      SHP7Q = (ETA+UN)*(UN+DZE)/HUIT
      SHP8Q = -SHP7Q
C     dérivée des fonctions standards : Ni,eta
      SHP1E = (QSI-UN)*(UN-DZE)/HUIT
      SHP2E = -(UN+QSI)*(UN-DZE)/HUIT
      SHP3E = -SHP2E
      SHP4E = -SHP1E
      SHP5E = (QSI-UN)*(UN+DZE)/HUIT
      SHP6E = -(UN+QSI)*(UN+DZE)/HUIT
      SHP7E = -SHP6E
      SHP8E = -SHP5E
C     dérivée des fonctions standards : Ni,dze
      SHP1D = (UN-QSI)*(ETA-UN)/HUIT
      SHP2D = (UN+QSI)*(ETA-UN)/HUIT
      SHP3D = -(UN+QSI)*(UN+ETA)/HUIT
      SHP4D = (QSI-UN)*(UN+ETA)/HUIT
      SHP5D = -SHP1D
      SHP6D = -SHP2D
      SHP7D = -SHP3D
      SHP8D = -SHP4D
      ENDIF


C***** boucle sur les enrichissements *****
      DO 2002 IENR=1,NBENR

      II = (IENR-1)*NBNN + 1
C     fonctions standards : Ni
      SHPTOT(1,II,KGAU) = SHP1
      SHPTOT(1,II+1,KGAU) = SHP2
      SHPTOT(1,II+2,KGAU) = SHP3
      SHPTOT(1,II+3,KGAU) = SHP4
C     dérivée des fonctions standards : Ni,qsi
      SHPTOT(2,II,KGAU) = SHP1Q
      SHPTOT(2,II+1,KGAU) = SHP2Q
      SHPTOT(2,II+2,KGAU) = SHP3Q
      SHPTOT(2,II+3,KGAU) = SHP4Q
C     dérivée des fonctions standards : Ni,eta
      SHPTOT(3,II,KGAU) = SHP1E
      SHPTOT(3,II+1,KGAU) = SHP2E
      SHPTOT(3,II+2,KGAU) = SHP3E
      SHPTOT(3,II+3,KGAU) = SHP4E
C
      IF (IDIM.EQ.3) THEN
C     fonctions standards : Ni
      SHPTOT(1,II+4,KGAU) = SHP5
      SHPTOT(1,II+5,KGAU) = SHP6
      SHPTOT(1,II+6,KGAU) = SHP7
      SHPTOT(1,II+7,KGAU) = SHP8
C     dérivée des fonctions standards : Ni,qsi
      SHPTOT(2,II+4,KGAU) = SHP5Q
      SHPTOT(2,II+5,KGAU) = SHP6Q
      SHPTOT(2,II+6,KGAU) = SHP7Q
      SHPTOT(2,II+7,KGAU) = SHP8Q
C     dérivée des fonctions standards : Ni,eta
      SHPTOT(3,II+4,KGAU) = SHP5E
      SHPTOT(3,II+5,KGAU) = SHP6E
      SHPTOT(3,II+6,KGAU) = SHP7E
      SHPTOT(3,II+7,KGAU) = SHP8E
C     dérivée des fonctions standards : Ni,dze
      SHPTOT(4,II,KGAU) = SHP1D
      SHPTOT(4,II+1,KGAU) = SHP2D
      SHPTOT(4,II+2,KGAU) = SHP3D
      SHPTOT(4,II+3,KGAU) = SHP4D
      SHPTOT(4,II+4,KGAU) = SHP5D
      SHPTOT(4,II+5,KGAU) = SHP6D
      SHPTOT(4,II+6,KGAU) = SHP7D
      SHPTOT(4,II+7,KGAU) = SHP8D
      ENDIF
C
C
 2002 CONTINUE
 2001 CONTINUE
C

C=======================================================
C     ON CALCULE LES FONCTIONS D EXTRAPOLATIONS
C
C      CALL EXTRAP(SHPTOT,NNN,NBBB,NBNO)
C
C

C=======================================================
C     ON DESACTIVE LES SEGMENTS
      SEGDES MINTE
C
      RETURN
      END