Sources Esope | Cast3M

fpcoq8
C FPCOQ8    SOURCE    OF166741  25/02/21    21:16:35     12166          
      SUBROUTINE FPCOQ8(IPTVPR,IPMAIL,IPTINT,IVACAR,IPTNOE,IVAFOR)
*______________________________________________________________________
*
*   CALCULE LES FORCES DE PRESSION AUX NOEUDS DES COQUES COQ8 ,COQ6
*
*
*  ENTREES :
*  ---------
*
*       IPTVPR  POINTEUR SUR LE CHAMELEM DES PRESSIONS         (actif)
*       IPMAIL  POINTEUR LE MAILLAGE                           (actif)
*       IPTINT  POINTEUR SUR LE CHAMELEM DE L'INTEGRATION
*               (SEGMENT ACTIF EN ENTREE, NON MODIFIE EN SORTIE)
*       IVACAR  POINTEUR SUR UN SEGMENT MPTVAL CONCERNANT LES CARA-
*                CTERISTIQUES (EPAISSEUR AUX NOEUDS)
*       IPTNOE  POINTEUR SUR L'ALIAS DU CHAMELEM D'INTEGRATION CONTENANT
*                LES FONCTIONS DE FORME AUX NOEUDS
*       IVAFOR  POINTEUR SUR UN MPTVAL ET MELVALS ASSOCIEES AUX FORCES
*                ET MOMENTS AUX NOEUDS
*
*   PASSAGE AUX NOUVEAU CHAMELEM PAR JM CAMPENON LE 13 09 90
*
*_______________________________________________________________________
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMCHAML
-INC SMELEME
-INC SMINTE
-INC SMCOORD
 
-INC TMPTVAL
 
      DIMENSION TH(8),VNGAU(3),XJ(3,3),TXR(3,3,8),XE(3,8)
*
      MELVA1=IPTVPR
*
      MINTE=IPTINT
c*    SEGACT MINTE                               &lt;- Actif en E/S
      NBPGAU=POIGAU(/1)
      NBGAU2=NBPGAU/2
*
      MINTE1=IPTNOE
      SEGACT MINTE1
*
      MELEME=IPMAIL
      NBELEM=NUM(/2)
      NBNN=NUM(/1)
*
*     BOUCLE SUR LES ELEMENTS
*
      DO 1 IB=1,NBELEM
*
*        CALCUL DE L'INDICE D'ORIENTATION DE LA COQUE % PRESSION
*        DANS FPCOQU LES ELEMENTS SONT REORIENTES EN FONCTION DU VECTEUR
*         DIRECTIONNEL DE LA PRESSION DONC LA PRESSION EST APPLIQUEE
*        SUR LA FACE -1
*
         ZETA=-1.D0
*
*        CALCUL DE L EPAISSEUR MOYENNE
*          CALCUL DE TH(IPTELE)
*
         EPAI=0.D0
         MPTVAL=IVACAR
         MELVAL=IVAL(1)
         IBMN=MIN(IB,VELCHE(/2))
         IF(VELCHE(/1).EQ.1) EPAI=VELCHE(1,IBMN)
         IF(VELCHE(/1).GT.1) THEN
            DO 2 I=1,VELCHE(/1)
               EPAI=EPAI+VELCHE(I,IBMN)
  2         CONTINUE
            EPAI=EPAI/VELCHE(/1)
         ENDIF
         DO 3 J=1,NBNN
            TH(J)=EPAI
 3       CONTINUE
*
*        DETERMINATION DES REPERES LOCAUX AUX NOEUDS
*
         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
         CALL CQ8LOC(XE,NBNN,MINTE1.SHPTOT,TXR,IRR)
*
*       BOUCLE SUR LES POINTS DE GAUSS
*
         IBMN=MIN(IB,MELVA1.VELCHE(/2))
         DO 10 IGAU=1,NBGAU2
            IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
            PRE=MELVA1.VELCHE(IGMN,IBMN)
*
*           VECTEUR NORMAL A LA SURFACE DE L ELEMENT AU PT DE GAUSS IGAU
*           NE PAS NORMALISER LE VECTEUR CAR IL INTEGRE L'ELEMENT
*           DE SURFACE POUR L'INTEGRATION
*
            CALL COQ8JC(IGAU,NBNN,ZETA,XE,TH,TXR,SHPTOT,XJ,DET,IRR)
            VNGAU(1)=XJ(1,2)*XJ(2,3)-XJ(2,2)*XJ(1,3)
            VNGAU(2)=XJ(1,3)*XJ(2,1)-XJ(2,3)*XJ(1,1)
            VNGAU(3)=XJ(1,1)*XJ(2,2)-XJ(2,1)*XJ(1,2)
*
*           BOUCLE SUR NOEUDS DE L'ELEMENT
*
            MPTVAL=IVAFOR
            DO 20 J=1,NBNN
*
*              FORCES AUX NOEUDS
*
               WGTF=POIGAU(IGAU)*PRE
               MELVAL=IVAL(1)
               VELCHE(J,IB)=VELCHE(J,IB)+WGTF*SHPTOT(1,J,IGAU)*VNGAU(1)
               MELVAL=IVAL(2)
               VELCHE(J,IB)=VELCHE(J,IB)+WGTF*SHPTOT(1,J,IGAU)*VNGAU(2)
               MELVAL=IVAL(3)
               VELCHE(J,IB)=VELCHE(J,IB)+WGTF*SHPTOT(1,J,IGAU)*VNGAU(3)
*
*                                                      (V2JT)
*     MOMENTS AUX NDS = 0.5*ZETA*WT*P*TH(J)* (V1J,-V2J)(V1JT) *(VNGAU)
*
*              CALCUL DE LA MATRICE DE PASSAGE NOTEE XJ(3,3)
*
               DO 50 I=1,3
                  XJ(I,I)=0.
  50           CONTINUE
               XJ(1,2) = TXR(1,1,J)*TXR(2,2,J)-TXR(2,1,J)*TXR(1,2,J)
               XJ(1,3) = TXR(1,1,J)*TXR(3,2,J)-TXR(1,2,J)*TXR(3,1,J)
               XJ(2,3) = TXR(2,1,J)*TXR(3,2,J)-TXR(2,2,J)*TXR(3,1,J)
               DO 51 I=1,3
                  DO 51 L=I,3
                     XJ(L,I) = -XJ(I,L)
   51          CONTINUE
*
*              VALEURS DES MOMENTS AUX NOEUDS
*
               WGTM=0.5D0*ZETA*TH(J)*POIGAU(IGAU)*PRE
*
               DO 60 I=1,3
      MELVAL=IVAL(4)
      VELCHE(J,IB)=VELCHE(J,IB)+WGTM*SHPTOT(1,J,IGAU)*XJ(I,1)*VNGAU(I)
      MELVAL=IVAL(5)
      VELCHE(J,IB)=VELCHE(J,IB)+WGTM*SHPTOT(1,J,IGAU)*XJ(I,2)*VNGAU(I)
      MELVAL=IVAL(6)
      VELCHE(J,IB)=VELCHE(J,IB)+WGTM*SHPTOT(1,J,IGAU)*XJ(I,3)*VNGAU(I)
   60          CONTINUE
   20       CONTINUE
   10    CONTINUE
   1  CONTINUE
 
c*    SEGDES MINTE                               &lt;- Actif en E/S
      SEGDES MINTE1
*  Segment supprime dans fpcoqu.eso
c*      SEGSUP MELVA1
 
      RETURN
      END