Télécharger nmatst.eso

Retour à la liste

nmatst
C NMATST    SOURCE    CHAT      05/01/13    01:57:42     5004
 
C=======================================================================
C=                          N M A T S T                                =
C=                          -----------                                =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=   Calcul de la matrice N contenant les fonctions de forme de l'ele- =
C=   ment fini au point de Gauss considere, matrice N intervenant lors =
C=   du calcul de la matrice MASSE et aussi lors du calcul des forces  =
C=   nodales equivalentes a une densite de forces volumiques (CNEQ).   =
C=                                                                     =
C=  Parametres :  (E)=Entree  (S)=Sortie                               =
C=  ------------                                                       =
C=   IGAU     (E)   Numero du point de Gauss considere                 =
C=   ITEL     (E)   Type de l'element fini (cf. NOMTP dans bdata.eso)  =
C=   MFR      (E)   Formulation associee a l'element fini              =
C=   NBNO     (E)   Nombre de noeuds de l'element fini                 =
C=   LRE      (E)   Nombre de DDL de l'element fini                    =
C=   IFOU     (E)   Mode de calcul utilise (cf. IFOUR dans CCOPTIO)    =
C=   NIFOU    (E)   Numero du mode de Fourier (si IFOU=1)              =
C=   NST      (E)   Nombre de lignes de la matrice N                   =
C=   DIM3     (E)   Epaisseur dans l'hypothese des contraintes planes  =
C=   XEL      (E)   Coordonnees des noeuds de l'element fini etudie    =
C=   SHPTOT   (E)   Fonctions de forme et leurs derivees               =
C=   SHP      (S)   Fonctions de forme et leurs derivees actuelles     =
C=   XGENE    (S)   Matrice des fcts de forme (N) au point de Gauss    =
C=   DJAC     (S)   Jacobien au point de Gauss etudie                  =
C=   XDPGE,YDPGE   (E)   Coordonnees du noeud support (mode PLAN GENE) =
C=                                                                     =
C=  Remarque :                                                         =
C=  ----------                                                         =
C=   Lors de l'entree dans le sous-programme, SHPTOT(2 a 4,*) contient =
C=   les DERIVEES des fonctions de forme par rapport aux coordonnees   =
C=   de REFERENCE Qsi,Eta,Dzeta.                                       =
C=   En sortie du sous-programme, SHP(2 a 4,*) contient les DERIVEES   =
C=   des fonctions de FORME par rapport aux coordonnees REELLES x,y,z. =
C=======================================================================
 
      SUBROUTINE NMATST (IGAU,ITEL,MFR,NBNO,LRE,IFOU,NIFOU,NST,DIM3,
     .                   XEL,SHPTOT,SHP,XGENE,DJAC,XDPGE,YDPGE)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC CCREEL
 
      PARAMETER (XUn=1.,XUndemi=0.5)
 
      DIMENSION XEL(3,*),XGENE(NST,*),SHP(6,*),SHPTOT(6,NBNO,*)
      DIMENSION BB(9),XX(3),YY(3)
 
      DATA XX / 0.5,0.0,0.5 /
      DATA YY / 0.0,0.5,0.5 /
 
      CALL ZERO(XGENE,NST,LRE)
 
      IF (ITEL.EQ.28) GOTO 28
 
C  1 - Elements MASSIFS en MECANIQUE
C ===================================
      IFR=IFOU+4
      GOTO (100,110,110,120,130,140,150,150,150,150,
     .      150,150,150,150,150,160,160,160,170     ),IFR
      RETURN
