1 : C MDCRES SOURCE CHAT 05/01/13 01:40:07 5004 2 : SUBROUTINE MDCRES(COE,COEG,BETJEF,BETFLU) 3 : C 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : C 7 : DIMENSION AB(9,9),RELC(9),BRAN(8),DUR(200), 8 : & AB0(200),AL(200),AK(200),AKL(200), 9 : & EBFLU(9,200),EB(9),EVIS(9,38),TZE(200), 10 : & REL(200,200),TZERO(200),TMT0(200), 11 : & CB(9,9),ELC(9),COEG(8),TRO(200), 12 : & CB0(200),CL(200),CK(200),CKL(200), 13 : & COE(9,9),CDB(9),CZ1(9),CZ2(9), 14 : & FIFLU(200,200) 15 : C 16 : C****************************************************************** 17 : C TEM(N,M)=DATE DE MESURE DE LA DEFORMATION 18 : C TZERO(M)= DATE D'APPLICATION DE LA CHARGE 19 : C DATCOU= DATE DE COULAGE DU BETON 20 : C TMT0(N)=(TEM(N,M)-TZERO(M)) 21 : C E28=4734*SQR(FC) 22 : C 23 : C****************************************************************** 24 : C 25 : SEGMENT BETJEF 26 : REAL*8 AA,BETA,FC,ALPHA,EX,XNU,GFC,GFT,CAR,ETA,TDEF, 27 : & TCON,DPSTF1,DPSTF2,TETA,PDT,TP00 28 : INTEGER ICT,ICC,IMOD,IVIS,ITER, 29 : & ISIM,IBB,IGAU,IZON 30 : ENDSEGMENT 31 : SEGMENT BETFLU 32 : REAL*8 DATCOU,DATCUR,DATSEC,E28,PGTZO,PGDUR,TAU1,TAU2, 33 : & TP0,TZER 34 : INTEGER ITYPE,IMD,NBRC,NCOE,NTZERO,NTPS,IFOR 35 : ENDSEGMENT 36 : C******************************************************************* 37 : C INITIALISATION 37 : CALL ZERO(REL,200,200) 37 : CALL ZERO(TZERO,200,1) 37 : CALL ZERO(DUR,200,1) 37 : CALL ZERO(FIFLU,200,200) 37 : CALL ZERO(TRO,200,1) 38 : C 39 : C 40 : C TAU1= TEMPS INITIAL POUR LE CALCUL A PARTIR DE LA SECONDE BRANCHE 41 : C DES COEFFICIENTS DE CHAQUE BRANCHE 42 : C 43 : C******************************************************************* 44 : C CALCUL DES COEFFICIENTS DES BRANCHES DU MODELE DE MAXWELL 45 : C******************************************************************* 46 : C 47 : MC=NBRC+1 48 : C 49 : DO 10 N=1,NBRC 50 : IF (N.EQ.1) THEN 51 : BRAN(N) = 0.D0 52 : BRAN(N)=TAU1 53 : ELSE 54 : BRAN(N)=10**(N-2)*TAU2 55 : ENDIF 56 : 10 CONTINUE 57 : C 58 : NC=NCOE+1 59 : C 60 : C******************************************************************* 61 : C APPEL DES COURBES DE VALEURS DE RELAXATION 62 : C******************************************************************* 63 : C 63 : CALL TANSR(REL,TZERO,DUR,FIFLU,TRO,BETJEF,BETFLU) 64 : C 65 : NTPS1=NTPS+1 66 : C 67 : DO 20 I=1,NTPS1 68 : C 69 : IF(I.EQ.1)THEN 70 : TMT0(I)=DUR(I) 71 : ELSE IF(I.GT.1.AND.I.LT.NTPS1) THEN 72 : TMT0(I)=DUR(I) 73 : ELSE IF(I.EQ.NTPS1) THEN 74 : TMT0(I)=0.D0 75 : ENDIF 76 : C 77 : 20 CONTINUE 78 : C 79 : C****************************************************************** 80 : C INITIALISATION SUR COE(9,9)=0.D0 81 : C****************************************************************** 82 : C 83 : DO 21 KI=1,MC 84 : DO 22 KJ=1,NC 85 : COE(KI,KJ) = 0.D0 86 : 22 CONTINUE 87 : 21 CONTINUE 88 : C 89 : C******************************************************************* 90 : C BOUCLE SUR LES DIFFERENTES BRANCHES 91 : C******************************************************************* 92 : C 93 : DO 25 LDEB=1,MC 94 : C 95 : C****************************************************************** 96 : C INITIALISATION 97 : C***************************************************************** 98 : C 99 : DO 26 IN1 = 1,NC 100 : ELC(IN1) = 0.D0 101 : DO 27 IN2 = 1,NC 102 : CB(IN1,IN2) = 0.D0 103 : 27 CONTINUE 104 : 26 CONTINUE 105 : C 106 : C****************************************************************** 107 : C BOUCLE SUR LES DIFFERENTS TEMPS D'APPLICATION 108 : C******************************************************************* 109 : C 110 : DO 30 J = 1,NTZERO 111 : TZE(J) = TZERO(J) 112 : C 113 : C******************************************************************* 114 : C BOUCLE SUR LES DIFFERENTES DATES DE MESURE 115 : C******************************************************************* 116 : C 117 : C******************************************************************* 118 : C INITIALISATION 119 : C******************************************************************* 120 : C 121 : DO 40 I = 1,NTPS1 122 : AB0(I) = 0.D0 123 : AL(I) = 0.D0 124 : AK(I) = 0.D0 125 : AKL(I) = 0.D0 126 : 40 CONTINUE 127 : C 128 : C******************************************************************* 129 : C CONDITION THERMODYNAMIQUE 130 : C******************************************************************* 131 : C 132 : C DO 41 I=1,NTPS1 133 : C 134 : C DO 42 JO=1,NTZERO 135 : C 136 : C IF(REL(I,JO).LT.0.D0)THEN 137 : C NTPS1=I-1 138 : C GOTO 500 139 : C ENDIF 140 : C 141 : C 42 CONTINUE 142 : C 143 : C 41 CONTINUE 144 : C 145 : C******************************************************************* 146 : C INITIALISATION 147 : C******************************************************************* 148 : C 149 : 500 DO 43 L = 1,MC 150 : RELC(L) = 0.D0 151 : DO 44 K = 1,MC 152 : AB(L,K) = 0.D0 153 : 44 CONTINUE 154 : 43 CONTINUE 155 : C 156 : C******************************************************************** 157 : C 158 : DO 45 I=1,NTPS1 159 : C 160 : C 161 : NOK=NTPS 162 : C 163 : C 164 : IF(I.EQ.1)THEN 165 : AB0(I)=NOK*(TMT0(I))/(TMT0(NOK)) 166 : ELSE IF(I.EQ.2)THEN 167 : AB0(I)=NOK*(TMT0(I)-TMT0(NTPS1))/(2*(TMT0(NOK))) 168 : ELSE IF(I.LE.(NOK).AND.I.GT.2)THEN 169 : AB0(I)=NOK*(TMT0(I)-TMT0(I-2))/(2*(TMT0(NOK))) 170 : ELSE IF(I.EQ.NTPS1)THEN 171 : AB0(I)=NOK*(TMT0(NOK)-TMT0(NOK-1))/(TMT0(NOK)) 172 : ENDIF 173 : C 174 : DO 50 K=1,MC 175 : C 176 : DO 60 L=1,MC 177 : C 178 : C COEFFICIENT DE LA MATRICE [AB] 179 : C [AB]=TABLEAU AB[NBRC+1,NBRC+1] 180 : C 181 : IF(I.EQ.1) THEN 182 : IF(K.EQ.1.AND.L.EQ.1)THEN 183 : AB(L,K)=AB(L,K)+AB0(I) 184 : ELSE IF(K.EQ.1.AND.L.GT.1)THEN 185 : AL(I) = AB0(I)*EXP(-(TMT0(NTPS1))/BRAN(L-1)) 186 : AB(L,K) = AB(L,K)+ AL(I) 187 : ELSE IF(K.GT.1.AND.L.EQ.1)THEN 188 : AK(I) = AB0(I)*EXP(-(TMT0(NTPS1))/BRAN(K-1)) 189 : AB(L,K) = AB(L,K)+ AK(I) 190 : ELSE IF(K.GT.1.AND.L.GT.1)THEN 191 : AKL(I) = AB0(I)*EXP(-(TMT0(NTPS1))/BRAN(K-1))* 192 : *EXP(-(TMT0(NTPS1))/BRAN(L-1)) 193 : AB(L,K) = AB(L,K)+AKL(I) 194 : ENDIF 195 : C 196 : ELSE 197 : C 198 : IF(K.EQ.1.AND.L.EQ.1)THEN 199 : AB(L,K)=AB(L,K)+AB0(I) 200 : ELSE IF(K.EQ.1.AND.L.GT.1)THEN 201 : AL(I) = AB0(I)*EXP(-(TMT0(I-1))/BRAN(L-1)) 202 : AB(L,K) = AB(L,K)+ AL(I) 203 : ELSE IF(K.GT.1.AND.L.EQ.1)THEN 204 : AK(I) = AB0(I)*EXP(-(TMT0(I-1))/BRAN(K-1)) 205 : AB(L,K) = AB(L,K)+ AK(I) 206 : ELSE IF(K.GT.1.AND.L.GT.1)THEN 207 : AKL(I) = AB0(I)*EXP(-(TMT0(I-1))/BRAN(K-1))* 208 : *EXP(-(TMT0(I-1))/BRAN(L-1)) 209 : AB(L,K) = AB(L,K)+AKL(I) 210 : ENDIF 211 : ENDIF 212 : C 213 : 60 CONTINUE 214 : 50 CONTINUE 215 : C 216 : C******************************************************************* 217 : C INITIALISATION 218 : C******************************************************************* 219 : C 220 : RL0=0.D0 221 : RL1=0.D0 222 : C 223 : C 224 : C****************************************************************** 225 : C 226 : DO 70 L=1,MC 227 : C 228 : C COEFFICIENT DU VECTEUR RELC(NBRC) 229 : C RELC(NBRC)=SECOND MEMBRE POUR RESOLUTION PAR GAUSS 230 : C 231 : IF(I.EQ.1) THEN 232 : IF(L.EQ.1)THEN 233 : RL0=AB0(I)*REL(I,J) 234 : RELC(L)=RELC(L)+RL0 235 : ELSE IF(L.GT.1)THEN 236 : RL1=AB0(I)*REL(I,J)*EXP(-(TMT0(NTPS1))/BRAN(L-1)) 237 : RELC(L)=RELC(L)+RL1 238 : ENDIF 239 : ELSE 240 : C 241 : IF(L.EQ.1)THEN 242 : RL0=AB0(I)*REL(I,J) 243 : RELC(L)=RELC(L)+RL0 244 : ELSE IF(L.GT.1)THEN 245 : RL1=AB0(I)*REL(I,J)*EXP(-(TMT0(I-1))/BRAN(L-1)) 246 : RELC(L)=RELC(L)+RL1 247 : ENDIF 248 : ENDIF 249 : 250 : RL0=0.D0 251 : RL1=0.D0 252 : C 253 : EB(L)=0.D0 254 : C 255 : 70 CONTINUE 256 : C 257 : 45 CONTINUE 258 : C 258 : CALL SYSTLI(AB,RELC,MC,EB,MC,CZ1) 259 : C 260 : DO 79 NVIS = 1,38 261 : DO 80 L=1,MC 262 : EBFLU(L,J)=EB(L) 263 : EVIS(L,NVIS) = EBFLU(L,NVIS) 264 : 80 CONTINUE 265 : 79 CONTINUE 266 : C 267 : C 268 : C******************************************************************* 269 : C INITIALISATION 270 : C****************************************************************** 271 : C 272 : CB0(J)=0.D0 273 : CL(J)=0.D0 274 : CK(J)=0.D0 275 : CKL(J)=0.D0 276 : EL0=0.D0 277 : EL1=0.D0 278 : C 279 : C******************************************************************* 280 : C BOUCLE SUR LES DIFFERENTS TEMPS D APPLICATION (SUITE) 281 : C******************************************************************* 282 : C 283 : C******************************************************************* 284 : C !!!REMARQUE IMPORTANTE : SI NTZERO DIFFERENT DE NTPS 285 : C ALORS REVOIR LA VALEUR (LA DEFINIR)DE TZERO(MOK) CI-DESSOUS 286 : C TRANSFORMEE EN TMT0(MOK) CAR IL S AVERE ETRE LA MEME VALEUR 287 : C******************************************************************* 288 : C 289 : MOK=NTZERO-1 290 : C 291 : IF(J.EQ.1)THEN 292 : CB0(J)=MOK*(TZERO(J+1)-TZERO(J))/(TZERO(NTZERO)-TZERO(1)) 293 : ELSE IF(J.LE.(MOK).AND.J.GT.1)THEN 294 : CB0(J)=MOK*(TZERO(J+1)-TZERO(J-1))/(2*(TZERO(NTZERO)-TZERO(1))) 295 : ELSE IF(J.EQ.NTZERO)THEN 296 : CB0(J)=MOK*(TZERO(J)-TZERO(J-1))/(TZERO(NTZERO)- TZERO(1)) 297 : C 298 : ENDIF 299 : C 300 : C********************************************************************* 301 : C 302 : DO 100 K=1,NC 303 : C 304 : DO 110 I=1,NC 305 : C 306 : C COEFFICIENT DE LA MATRICE [CB] 307 : C [CB]=TABLEAU CB[NCOE+1,NCOE+1] 308 : C 309 : IF(K.EQ.1.AND.I.EQ.1)THEN 310 : C 311 : CB(I,K)=CB(I,K)+CB0(J) 312 : ELSE IF(K.EQ.1.AND.I.GT.1)THEN 313 : CL(J)=CB0(J)*EXP((DATCUR-TZERO(J)) 314 : **COEG(I-1)) 315 : CB(I,K)=CB(I,K)+CL(J) 316 : ELSE IF(K.GT.1.AND.I.EQ.1)THEN 317 : CK(J)=CB0(J)*EXP((DATCUR-TZERO(J)) 318 : **COEG(K-1)) 319 : CB(I,K)=CB(I,K)+CK(J) 320 : ELSE IF(K.GT.1.AND.I.GT.1)THEN 321 : CKL(J)=CB0(J)*EXP((DATCUR-TZERO(J)) 322 : **COEG(K-1))*EXP((DATCUR-TZERO(J)) 323 : **COEG(I-1)) 324 : CB(I,K)=CB(I,K)+CKL(J) 325 : C 326 : ENDIF 327 : C 328 : 110 CONTINUE 329 : C 330 : 100 CONTINUE 331 : C 332 : DO 120 N=1,NC 333 : C 334 : C COEFFICIENT DU VECTEUR ELC(NCOE) 335 : C ELC(NCOE)=SECOND MEMBRE POUR RESOLUTION PAR GAUSS (Subroutine SYSTLI) 336 : C 337 : IF(N.EQ.1)THEN 338 : C 339 : EL0=CB0(J)*EBFLU(LDEB,J) 340 : ELC(N)=ELC(N)+EL0 341 : ELSE IF(N.GT.1)THEN 342 : EL1=CB0(J)*EBFLU(LDEB,J)*EXP((DATCUR-TZERO(J)) 343 : **COEG(N-1)) 344 : ELC(N)=ELC(N)+EL1 345 : ENDIF 346 : CDB(N)=0.0 347 : C 348 : 120 CONTINUE 349 : C 350 : 30 CONTINUE 351 : C 351 : CALL SYSTLI(CB,ELC,NC,CDB,NC,CZ2) 352 : C 353 : C******************************************************************* 354 : C AFFICHAGE DES VALEURS CONSTITUTIVES DE CHAQUE MODULE 355 : C DE CHAQUE BRANCHE DE MAXWELL 356 : C******************************************************************* 357 : C 358 : DO 130 NFIN=1,NC 359 : C 360 : COE(LDEB,NFIN)=CDB(NFIN) 361 : C 362 : C PRINT*,'LES VALEURS POUR LA BRANCHE',LDEB,'SONT :',CDB(NFIN) 363 : C 364 : 130 CONTINUE 365 : C 366 : 25 CONTINUE 367 : C 368 : RETURN 369 : END 370 : 371 :
© Cast3M 2003 - All rights reserved.
Disclaimer