Télécharger mdcrel.eso

Retour à la liste

mdcrel
C MDCREL    SOURCE    CHAT      05/01/13    01:40:01     5004
      SUBROUTINE MDCREL(COE,COEG,BETJEF,BETFLU)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
      DIMENSION    REL(200,200),TZO(200),DUR(200),
     &             FIFLU(200,200),BRAN(8),TRO(200),
     &             AB0(200),AB(8,8),RELC(8),
     &             CZ1(8),CB0(200),CB(8,8),ELC(8),
     &             EB(8),EBFLU(8,200),EVIS(8,38),
     &             COEG(8),COE(8,8),CDB(8),CZ2(8)
C
C*******************************************************************
C TAU1     = TEMPS INITIAL POUR LE CALCUL
C            DES COEFFICIENTS DE CHAQUE BRANCHE
C TZO(M)   = DATE D'APPLICATION DE LA CHARGE
C DATCUR   = DATE DE CURE DU BETON MINIMALE
C DUR(N)   = DUREE VARIABLE D APPLICATION DE LA CHARGE
C NBRC     = NOMBRE DE BRANCHES DU MODELE DE MAXWELL LIQUIDE
C EVIS sert seulement à rendre visible toutes les valeurs de toutes les
C branches du modèle de MAXWELL
C TRO(N) = TABLEAU DU PREMIER TEMPS DE RELAXATION
C          POUR CHAQUE AGE D APPLICATION D UNE CHARGE
C*******************************************************************
C
      SEGMENT BETJEF
       REAL*8 AA,BETA,FC,ALPHA,EX,XNU,GFC,GFT,CAR,ETA,TDEF,
     &          TCON,DPSTF1,DPSTF2,TETA,PDT,TP00
       INTEGER ICT,ICC,IMOD,IVIS,ITER,
     &                ISIM,IBB,IGAU,IZON
      ENDSEGMENT
      SEGMENT BETFLU
       REAL*8 DATCOU,DATCUR,DATSEC,E28,PGTZO,PGDUR,TAU1,TAU2,
     &         TP0,TZER
       INTEGER ITYPE,IMD,NBRC,NCOE,NTZERO,NTPS,IFOR
      ENDSEGMENT
C*******************************************************************
C                  INITIALISATION
      CALL ZERO(REL,200,200)
      CALL ZERO(TZO,200,1)
      CALL ZERO(DUR,200,1)
      CALL ZERO(FIFLU,200,200)
      CALL ZERO(TRO,200,1)
C
C*******************************************************************
C DETERMINATION DES TEMPS DE RELAXATION DES BRANCHES DE MAXWELL
C*******************************************************************
C
      DO 10 N = 1,NBRC
      BRAN(N) = 0.D0
      IF (N.EQ.1) THEN
      BRAN(N) = TAU1
      ELSE
      BRAN(N) = 10**(N-2)*TAU2
      ENDIF
   10 CONTINUE
C
C*******************************************************************
C APPEL DES COURBES DE VALEURS DE RELAXATION
C*******************************************************************
C
      CALL TANSR(REL,TZO,DUR,FIFLU,TRO,BETJEF,BETFLU)
C
C NOMBRE DE VALEURS DE DUREE D APPLICATION DE LA CHARGE = NTPS1
      NTPS1 = NTPS+1
C
C INITIALISATION
C*******************************************************************
      DO 11 K1 = 1,NBRC
      DO 12 K2 = 1,NCOE
      COE(K1,K2) = 0.D0
   12 CONTINUE
   11 CONTINUE
C
C
C BOUCLE SUR LES DIFFERENTES BRANCHES (NBRC)
C*******************************************************************
C*******************************************************************
      DO 20 LDEB = 1,NBRC
C*******************************************************************
C*******************************************************************
C
C
C INITIALISATION
C*******************************************************************
C
      DO 22 K2 = 1,NCOE
      ELC(K2) = 0.D0
      DO 23 K3 = 1,NCOE
      CB(K2,K3) = 0.D0
   23 CONTINUE
   22 CONTINUE
C
C
C BOUCLE SUR LES DIFFERENTS TEMPS D'APPLICATION (NTZERO)
C*******************************************************************
C*******************************************************************
      DO 30 J = 1,NTZERO
C*******************************************************************
C*******************************************************************
C
C INITIALISATION
C*******************************************************************
C
      DO 31 K1 = 1,NTPS1
      AB0(K1) = 0.D0
   31 CONTINUE
      DO 32 K2 = 1,NBRC
      RELC(K2) = 0.D0
      DO 33 K3 = 1,NBRC
      AB(K2,K3) = 0.D0
   33 CONTINUE
   32 CONTINUE
C
C BOUCLE SUR LES DIFFERENTES DUREES D APPLICATION DE LA CHARGE (NTPS1)
C*******************************************************************
C*******************************************************************
      DO 40 I = 1,NTPS1
C*******************************************************************
C*******************************************************************
C
      IF(I.EQ.1)THEN
         AB0(I) = NTPS*(DUR(I)/DUR(NTPS1))