C =====
C  1.1 - Elements MASSIFS/JOINTS 2D PLAN GENE
C =====
 100  IF (ITEL.EQ.85.OR.ITEL.EQ.168.OR.ITEL.EQ.169) GOTO 110
      XXX=XZero
      YYY=XZero
      DO NP=1,NBNO
        SHP(1,NP)=SHPTOT(1,NP,IGAU)
        SHP(2,NP)=SHPTOT(2,NP,IGAU)
        SHP(3,NP)=SHPTOT(3,NP,IGAU)
        XXX=XXX+(SHP(1,NP)*XEL(1,NP))
        YYY=YYY+(SHP(1,NP)*XEL(2,NP))
      ENDDO
      IF (ITEL.EQ.170) THEN
        IDIM=1
        NBNOS=NBNO/2
        XXX=XUnDemi*XXX
        YYY=XUnDemi*YYY
        CALL DEVOLU(XEL,SHP,MFR,NBNOS,IFOU,NIFOU,IDIM,DIM3,RR,DJAC)
      ELSE
        IDIM=2
        CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NIFOU,IDIM,DIM3,RR,DJAC)
      ENDIF
      K=0
      NNN=NST-1
      DO NP=1,NBNO
        DO INST=1,NNN
          XGENE(INST,K+INST)=SHP(1,NP)
        ENDDO
        K=K+NNN
      ENDDO
      XGENE(3,K+1)=XUn
      XGENE(3,K+2)=XDPGE-XXX
      XGENE(3,K+3)=YYY-YDPGE
      RETURN
C =====
C  1.2 - Elements MASSIFS/JOINTS 2D PLAN DEFO ou PLAN CONT
C =====
 110  DO NP=1,NBNO
        SHP(1,NP)=SHPTOT(1,NP,IGAU)
        SHP(2,NP)=SHPTOT(2,NP,IGAU)
        IF (ITEL.NE.85) SHP(3,NP)=SHPTOT(3,NP,IGAU)
      ENDDO
      IDIM=2
      IF (ITEL.EQ.48.OR.ITEL.EQ.85.OR.ITEL.EQ.170) IDIM=1
      IF (ITEL.EQ.85.OR.ITEL.EQ.170.OR.ITEL.EQ.168.OR.ITEL.EQ.169) THEN
        NBNOS=NBNO/2
        CALL DEVOLU(XEL,SHP,MFR,NBNOS,IFOU,NIFOU,IDIM,DIM3,RR,DJAC)
      ELSE
        CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NIFOU,IDIM,DIM3,RR,DJAC)
      ENDIF
C  NST = 2 POUR MASSIFS MECA ET 2 POUR MASSIF FLUIDES
C  NST = 3 POUR SURFACE LIBRE
      K=0
      DO NP=1,NBNO
        DO INST=1,NST
          XGENE(INST,K+INST)=SHP(1,NP)
        ENDDO
        K=K+NST
      ENDDO
      RETURN
C =====
C  1.3 - Elements MASSIFS/JOINTS 2D AXISymetrique
C =====
 120  DO NP=1,NBNO
        SHP(1,NP)=SHPTOT(1,NP,IGAU)
        SHP(2,NP)=SHPTOT(2,NP,IGAU)
        IF (ITEL.NE.85) SHP(3,NP)=SHPTOT(3,NP,IGAU)
      ENDDO
      IF (ITEL.EQ.85) THEN
        IDIM=1
        NBNOS=NBNO/2
        CALL DEVOLU(XEL,SHP,MFR,NBNOS,IFOU,NIFOU,IDIM,DIM3,RR,DJAC)
      ELSE
        IDIM=2
        IF (ITEL.EQ.48) IDIM=1
        CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NIFOU,IDIM,DIM3,RR,DJAC)
      ENDIF
C  NST = 2 POUR MASSIFS MECA ET 2 POUR MASSIF FLUIDES
C  NST = 3 POUR SURFACE LIBRE
      K=0
      DO NP=1,NBNO
        DO INST=1,NST
          XGENE(INST,K+INST)=SHP(1,NP)
        ENDDO
        K=K+NST
      ENDDO
      RETURN
C =====
C  1.4 - Elements MASSIFS 2D FOURIER
C =====
 130  DO NP=1,NBNO
        SHP(1,NP)=SHPTOT(1,NP,IGAU)
        SHP(2,NP)=SHPTOT(2,NP,IGAU)
        SHP(3,NP)=SHPTOT(3,NP,IGAU)
      ENDDO
      IDIM=2
      IF (ITEL.EQ.48) IDIM=1
      CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NIFOU,IDIM,DIM3,RR,DJAC)
C  NST = 3 POUR MASSIFS MECA ET 2 POUR MASSIF FLUIDES
C  NST = 3 POUR SURFACE LIBRE
      K=0
      DO NP=1,NBNO
        DO INST=1,NST
          XGENE(INST,K+INST)=SHP(1,NP)
        ENDDO
        K=K+NST
      ENDDO
      RETURN
