1 : C CMODFI SOURCE KICH 09/09/11 21:16:41 6505 2 : SUBROUTINE CMODFI(TPS1,TPS2,NBR,WR12,wrk52,wrk53,NWA, 3 : 1 EFIC,TR,E1,E2) 4 : C MODFIC SOURCE AM 99/08/13 21:22:31 3647 5 : * SUBROUTINE MODFIC(TPS1,TPS2,NBR,WR12,WRK0,NWA, 6 : * 1 EFIC,TR,E1,E2,KERRE,CMATE) 7 : * 8 : * 9 : *============================================================== 10 : * calcul du module fictif d'une chaine de Maxwell 11 : *============================================================== 12 : * 13 : * 14 : * entrees 15 : * 16 : * 17 : * WRK12 18 : * EMi(2,NWA(i+1)) i=0 a 8 19 : * = EVOLUTION DU MODUE D'YOUNG DE LA BRANCHE i 20 : * SMi(NSTRS) i=1 a 8 21 : * = VARIABLES INTERNES AU DEBUT DU PAS D'INTEGRATION 22 : * 23 : * TPS1 = TEMPS AU DEBUT DU PAS D'INTEGRATION 24 : * TPS2 = TEMPS A LA FIN DU PAS D'INTEGRATION 25 : * NBR = INDICE DE LA CHAINE DE MAXWELL CONCERNEE 26 : * NWA = TABLEAU DES DIMENSIONS DES EVOLUTIONS DES MODULES DE CHAQUE CHAINE 27 : * 28 : * 29 : * sortie 30 : * 31 : * EFIC = MODULE FICTIF DE LA CHAINE DE MAXWELL 32 : * TR = TEMPS DE RELAXATION DE LA CHAINE DE MAXWELL 33 : * E1 = MODULE DE LA CHAINE DE MAXWELL AU DEBUT DU PAS 34 : * E2 = MODULE DE LA CHAINE DE MAXWELL A LA FIN DU PAS 35 : * KERRE = INDICATEUR D'ERREUR 36 : * 37 : * 38 : * 39 : *============================================================== 40 : * 41 : IMPLICIT INTEGER(I-N) 42 : IMPLICIT REAL*8(A-H,O-Z) 43 : -INC CCOPTIO 44 : -INC DECHE 45 : * 46 : SEGMENT WR12 47 : REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3)) 48 : REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6)) 49 : REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9)) 50 : REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS) 51 : REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS) 52 : REAL*8 SM8(NSTRS) 53 : ENDSEGMENT 54 : * 55 : DIMENSION NWA(9) 56 : * 57 : ******* Cas d'une formulation isotrope 58 : * 59 : IF(CMATE.EQ.'ISOTROPE') THEN 60 : 61 : * 62 : JED=0 63 : IF (IFOUR.EQ.-2) JED=1 64 : * 65 : * test sur la branche 66 : * 67 : IF (NBR.EQ.0) THEN 67 : CALL MAXINT(EM0,NWA(1),TPS1,FTPS1,IRET1) 67 : CALL MAXINT(EM0,NWA(1),TPS2,FTPS2,IRET2) 68 : EFIC=(FTPS2+FTPS1)/2 69 : TR=0. 70 : E1=FTPS1 71 : E2=FTPS2 72 : GOTO 10 73 : ELSE IF (NBR.EQ.1) THEN 73 : CALL MAXINT(EM1,NWA(2),TPS1,FTPS1,IRET1) 73 : CALL MAXINT(EM1,NWA(2),TPS2,FTPS2,IRET2) 74 : TR=XMAT(5) 75 : ELSE IF (NBR.EQ.2) THEN 75 : CALL MAXINT(EM2,NWA(3),TPS1,FTPS1,IRET1) 75 : CALL MAXINT(EM2,NWA(3),TPS2,FTPS2,IRET2) 76 : TR=XMAT(7) 77 : ELSE IF (NBR.EQ.3) THEN 77 : CALL MAXINT(EM3,NWA(4),TPS1,FTPS1,IRET1) 77 : CALL MAXINT(EM3,NWA(4),TPS2,FTPS2,IRET2) 78 : TR=XMAT(9) 79 : ELSE IF (NBR.EQ.4) THEN 79 : CALL MAXINT(EM4,NWA(5),TPS1,FTPS1,IRET1) 79 : CALL MAXINT(EM4,NWA(5),TPS2,FTPS2,IRET2) 80 : TR=XMAT(11) 81 : * 82 : * 5 et plus 83 : * 84 : ELSE IF (NBR.EQ.5) THEN 84 : CALL MAXINT(EM5,NWA(6),TPS1,FTPS1,IRET1) 84 : CALL MAXINT(EM5,NWA(6),TPS2,FTPS2,IRET2) 85 : TR=XMAT(16+JED) 86 : ELSE IF (NBR.EQ.6) THEN 86 : CALL MAXINT(EM6,NWA(7),TPS1,FTPS1,IRET1) 86 : CALL MAXINT(EM6,NWA(7),TPS2,FTPS2,IRET2) 87 : TR=XMAT(18+JED) 88 : ELSE IF (NBR.EQ.7) THEN 88 : CALL MAXINT(EM7,NWA(8),TPS1,FTPS1,IRET1) 88 : CALL MAXINT(EM7,NWA(8),TPS2,FTPS2,IRET2) 89 : TR=XMAT(20+JED) 90 : ELSE IF (NBR.EQ.8) THEN 90 : CALL MAXINT(EM8,NWA(9),TPS1,FTPS1,IRET1) 90 : CALL MAXINT(EM8,NWA(9),TPS2,FTPS2,IRET2) 91 : TR=XMAT(22+JED) 92 : ENDIF 93 : * 94 : ******* Cas d'une formulation unidirectionnelle 95 : * 96 : ELSE IF(CMATE.EQ.'UNIDIREC') THEN 97 : 98 : * 99 : JED=0 100 : IF (IFOUR.EQ.-2) JED=1 101 : IF (IFOUR.EQ. 2) JED=4 102 : * 103 : KED=0 104 : IF (IFOUR.EQ. 2) KED=4 105 : 106 : * test sur la branche 107 : * 108 : IF (NBR.EQ.0) THEN 108 : CALL MAXINT(EM0,NWA(1),TPS1,FTPS1,IRET1) 108 : CALL MAXINT(EM0,NWA(1),TPS2,FTPS2,IRET2) 109 : EFIC=(FTPS2+FTPS1)/2 110 : TR=0. 111 : E1=FTPS1 112 : E2=FTPS2 113 : GOTO 10 114 : ELSE IF (NBR.EQ.1) THEN 114 : CALL MAXINT(EM1,NWA(2),TPS1,FTPS1,IRET1) 114 : CALL MAXINT(EM1,NWA(2),TPS2,FTPS2,IRET2) 115 : TR=XMAT(6+KED) 116 : ELSE IF (NBR.EQ.2) THEN 116 : CALL MAXINT(EM2,NWA(3),TPS1,FTPS1,IRET1) 116 : CALL MAXINT(EM2,NWA(3),TPS2,FTPS2,IRET2) 117 : TR=XMAT(8+KED) 118 : ELSE IF (NBR.EQ.3) THEN 118 : CALL MAXINT(EM3,NWA(4),TPS1,FTPS1,IRET1) 118 : CALL MAXINT(EM3,NWA(4),TPS2,FTPS2,IRET2) 119 : TR=XMAT(10+KED) 120 : ELSE IF (NBR.EQ.4) THEN 120 : CALL MAXINT(EM4,NWA(5),TPS1,FTPS1,IRET1) 120 : CALL MAXINT(EM4,NWA(5),TPS2,FTPS2,IRET2) 121 : TR=XMAT(12+KED) 122 : * 123 : * 5 et plus 124 : * 125 : ELSE IF (NBR.EQ.5) THEN 125 : CALL MAXINT(EM5,NWA(6),TPS1,FTPS1,IRET1) 125 : CALL MAXINT(EM5,NWA(6),TPS2,FTPS2,IRET2) 126 : TR=XMAT(16+JED) 127 : ELSE IF (NBR.EQ.6) THEN 127 : CALL MAXINT(EM6,NWA(7),TPS1,FTPS1,IRET1) 127 : CALL MAXINT(EM6,NWA(7),TPS2,FTPS2,IRET2) 128 : TR=XMAT(18+JED) 129 : ELSE IF (NBR.EQ.7) THEN 129 : CALL MAXINT(EM7,NWA(8),TPS1,FTPS1,IRET1) 129 : CALL MAXINT(EM7,NWA(8),TPS2,FTPS2,IRET2) 130 : TR=XMAT(20+JED) 131 : ELSE IF (NBR.EQ.8) THEN 131 : CALL MAXINT(EM8,NWA(9),TPS1,FTPS1,IRET1) 131 : CALL MAXINT(EM8,NWA(9),TPS2,FTPS2,IRET2) 132 : TR=XMAT(22+JED) 133 : ENDIF 134 : ENDIF 135 : * 136 : * 137 : E1=FTPS1 138 : E2=FTPS2 139 : IF(TPS2-TPS1.EQ.0.D0) THEN 140 : EFIC =FTPS1 141 : ELSE 142 : EFIC=1.D0/(TR*(TPS2-TPS1))* 143 : 1 ((FTPS1*(1.D0-EXP(-TR*(TPS2-TPS1)))) 144 : 2 +(FTPS2-FTPS1)*(1.D0-(1.D0-EXP(-TR*(TPS2-TPS1)))/ 145 : 3 (TR*(TPS2-TPS1)))) 146 : ENDIF 147 : * 148 : * 149 : 10 IF (IRET1.EQ.0) THEN 149 : CALL ERREUR(854) 150 : RETURN 151 : ELSE IF (IRET2.EQ.0) THEN 151 : CALL ERREUR(854) 152 : RETURN 153 : ENDIF 154 : END 155 : 156 : 157 : 158 : 159 : 160 : 161 : 162 : 163 : 164 : 165 : 166 :
© Cast3M 2003 - All rights reserved.
Disclaimer