C
      ELSE IF(I.EQ.2)THEN
         AB0(I) = NTPS*(DUR(I)/(2*DUR(NTPS1)))
C
      ELSE IF(I.LT.NTPS1.AND.I.GT.2)THEN
         AB0(I) = NTPS*(DUR(I)-DUR(I-2))/(2*DUR(NTPS1))
C
      ELSE IF(I.EQ.NTPS1)THEN
         AB0(I) = NTPS*(DUR(NTPS1)-DUR(NTPS))/DUR(NTPS1)
      ENDIF
C
      DO 50 K = 1,NBRC
      DO 60 L = 1,NBRC
C
C COEFFICIENT DE LA MATRICE [AB]
C [AB] = TABLEAU AB[NBRC,NBRC]
C*******************************************************************
      IF (I.EQ.1) THEN
      AB(L,K) = AB0(I)
      ELSE
      AB(L,K) = AB(L,K) + AB0(I)*EXP(-DUR(I-1)/BRAN(K))*
     *EXP(-DUR(I-1)/BRAN(L))
      ENDIF
C
   60 CONTINUE
   50 CONTINUE
C
      DO 70 L = 1,NBRC
C
C COEFFICIENT DU VECTEUR RELC(NBRC)
C RELC(NBRC)=SECOND MEMBRE POUR RESOLUTION PAR GAUSS
C*******************************************************************
      IF(I.EQ.1)THEN
      RELC(L) = RELC(L)+AB0(I)*REL(I,J)
      ELSE
      RELC(L) = RELC(L)+AB0(I)*REL(I-1,J)
     **EXP(-DUR(I-1)/BRAN(L))
      ENDIF
C
C INITIALISATION
C*******************************************************************
      EB(L) = 0.D0
   70 CONTINUE
C
C
C*******************************************************************
C*******************************************************************
   40 CONTINUE
C*******************************************************************
C*******************************************************************
C
      CALL SYSTLI(AB,RELC,NBRC,EB,NBRC,CZ1)
C
      DO 79 NVIS =1,38
      DO 80 L = 1,NBRC
      EBFLU(L,J) = EB(L)
      EVIS(L,NVIS) = EBFLU(L,NVIS)
   80 CONTINUE
   79 CONTINUE
C
C
C INITIALISATION
C*******************************
      CB0(J) = 0.D0
C
C
C BOUCLE SUR LES DIFFERENTS TEMPS D APPLICATION (SUITE)
C*******************************************************************
C*******************************************************************
C
      MOK = NTZERO-1
      IF(J.EQ.1)THEN
      CB0(J) = MOK*(TZO(J+1)-TZO(1))/(TZO(NTZERO)-TZO(1))
C
      ELSE IF(J.LT.NTZERO.AND.J.GT.1)THEN
      CB0(J) = MOK*(TZO(J+1)-TZO(J-1))
     */(2*(TZO(NTZERO)-TZO(1)))
C
      ELSE IF(J.EQ.NTZERO)THEN
      CB0(J) = MOK*(TZO(NTZERO)-TZO(MOK))
     */(TZO(NTZERO) - TZO(1))
C
      ENDIF
C
C*******************************************************************
C
      DO 100 K = 1,NCOE
      DO 110 I = 1,NCOE
C
C   COEFFICIENT DE LA MATRICE [CB]
C   [CB] = TABLEAU CB[NCOE,NCOE]
C
      CB(I,K) = CB(I,K)+CB0(J)*EXP((DATCUR-TZO(J))
     **COEG(K))*EXP((DATCUR-TZO(J))*COEG(I))
C
  110 CONTINUE
  100 CONTINUE
C
C COEFFICIENT DU VECTEUR ELC(NCOE)
C ELC(NCOE)=SECOND MEMBRE POUR RESOLUTION PAR GAUSS (SYSTLI)
C*******************************************************************
C
      DO 120 N = 1,NCOE
C
      ELC(N) = ELC(N)+CB0(J)*EBFLU(LDEB,J)
     **EXP((DATCUR-TZO(J))*COEG(N))
C
C INITIALISATION
C*******************************************************************
      CDB(N) = 0.0
  120 CONTINUE
C
C*******************************************************************
C*******************************************************************
   30 CONTINUE
C*******************************************************************
C*******************************************************************
C
      CALL SYSTLI(CB,ELC,NCOE,CDB,NCOE,CZ2)
C
C AFFICHAGE DES VALEURS CONSTITUTIVES DE CHAQUE MODULE
C DE CHAQUE BRANCHE DE MAXWELL
C*******************************************************************
C
      DO 130 NFIN = 1,NCOE
      COE(LDEB,NFIN) = CDB(NFIN)
C      PRINT*,'LES VALEURS POUR LA BRANCHE',LDEB,'SONT :',CDB(NFIN)
  130 CONTINUE
C
C*******************************************************************
C*******************************************************************
   20 CONTINUE
C*******************************************************************
C*******************************************************************
C
      RETURN
      END
 
 
 

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