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