C =====
C  1.5 - Elements MASSIFS/JOINTS 3D
C =====
 140  DO NP=1,NBNO
        SHP(1,NP)=SHPTOT(1,NP,IGAU)
        SHP(2,NP)=SHPTOT(2,NP,IGAU)
        SHP(3,NP)=SHPTOT(3,NP,IGAU)
        IF (ITEL.NE.87.AND.ITEL.NE.88) SHP(4,NP)=SHPTOT(4,NP,IGAU)
      ENDDO
      IF (ITEL.EQ.87.OR.ITEL.EQ.88.OR.ITEL.EQ.171.OR.ITEL.EQ.172) THEN
        IDIM=2
        NBNOS=NBNO/2
        CALL DEVOLU(XEL,SHP,MFR,NBNOS,IFOU,NIFOU,IDIM,DIM3,RR,DJAC)
      ELSE
        IDIM=3
        IF (ITEL.EQ.53.OR.ITEL.EQ.54) IDIM=2
        CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NIFOU,IDIM,DIM3,RR,DJAC)
      ENDIF
C  NST = 3 POUR MASSIFS MECA ET 2 POUR MASSIF FLUIDES
C  NST = 3 POUR JOINTS TRIDIM
C  NST = 3 POUR SURFACE LIBRE
      K=0
      DO NP=1,NBNO
        DO INST=1,NST
          XGENE(INST,K+INST)=SHP(1,NP)
        ENDDO
        K=K+NST
      ENDDO
      RETURN
C =====
C  1.6 - Elements MASSIFS 1D
C =====
C= 1.6.1 - Modes 1D PLAN
 150  DO NP=1,NBNO
        SHP(1,NP)=SHPTOT(1,NP,IGAU)
        SHP(2,NP)=SHPTOT(2,NP,IGAU)
      ENDDO
      IDIM=1
      CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NIFOU,IDIM,DIM3,RR,DJAC)
      DO NP=1,NBNO
        XGENE(1,NP)=SHP(1,NP)
      ENDDO
      IF (IFOU.GE.7) THEN
        XGENE(2,NP)=XUn
        IF (IFOU.EQ.11) XGENE(3,NP+1)=XUn
      ENDIF
      RETURN
C= 1.6.2 - Modes 1D AXIS
 160  DO NP=1,NBNO
        SHP(1,NP)=SHPTOT(1,NP,IGAU)
        SHP(2,NP)=SHPTOT(2,NP,IGAU)
      ENDDO
      IDIM=1
      CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NIFOU,IDIM,DIM3,RR,DJAC)
      DO NP=1,NBNO
        XGENE(1,NP)=SHP(1,NP)
      ENDDO
      IF (IFOU.EQ.14) XGENE(2,NP)=XUn
      RETURN
C= 1.6.3 - Mode 1D SPHE
 170  DO NP=1,NBNO
        SHP(1,NP)=SHPTOT(1,NP,IGAU)
        SHP(2,NP)=SHPTOT(2,NP,IGAU)
      ENDDO
      IDIM=1
      CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NIFOU,IDIM,DIM3,RR,DJAC)
      DO NP=1,NBNO
        XGENE(1,NP)=SHP(1,NP)
      ENDDO
      RETURN
 
C  2 - Element COQUE DKT en MECANIQUE
C ====================================
 28   DO NP=1,NBNO
        SHP(1,NP)=SHPTOT(1,NP,IGAU)
        SHP(2,NP)=SHPTOT(2,NP,IGAU)
        SHP(3,NP)=SHPTOT(3,NP,IGAU)
      ENDDO
      CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NIFOU,2,DIM3,RR,DJAC)
      K=1
      DO NP=1,NBNO
        XGENE(1,K  )=SHP(1,NP)
        XGENE(2,K+1)=SHP(1,NP)
        K=K+6
      ENDDO
      CALL MFDKT(XX(IGAU),YY(IGAU),XEL,BB)
      KK=3
      IA=1
      DO NP=1,3
        XGENE(3,KK  )=BB(IA  )
        XGENE(3,KK+1)=BB(IA+1)
        XGENE(3,KK+2)=BB(IA+2)
        KK=KK+6
        IA=IA+3
      ENDDO
      RETURN
 
      END
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales