1 : C BRILAM SOURCE CHAT 05/01/12 21:42:37 5004 2 : SUBROUTINE BRILAM(ICAS,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, 3 : .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,YUNG,XNU,SIGEL,DSIGP,SIGMAT, 4 : .IC1,IC2,DGLAP1,DGLAP2,DGLAM1,DGLAM2,DGLA1,DGLA2,DL1,DL2,DI1,DI2, 5 : .KERRE) 6 : C 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8(A-H,O-Z) 9 : -INC CCOPTIO 10 : C 11 : DIMENSION SIGEL(*),DSIGP(*),SIGMAT(*) 12 : C 13 : ZR=0.D0 14 : C 15 : GO TO (100,200,300,400,500,600,700,800),ICAS 16 : WRITE(IOIMP,10)ICAS 17 : KERRE=640 18 : RETURN 19 : C 20 : C CAS DU CRITERE DE LA POROSITE (1) AVEC 21 : C LE CRITERE DE DRUCKER DUCTILE (2) 22 : C 23 : 100 A1=-0.3333333333333333333333333333333333333D0 24 : IB1=0 25 : H1=PENTE3 26 : A2=ALFADV 27 : IB2=1 28 : H2=0.D0 29 : IC1=1 30 : IC2=2 31 : GO TO 2 32 : C 33 : C CAS DU CRITERE DE LA POROSITE (1) AVEC 34 : C LE CRITERE DE VON MISES (2) 35 : C 36 : 200 A1=-0.33333333333333333333333333333333333333D0 37 : IB1=0 38 : H1=PENTE3 39 : A2=0.D0 40 : IB2=1 41 : H2=PENTE1 42 : IC1=1 43 : IC2=3 44 : GO TO 2 45 : C 46 : C CAS DU CRITERE DE DRUCKER DUCTILE (1) AVEC 47 : C LE CRITERE DE VON MISES (2) 48 : C 49 : 300 A1=ALFADV 50 : IB1=1 51 : H1=0.D0 52 : A2=0.D0 53 : IB2=1 54 : H2=PENTE1 55 : IC1=2 56 : IC2=3 57 : GO TO 2 58 : C 59 : C CAS DU CRITERE DE DRUCKER DUCTILE (1) AVEC 60 : C LE CRITERE DE DRUCKER FRAGILE (2) 61 : C 62 : 400 A1=ALFADV 63 : IB1=1 64 : H1=0.D0 65 : A2=ALFAD1 66 : IB2=1 67 : H2=0.D0 68 : IC1=2 69 : IC2=4 70 : GO TO 2 71 : C 72 : C CAS DU CRITERE DE DRUCKER DUCTILE (1) AVEC 73 : C LE CRITERE DE DRUCKER ECROUISSABLE (2) 74 : C 75 : 500 A1=ALFADV 76 : IB1=1 77 : H1=0.D0 78 : A2=ALFAD2 79 : IB2=1 80 : H2=PENTE2 81 : IC1=2 82 : IC2=5 83 : GO TO 2 84 : C 85 : C CAS DU CRITERE DE VON MISES (1) AVEC 86 : C LE CRITERE DE DRUCKER ECROUISSABLE (2) 87 : C 88 : 600 A1=0.D0 89 : IB1=1 90 : H1=PENTE1 91 : A2=ALFAD2 92 : IB2=1 93 : H2=PENTE2 94 : IC1=3 95 : IC2=5 96 : GO TO 2 97 : C 98 : C CAS DU CRITERE DE DRUCKER FRAGILE (1) AVEC 99 : C LE CRITERE DE DRUCKER ECROUISSABLE (2) 100 : C 101 : 700 A1=ALFAD1 102 : IB1=1 103 : H1=0.D0 104 : A2=ALFAD2 105 : IB2=1 106 : H2=PENTE2 107 : IC1=4 108 : IC2=5 109 : GO TO 2 110 : C 111 : C CAS DU CRITERE DE VON MISES (1) AVEC 112 : C LE CRITERE DE DRUCKER FRAGILE (2) 113 : C 114 : 800 A1=0.D0 115 : IB1=1 116 : H1=PENTE1 117 : A2=ALFAD1 118 : IB2=1 119 : H2=0.D0 120 : IC1=3 121 : IC2=4 122 : C 123 : 2 SU=1.5D0*YUNG/(1.D0+XNU) 124 : DU=3.D0*YUNG/(1.D0-2.D0*XNU) 125 : C 126 : C CALCUL DU: A11, A22, A12 127 : C 128 : A11=H1 129 : IF(IB1.NE.0) A11=A11+SU 130 : IF(A1.NE.0.D0) A11=A11+A1*A1*DU 131 : A22=H2 132 : IF(IB2.NE.0) A22=A22+SU 133 : IF(A2.NE.0.D0) A22=A22+A2*A2*DU 134 : A12=IB1*IB2*SU+A1*A2*DU 135 : C 136 : DET=A11*A22-A12*A12 137 : IF(IIMPI.EQ.9) 138 : . WRITE(IOIMP,1000) DET,A11,A22,A12 139 : 140 : C 141 : IF(DET.NE.0.D0) GO TO 3 142 : WRITE(IOIMP,11) 143 : KERRE=640 144 : RETURN 145 : C 146 : C CALCUL DU: DGLA1, DGLA2 147 : C 148 : 3 TRSIGE=SIGEL(1)+SIGEL(2)+SIGEL(3) 149 : SIGEQ2=AVM(SIGEL,SIGEL) 150 : SIGEQ=SQRT(SIGEQ2) 151 : IF(SIGEQ.EQ.0.D0) GO TO 8 152 : TRDSIG=DSIGP(1)+DSIGP(2)+DSIGP(3) 153 : C1=A1*TRDSIG 154 : IF(IB1.EQ.0)GO TO 4 155 : FF=SIGEL(1)*DSIGP(1)+SIGEL(2)*DSIGP(2)+SIGEL(3)*DSIGP(3) 156 : ZZ=2.D0*(SIGEL(4)*DSIGP(4)+SIGEL(5)*DSIGP(5)+SIGEL(6)*DSIGP(6)) 157 : TRSIDS=FF+ZZ-TRSIGE*TRDSIG/3.D0 158 : C1=C1+1.5D0*TRSIDS/SIGEQ 159 : IF(IIMPI.EQ.9) 160 : . WRITE(IOIMP,1001) C1,FF,ZZ,TRDSIG,TRSIDS,TRSIGE 161 : 4 C2=A2*TRDSIG 162 : IF(IB2.EQ.0) GO TO 5 163 : FF=SIGEL(1)*DSIGP(1)+SIGEL(2)*DSIGP(2)+SIGEL(3)*DSIGP(3) 164 : ZZ=2.*(SIGEL(4)*DSIGP(4)+SIGEL(5)*DSIGP(5)+SIGEL(6)*DSIGP(6)) 165 : TRSIDS=FF+ZZ-TRSIGE*TRDSIG/3. 166 : C2=C2+1.5D0*TRSIDS/SIGEQ 167 : IF(IIMPI.EQ.9) 168 : . WRITE(IOIMP,1002) C2,FF,ZZ,TRDSIG,TRSIDS,TRSIGE 169 : 5 DGLA1=(C1*A22-C2*A12)/DET 170 : DGLA2=(C2*A11-C1*A12)/DET 171 : IF(IIMPI.EQ.9) 172 : . WRITE(IOIMP,1003) DGLA1,DGLA2 173 : C 174 : C CALCUL DU: DGLAP1, DGLAP2 175 : C 176 : TRSIGE=SIGMAT(1)+SIGMAT(2)+SIGMAT(3) 177 : SIGEQ2=AVM(SIGMAT,SIGMAT) 178 : SIGEQ=SQRT(SIGEQ2) 179 : IF(SIGEQ.EQ.0.D0) GO TO 8 180 : TRDSIG=DSIGP(1)+DSIGP(2)+DSIGP(3) 181 : C1=A1*TRDSIG 182 : IF(IB1.EQ.0)GO TO 6 183 : FF=SIGMAT(1)*DSIGP(1)+SIGMAT(2)*DSIGP(2)+SIGMAT(3)*DSIGP(3) 184 : ZZ=2.D0*(SIGMAT(4)*DSIGP(4)+SIGMAT(5)*DSIGP(5)+SIGMAT(6)*DSIGP(6)) 185 : TRSIDS=FF+ZZ-TRSIGE*TRDSIG/3.D0 186 : C1=C1+1.5D0*TRSIDS/SIGEQ 187 : IF(IIMPI.EQ.9) 188 : . WRITE(IOIMP,1001) C1,FF,ZZ,TRDSIG,TRSIDS,TRSIGE 189 : 6 C2=A2*TRDSIG 190 : IF(IB2.EQ.0) GO TO 7 191 : FF=SIGMAT(1)*DSIGP(1)+SIGMAT(2)*DSIGP(2)+SIGMAT(3)*DSIGP(3) 192 : ZZ=2.D0*(SIGMAT(4)*DSIGP(4)+SIGMAT(5)*DSIGP(5)+SIGMAT(6)*DSIGP(6)) 193 : TRSIDS=FF+ZZ-TRSIGE*TRDSIG/3.D0 194 : C2=C2+1.5*TRSIDS/SIGEQ 195 : IF(IIMPI.EQ.9) 196 : . WRITE(IOIMP,1002) C2,FF,ZZ,TRDSIG,TRSIDS,TRSIGE 197 : 7 DGLAP1=(C1*A22-C2*A12)/DET 198 : DGLAP2=(C2*A11-C1*A12)/DET 199 : IF(IIMPI.EQ.9) 200 : . WRITE(IOIMP,1004) DGLAP1,DGLAP2 201 : C 202 : C CALCUL DU: DGLAM1, DGLAM2 203 : C 203 : CALL KRITER(IC1,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, 204 : . DPELA1,DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZR,SIGMAT,FSG,C1,KERRE) 204 : CALL KRITER(IC2,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, 205 : . DPELA1,DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZR,SIGMAT,FSG,C2,KERRE) 206 : DGLAM1=(C1*A22-C2*A12)/DET 207 : DGLAM2=(C2*A11-C1*A12)/DET 208 : IF(IIMPI.EQ.9) 209 : . WRITE(IOIMP,1005) DGLAM1,DGLAM2 210 : C 211 : C CALCUL DU: DI1, DI2 212 : C 212 : CALL KRITER(IC1,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, 213 : . DPELA1,DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZR,SIGEL,FSG,C1,KERRE) 213 : CALL KRITER(IC2,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, 214 : . DPELA1,DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZR,SIGEL,FSG,C2,KERRE) 215 : DI1=(C1*A22-C2*A12)/DET 216 : DI2=(C2*A11-C1*A12)/DET 217 : IF(IIMPI.EQ.9) 218 : . WRITE(IOIMP,1006) DI1,DI2 219 : C 220 : C CALCUL DU: DL1, DL2 221 : C 222 : DL1=DGLAM1-DGLAP1 223 : DL2=DGLAM2-DGLAP2 224 : IF(IIMPI.EQ.9) 225 : . WRITE(IOIMP,1007) DL1,DL2 226 : GOTO 99 227 : C 228 : 8 KERRE=640 229 : WRITE(IOIMP,12) 230 : RETURN 231 : 99 CONTINUE 232 : C 233 : 10 FORMAT(1X,'ERREUR DANS BRILAM I =',I4) 234 : 11 FORMAT(1X,'ERREUR DANS BRILAM DET EGAL A ZERO') 235 : 12 FORMAT(1X,'ERREUR DANS BRILAM SIGEQ EGAL A ZERO') 236 : C 237 : 1000 FORMAT(1X,'DET =',1PD12.5,1X,'A11 =',1PD12.5, 238 : . 1X,'A22 =',1PD12.5,1X,'A12 =',1PD12.5) 239 : 1001 FORMAT(1X,'C1 =',1PD12.5,1X,'FF =',1PD12.5,/, 240 : . 1X,'ZZ =',1PD12.5,1X,'TRDSIG=',1PD12.5,/, 241 : . 1X,'TRSIDS=',1PD12.5,1X,'TRSIGE=',1PD12.5) 242 : 1002 FORMAT(1X,'C2 =',1PD12.5,1X,'FF =',1PD12.5,/, 243 : . 1X,'ZZ =',1PD12.5,1X,'TRDSIG=',1PD12.5,/, 244 : . 1X,'TRSIDS=',1PD12.5,1X,'TRSIGE=',1PD12.5) 245 : 1003 FORMAT(1X,'DGLA1 =',1PD12.5,1X,'DGLA2 =',1PD12.5) 246 : 1004 FORMAT(1X,'DGLAP1=',1PD12.5,1X,'DGLAP2=',1PD12.5) 247 : 1005 FORMAT(1X,'DGLAM1=',1PD12.5,1X,'DGLAM2=',1PD12.5) 248 : 1006 FORMAT(1X,'DI1 =',1PD12.5,1X,'DI2 =',1PD12.5) 249 : 1007 FORMAT(1X,'DL1 =',1PD12.5,1X,'DL2 =',1PD12.5) 250 : C 251 : RETURN 252 : END 253 :
© Cast3M 2003 - All rights reserved.
Disclaimer