Sources Esope | Cast3M

renoeu
C RENOEU    SOURCE    OF166741  24/07/25    21:15:03     11950          
      SUBROUTINE RENOEU(IELE,MELE,NBSH,IPT,IRET)
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     IELE  =NUMERO DE L ELEMENT DANS NOMS (VOIR CCGEOME )
C     MELE  =NUMERO DE L ELEMENT DANS NOMTP
C     NBSH  =NOMBRE DE FONCTIONS D'INTERPOLATION
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 INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCGEOME
-INC SMINTE
 
-INC PPARAM
-INC CCOPTIO
      SEGMENT SHXX 
       REAL*8 SHPXXX(6,NBB)
      ENDSEGMENT
      DIMENSION IMIPOR(5)
C
      DATA IMIPOR/4,8,14,23,16/
C
      IRET=1
      NBBB=NBNNE(IELE)
*
*     CAS PARTICULIER  ELEMENT TUYO
*
      IF(MELE.EQ.96) NBBB=24
*
*
*     CAS PARTICULIER  ELEMENT POLYGONE
*
      IF(MELE.GE.111.AND.MELE.LE.122) NBBB=NBSH
*
      NBNO=NBSH
      CALL DONOEU(IELE,MELE,NBSH,NBBB,IPT1,IRT1)
      IF (IRT1.EQ.1) GOTO 10
C
C     MESSAGE D ERREUR  ELEMENT IELE NON IMPLEMENTE DANS DONOEU
C
      MOTERR(1:4)=NOMS(IELE)
      CALL ERREUR(74)
      IRET=0
      GOTO 666
  10  CONTINUE
      MINTE=IPT1
      SEGACT MINTE*MOD
C
      DO 110 IA=1,NBBB
      DO 111 IB=1,6
      DO 112 IC=1,NBNO
         SHPTOT(IB,IC,IA)=0.D0
 112  CONTINUE
 111  CONTINUE
 110  CONTINUE
      NBB=NBNO
      SEGINI SHXX
      DO 100 II=1,NBBB
C     INSERER EVENTUELLEMENT UN INDICATEUR DE SUCCES
      XX=QSIGAU(II)
      YY=ETAGAU(II)
      ZZ=DZEGAU(II)
      IF(MELE.EQ.96) THEN
        CALL SHAP96(XX,YY,ZZ,IELE,SHPXXX,IRT2)
      ELSEIF ((MELE.GE.111).AND.(MELE.LE.122)) THEN
        CALL SHPOLY(XX,YY,ZZ,MELE,SHPXXX,IRT2)
      ELSEIF(mele.eq.260) then
         call shshb8(xx,shpxxx)
         irt2=1
      ELSE
        CALL SHAPE(XX,YY,ZZ,IELE,SHPXXX,IRT2)
      ENDIF
C
C  TRAITEMENT SPECIAL MILIEU POREUX
C
      IF(MELE.GE.79.AND.MELE.LE.83) THEN
      CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-78),
     .           SHPXXX(1,NBBB+1),IRT2)
*
      ELSE IF(MELE.GE.173.AND.MELE.LE.177) THEN
      CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-172),
     .           SHPXXX(1,NBBB+1),IRT2)
*
      ELSE IF(MELE.GE.178.AND.MELE.LE.182) THEN
      CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-177),
     .           SHPXXX(1,NBBB+1),IRT2)
*
      ENDIF
C
      DO 200 ID=1,6
         DO 201  NO=1,NBNO
            SHPTOT(ID,NO,II)=SHPXXX(ID,NO)
 201     CONTINUE
 200  CONTINUE
 100  CONTINUE
C
C     APPEL AU CALCULE DES FONCTIONS D EXTRAPOLATIONS
C
      if(mele.ne.260) CALL EXTRAP(SHPTOT,NBBB,NBBB,NBNO)
C
      SEGSUP SHXX
      IF (IRT2.EQ.1) GOTO 20
C
C     ERREUR LES FONCTIONS DE FORME PAS ENCORE IMPLEMENTEES
C
      MOTERR(1:4)=NOMS(IELE)
      CALL ERREUR(68)
      IRET=0
      SEGSUP MINTE
      GOTO 666
  20  IPT=IPT1
  666 CONTINUE
      END