Télécharger cjfddd.eso

Retour à la liste

cjfddd
C CJFDDD    SOURCE    OF166741  25/11/04    21:15:24     12349          
 
      SUBROUTINE CJFDDD(WRK52,WRK53,WRK54,NVARI,iecou,necou,xecou)
C
C    calcule la deformation initiale a partir de la contrainte initiale
C    puis appelle la subroutine CLBCOM
C
C     variables en entree
C
C     WRK0,KRK1  pointeurs sur des segments de travail
C
C     NSTRS1      nombre de composantes dans les vecteurs des contraintes
C                                        et les vecteurs des deformations
C
C     NVARI      nombre de variables internes (doit etre egal a 4)
C
C     NMATT      nombre de constantes du materiau
C
C     ISTEP      flag utilise pour separer les etapes dans un calcul non local
C                ISTEP=0 -----> calcul local
C                ISTEP=1 -----> calcul non local etape 1 on calcule les seuils
C                ISTEP=2 -----> calcul non local etape 2 on continue le calcul
C                               a partir des seuils moyennes
C
C     variables en sortie
C
C     VARF      variables internes finales dans WRK0
C
C     SIGF      contraintes finales dans WRK0
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC DECHE
 
-INC TECOU
 
      SEGMENT WRKK2
         REAL*8 EPSILI(NSTRSV)
      END SEGMENT
 
      SEGMENT WRK6
        REAL*8 SIG0S(NSTRS1)
      END SEGMENT
 
      PARAMETER (UN=1.D0)
 
      KERRE=0
 
      NSTRS1 = iecou.NSTRSS
      IF (iecou.MFR1 .EQ. 9) THEN
         NSTRSV=4
         IFOUR2=-2
      ELSE IF (iecou.MFR1 .EQ. 1) THEN
         NSTRSV=NSTRS1
         IF (IFOURB.NE. -2)THEN
            KERRE=57
            RETURN
         END IF
         IFOUR2=necou.IFOURB
      ELSE
         KERRE=57
         RETURN
      END IF
C
C     calcul de la matrice elastique
C
      CMATE = 'ISOTROPE'
      KCAS=2
      CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,KCAS,DDHOOK,IRTD)
      IF (IRTD .NE. 1) THEN
         print*,'erreur dans dohmas'
         KERRE=56
         RETURN
      END IF
C
C      calcul de l'increment de contrainte
C
      CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1)
C
C     ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES
C
      WRK6 = 0
      IF (iecou.MFR1 .EQ. 9) THEN
        EPAI=xcarb(1)
        SEGINI WRK6
        DO ISTRS=1,NSTRS1
          SIG0S(ISTRS)=SIG0(ISTRS)
        END DO
        SIG0(1)=SIG0S(1)/EPAI
        SIG0(2)=SIG0S(2)/EPAI
        SIG0(3)=0.D0
        SIG0(4)=SIG0S(3)/EPAI
      END IF
C
C     inversion de la matrice
C
      PREC=1.D-08
      CALL INVALM(DDHOOK,NSTRSV,NSTRSV,IRTD,PREC)
      IF (IRTD.NE.0)THEN
        print*,'erreur dans invalm'
        KERRE=56
        RETURN
      END IF
 
      SEGINI,WRKK2
C
C     calcul des deformations du materiau elastique lineaire
C
      CALL MATVE1 (DDHOOK,SIG0,NSTRSV,NSTRSV,EPSILI,1)
C
C     modification pour tenir compte de l'endommagement
C
      DO ISTRS=1,NSTRSV
        EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
      ENDDO
C
C      appel a la routine CLBCOM
C
      icarbi=iecou.icara
      CALL CJFDEC(WRK52,WRK53,WRK54,WRKK2,NSTRSV,NVARI,icarbi,xecou)
C
C      ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES
C
      IF (iecou.MFR1 .EQ. 9) THEN
        DO ISTRS=1,NSTRS1
          SIG0(ISTRS)=SIG0S(ISTRS)
        END DO
        SIGF(1)=SIGF(1)*EPAI
        SIGF(2)=SIGF(2)*EPAI
        SIGF(3)=SIGF(4)*EPAI
        DO ISTRS=4,NSTRS1
          SIGF(ISTRS)=SIG0(ISTRS)+DSIGT(ISTRS)
        END DO
        SEGSUP WRK6
      END IF
      SEGSUP WRKK2
 
      RETURN
      END
 
 
 

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