Esope source files

   1 : C MDCREL    SOURCE    CHAT      05/01/13    01:40:01     5004           
   2 :       SUBROUTINE MDCREL(COE,COEG,BETJEF,BETFLU)
   3 : C
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8(A-H,O-Z)
   6 : C      
   7 :       DIMENSION    REL(200,200),TZO(200),DUR(200),
   8 :      &             FIFLU(200,200),BRAN(8),TRO(200),
   9 :      &             AB0(200),AB(8,8),RELC(8),
  10 :      &             CZ1(8),CB0(200),CB(8,8),ELC(8),
  11 :      &             EB(8),EBFLU(8,200),EVIS(8,38),
  12 :      &             COEG(8),COE(8,8),CDB(8),CZ2(8)             
  13 : C
  14 : C*******************************************************************
  15 : C TAU1     = TEMPS INITIAL POUR LE CALCUL 
  16 : C            DES COEFFICIENTS DE CHAQUE BRANCHE
  17 : C TZO(M)   = DATE D'APPLICATION DE LA CHARGE
  18 : C DATCUR   = DATE DE CURE DU BETON MINIMALE
  19 : C DUR(N)   = DUREE VARIABLE D APPLICATION DE LA CHARGE
  20 : C NBRC     = NOMBRE DE BRANCHES DU MODELE DE MAXWELL LIQUIDE
  21 : C EVIS sert seulement à rendre visible toutes les valeurs de toutes les
  22 : C branches du modèle de MAXWELL
  23 : C TRO(N) = TABLEAU DU PREMIER TEMPS DE RELAXATION 
  24 : C          POUR CHAQUE AGE D APPLICATION D UNE CHARGE
  25 : C*******************************************************************
  26 : C
  27 :       SEGMENT BETJEF
  28 :        REAL*8 AA,BETA,FC,ALPHA,EX,XNU,GFC,GFT,CAR,ETA,TDEF,
  29 :      &          TCON,DPSTF1,DPSTF2,TETA,PDT,TP00
  30 :        INTEGER ICT,ICC,IMOD,IVIS,ITER,
  31 :      &                ISIM,IBB,IGAU,IZON
  32 :       ENDSEGMENT
  33 :       SEGMENT BETFLU
  34 :        REAL*8 DATCOU,DATCUR,DATSEC,E28,PGTZO,PGDUR,TAU1,TAU2,
  35 :      &         TP0,TZER
  36 :        INTEGER ITYPE,IMD,NBRC,NCOE,NTZERO,NTPS,IFOR
  37 :       ENDSEGMENT
  38 : C*******************************************************************
  39 : C                  INITIALISATION       
  39 :       CALL ZERO(REL,200,200)
  39 :       CALL ZERO(TZO,200,1)
  39 :       CALL ZERO(DUR,200,1)
  39 :       CALL ZERO(FIFLU,200,200)
  39 :       CALL ZERO(TRO,200,1)
  40 : C
  41 : C*******************************************************************
  42 : C DETERMINATION DES TEMPS DE RELAXATION DES BRANCHES DE MAXWELL
  43 : C*******************************************************************
  44 : C
  45 :       DO 10 N = 1,NBRC
  46 :       BRAN(N) = 0.D0
  47 :       IF (N.EQ.1) THEN
  48 :       BRAN(N) = TAU1
  49 :       ELSE
  50 :       BRAN(N) = 10**(N-2)*TAU2
  51 :       ENDIF
  52 :    10 CONTINUE
  53 : C
  54 : C*******************************************************************
  55 : C APPEL DES COURBES DE VALEURS DE RELAXATION 
  56 : C*******************************************************************
  57 : C
  57 :       CALL TANSR(REL,TZO,DUR,FIFLU,TRO,BETJEF,BETFLU)
  58 : C
  59 : C NOMBRE DE VALEURS DE DUREE D APPLICATION DE LA CHARGE = NTPS1
  60 :       NTPS1 = NTPS+1
  61 : C         
  62 : C INITIALISATION 
  63 : C*******************************************************************
  64 :       DO 11 K1 = 1,NBRC     
  65 :       DO 12 K2 = 1,NCOE
  66 :       COE(K1,K2) = 0.D0
  67 :    12 CONTINUE
  68 :    11 CONTINUE
  69 : C
  70 : C
  71 : C BOUCLE SUR LES DIFFERENTES BRANCHES (NBRC)
  72 : C*******************************************************************
  73 : C*******************************************************************
  74 :       DO 20 LDEB = 1,NBRC
  75 : C*******************************************************************
  76 : C*******************************************************************
  77 : C
  78 : C
  79 : C INITIALISATION
  80 : C*******************************************************************
  81 : C   
  82 :       DO 22 K2 = 1,NCOE
  83 :       ELC(K2) = 0.D0
  84 :       DO 23 K3 = 1,NCOE
  85 :       CB(K2,K3) = 0.D0
  86 :    23 CONTINUE
  87 :    22 CONTINUE
  88 : C 
  89 : C
  90 : C BOUCLE SUR LES DIFFERENTS TEMPS D'APPLICATION (NTZERO)
  91 : C*******************************************************************
  92 : C*******************************************************************            
  93 :       DO 30 J = 1,NTZERO
  94 : C*******************************************************************
  95 : C*******************************************************************     
  96 : C
  97 : C INITIALISATION
  98 : C*******************************************************************
  99 : C     
 100 :       DO 31 K1 = 1,NTPS1
 101 :       AB0(K1) = 0.D0
 102 :    31 CONTINUE
 103 :       DO 32 K2 = 1,NBRC
 104 :       RELC(K2) = 0.D0
 105 :       DO 33 K3 = 1,NBRC
 106 :       AB(K2,K3) = 0.D0
 107 :    33 CONTINUE
 108 :    32 CONTINUE
 109 : C
 110 : C BOUCLE SUR LES DIFFERENTES DUREES D APPLICATION DE LA CHARGE (NTPS1)
 111 : C*******************************************************************
 112 : C*******************************************************************
 113 :       DO 40 I = 1,NTPS1
 114 : C*******************************************************************
 115 : C*******************************************************************
 116 : C 
 117 :       IF(I.EQ.1)THEN
 118 :          AB0(I) = NTPS*(DUR(I)/DUR(NTPS1))
 119 : C         
 120 :       ELSE IF(I.EQ.2)THEN
 121 :          AB0(I) = NTPS*(DUR(I)/(2*DUR(NTPS1)))
 122 : C         
 123 :       ELSE IF(I.LT.NTPS1.AND.I.GT.2)THEN
 124 :          AB0(I) = NTPS*(DUR(I)-DUR(I-2))/(2*DUR(NTPS1))
 125 : C         
 126 :       ELSE IF(I.EQ.NTPS1)THEN
 127 :          AB0(I) = NTPS*(DUR(NTPS1)-DUR(NTPS))/DUR(NTPS1)
 128 :       ENDIF
 129 : C       
 130 :       DO 50 K = 1,NBRC
 131 :       DO 60 L = 1,NBRC
 132 : C
 133 : C COEFFICIENT DE LA MATRICE [AB]
 134 : C [AB] = TABLEAU AB[NBRC,NBRC]
 135 : C******************************************************************* 
 136 :       IF (I.EQ.1) THEN
 137 :       AB(L,K) = AB0(I)
 138 :       ELSE
 139 :       AB(L,K) = AB(L,K) + AB0(I)*EXP(-DUR(I-1)/BRAN(K))*
 140 :      *EXP(-DUR(I-1)/BRAN(L))
 141 :       ENDIF
 142 : C
 143 :    60 CONTINUE
 144 :    50 CONTINUE
 145 : C    
 146 :       DO 70 L = 1,NBRC
 147 : C      
 148 : C COEFFICIENT DU VECTEUR RELC(NBRC)
 149 : C RELC(NBRC)=SECOND MEMBRE POUR RESOLUTION PAR GAUSS
 150 : C******************************************************************* 
 151 :       IF(I.EQ.1)THEN      
 152 :       RELC(L) = RELC(L)+AB0(I)*REL(I,J)
 153 :       ELSE 
 154 :       RELC(L) = RELC(L)+AB0(I)*REL(I-1,J)
 155 :      **EXP(-DUR(I-1)/BRAN(L))
 156 :       ENDIF
 157 : C
 158 : C INITIALISATION
 159 : C*******************************************************************    
 160 :       EB(L) = 0.D0     
 161 :    70 CONTINUE
 162 : C
 163 : C
 164 : C*******************************************************************
 165 : C*******************************************************************
 166 :    40 CONTINUE
 167 : C*******************************************************************
 168 : C*******************************************************************
 169 : C
 169 :       CALL SYSTLI(AB,RELC,NBRC,EB,NBRC,CZ1)
 170 : C
 171 :       DO 79 NVIS =1,38
 172 :       DO 80 L = 1,NBRC
 173 :       EBFLU(L,J) = EB(L)     
 174 :       EVIS(L,NVIS) = EBFLU(L,NVIS)
 175 :    80 CONTINUE 
 176 :    79 CONTINUE 
 177 : C        
 178 : C
 179 : C INITIALISATION
 180 : C*******************************
 181 :       CB0(J) = 0.D0
 182 : C
 183 : C
 184 : C BOUCLE SUR LES DIFFERENTS TEMPS D APPLICATION (SUITE)
 185 : C*******************************************************************
 186 : C*******************************************************************
 187 : C
 188 :       MOK = NTZERO-1
 189 :       IF(J.EQ.1)THEN     
 190 :       CB0(J) = MOK*(TZO(J+1)-TZO(1))/(TZO(NTZERO)-TZO(1))
 191 : C      
 192 :       ELSE IF(J.LT.NTZERO.AND.J.GT.1)THEN
 193 :       CB0(J) = MOK*(TZO(J+1)-TZO(J-1))
 194 :      */(2*(TZO(NTZERO)-TZO(1)))
 195 : C      
 196 :       ELSE IF(J.EQ.NTZERO)THEN
 197 :       CB0(J) = MOK*(TZO(NTZERO)-TZO(MOK))
 198 :      */(TZO(NTZERO) - TZO(1))
 199 : C      
 200 :       ENDIF
 201 : C
 202 : C*******************************************************************
 203 : C
 204 :       DO 100 K = 1,NCOE
 205 :       DO 110 I = 1,NCOE
 206 : C
 207 : C   COEFFICIENT DE LA MATRICE [CB]
 208 : C   [CB] = TABLEAU CB[NCOE,NCOE]
 209 : C         
 210 :       CB(I,K) = CB(I,K)+CB0(J)*EXP((DATCUR-TZO(J))
 211 :      **COEG(K))*EXP((DATCUR-TZO(J))*COEG(I))
 212 : C
 213 :   110 CONTINUE
 214 :   100 CONTINUE
 215 : C
 216 : C COEFFICIENT DU VECTEUR ELC(NCOE)
 217 : C ELC(NCOE)=SECOND MEMBRE POUR RESOLUTION PAR GAUSS (SYSTLI)
 218 : C*******************************************************************
 219 : C 
 220 :       DO 120 N = 1,NCOE
 221 : C   
 222 :       ELC(N) = ELC(N)+CB0(J)*EBFLU(LDEB,J)
 223 :      **EXP((DATCUR-TZO(J))*COEG(N))
 224 : C      
 225 : C INITIALISATION
 226 : C*******************************************************************           
 227 :       CDB(N) = 0.0
 228 :   120 CONTINUE
 229 : C
 230 : C*******************************************************************  
 231 : C*******************************************************************  
 232 :    30 CONTINUE   
 233 : C*******************************************************************  
 234 : C*******************************************************************  
 235 : C    
 235 :       CALL SYSTLI(CB,ELC,NCOE,CDB,NCOE,CZ2)
 236 : C
 237 : C AFFICHAGE DES VALEURS CONSTITUTIVES DE CHAQUE MODULE 
 238 : C DE CHAQUE BRANCHE DE MAXWELL
 239 : C*******************************************************************
 240 : C
 241 :       DO 130 NFIN = 1,NCOE
 242 :       COE(LDEB,NFIN) = CDB(NFIN)      
 243 : C      PRINT*,'LES VALEURS POUR LA BRANCHE',LDEB,'SONT :',CDB(NFIN)
 244 :   130 CONTINUE 
 245 : C
 246 : C*******************************************************************
 247 : C*******************************************************************
 248 :    20 CONTINUE 
 249 : C*******************************************************************
 250 : C******************************************************************* 
 251 : C
 252 :       RETURN
 253 :       END
 254 :  
 255 :