Télécharger la plaquette Cast3M


fr en

Télécharger mdcres.eso

Retour à la liste

Numérotation des lignes : 

mdcres

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

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