Sources Esope | Cast3M

intcn1
C INTCN1    SOURCE    CB215821  19/08/20    21:18:36     10287          
      SUBROUTINE INTCN1(IPVANO,IPGEOM,IPINTE,IPVAEQ)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
************************************************************************
*
*                             I N T C N 1
*                             -----------
*
* FONCTION:
* ---------
*     INTEGRATION NUMERIQUE DANS UN DOMAINE UNIDIMENSIONNEL DU PRODUIT:
*                     COEF. * TRANSPOSEE( N )
*     COEF. : GRANDEUR PHYSIQUE REPRESENTEE PAR UN CHAMELEM
*     N     : FONCTIONS DE FORME DE L'ELEMENT MAILLANT LE DOMAINE
*             CONSIDERE
*
* MODULES UTILISES:
* -----------------
*
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC SMCHAML
-INC SMELEME
-INC SMINTE
-INC SMCOORD
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
* -----------
*
*     IPVANO  (E)  POINTEUR SUR UN SEGMENT MELVAL CONTENANT LES
*                  VALEURS NODALES DE NOTRE COEFFICIENT
*     IPGEOM  (E)  POINTEUR SUR UN OBJET MAILLAGE ELEMENTAIRE
*                  DU DOMAINE D'INTEGRATION
*     IPINTE  (E)  POINTEUR SUR UN SEGMENT MINTE CONTENANT LES
*                  CARACTERISTIQUES D'INTEGRATION DES FACES
*    +IDIM    (E)  VOIR CCOPTIO
*    +XZERO   (E)  VOIR CCREEL
*    +XPETIT  (E)  VOIR CCREEL
*     IPVAEQ  (S)  POINTEUR SUR UN SEGMENT MELVAL CONTENANT LES VALEURS
*                  NODALES EQUIVALENTES (APRES INTEGRATION NUMERIQUE)
*
* VARIABLES:
* ----------
*
*     XE(3,NBPTEL)  =  CORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL
*     FACE          =  LONGUEUR DE DE L'ELEMENT CONSIDERE
*     A             =  TABLEAU DE TRAVAIL
*
      SEGMENT,MMAT1
         REAL*8 XE(3,NBPTEL),A(NBPTEL,NBPTEL),SHP(6,NBPTEL)
      ENDSEGMENT
*
* CONSTANTES:
* -----------
*
      PARAMETER ( O1=1.D0 )
      PARAMETER ( O2=2.D0 )
*
* REMARQUES:
* ----------
*
*     L'UTILISATION DE CE S-P PRESUPPOSE UN PRE ET POST-TRAITEMENT
*     DES SEGMENTS MELVAL PASSES EN TANT QUE PARAMETRES
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     DENIS ROBERT,LE 15 AVRIL 1988.
*
* LANGAGE:
* --------
*
*     ESOPE + FORTRAN77
*
************************************************************************
      IF (IDIM.EQ.3) THEN
*
*        OPTION INDISPONIBLE
*
         CALL ERREUR(19)
         RETURN
      ENDIF
*
*     ON RECUPERE LES VALEURS NODALES DU COEFFICIENT
*
      MELVA1=IPVANO
      SEGACT,MELVA1
      NBPTE1=MELVA1.VELCHE(/1)
      NEL1=MELVA1.VELCHE(/2)
*
*     ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION DES FACES
*
      MINTE=IPINTE
      SEGACT,MINTE
      NBPGAU=POIGAU(/1)
*
*     ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
*
      MELEME=IPGEOM
      SEGACT,MELEME
      NBPTEL=NUM(/1)
      NEL=NUM(/2)
*
*     INITIALISATION DU MELVAL QUI CONTIENDRA LES VALEURS EQUIVALENTES
*
      N1PTEL=NBPTEL
      N1EL=NEL
      N2PTEL=0
      N2EL=0
      SEGINI,MELVAL
      IPVAEQ=MELVAL
      SEGINI,MMAT1
*
*     BOUCLE SUR LES ELEMENTS
*
      DO 10 IEL=1,NEL
*
*        ON CHERCHE LES COORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL
*
         CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XE)
*
*        CALCUL DE LA LONGUEUR DE LA FACE CONSIDEREE
*
C         DLX=XZERO
C         DLY=XZERO
C         DO 20 IGAU=1,NBPGAU
C            DLONX=XZERO
C            DLONY=XZERO
C            DO 30 INOE=1,NBPTEL
C               DLONX=DLONX+SHPTOT(2,INOE,IGAU)*XE(1,INOE)
C               DLONY=DLONY+SHPTOT(2,INOE,IGAU)*XE(2,INOE)
C 30            CONTINUE
C*           END DO
CC            DLX=DLX+DLONX*POIGAU(IGAU)
CC            DLY=DLY+DLONY*POIGAU(IGAU)
C             DLX= DLONX
C            DLY= DLONY
C 20         CONTINUE
C*        END DO
C         FACE=SQRT(DLX**2+DLY**2)
*
*        BOUCLES SUR LES POINTS DE GAUSS ET SUR LES NOEUDS
*
         CALL ZERO(A,NBPTEL,NBPTEL)
         DO 40 IGAU=1,NBPGAU
         DLX=XZERO
         DLY=XZERO
            DLONX=XZERO
            DLONY=XZERO
            DO 30 INOE=1,NBPTEL
               DLONX=DLONX+SHPTOT(2,INOE,IGAU)*XE(1,INOE)
               DLONY=DLONY+SHPTOT(2,INOE,IGAU)*XE(2,INOE)
 30            CONTINUE
*           END DO
C            DLX=DLX+DLONX*POIGAU(IGAU)
C            DLY=DLY+DLONY*POIGAU(IGAU)
             DLX= DLONX
             DLY= DLONY
 
*        END DO
         FACE=SQRT(DLX**2+DLY**2)
            AXIS=O1
            IF (IFOMOD.EQ.0) THEN
*
*              CAS DES ELEMENTS AXISYMETRIQUES
*
               DO 41 NP=1,NBPTEL
                  SHP(1,NP)=SHPTOT(1,NP,IGAU)
                  SHP(2,NP)=SHPTOT(2,NP,IGAU)
                  SHP(3,NP)=SHPTOT(3,NP,IGAU)
 41               CONTINUE
*              END DO
               CALL DISTRR(XE,SHP,NBPTEL,RR)
               AXIS=O2*XPI*RR
            ENDIF
            DO 50 INOE=1,NBPTEL
               DO 60 INO2=1,NBPTEL
                  A(INOE,INO2)=A(INOE,INO2)+SHPTOT(1,INOE,IGAU)*
     1            SHPTOT(1,INO2,IGAU)*POIGAU(IGAU)*AXIS*FACE
 60               CONTINUE
*              END DO
 50            CONTINUE
*           END DO
 40         CONTINUE
*        END DO
         IEMIN=MIN(NEL1,IEL)
         DO 70 INOE=1,NBPTEL
            DO 80 INO2=1,NBPTEL
               INMIN=MIN(NBPTE1,INO2)
         VELCHE(INOE,IEL)=VELCHE(INOE,IEL)+MELVA1.VELCHE(INMIN,IEMIN)*
     1                    A(INO2,INOE)
 80            CONTINUE
*           END DO
 70         CONTINUE
*        END DO
 10      CONTINUE
*     END DO
      SEGSUP,MMAT1
      END