C BRILAM SOURCE CHAT 05/01/12 21:42:37 5004 SUBROUTINE BRILAM(ICAS,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,YUNG,XNU,SIGEL,DSIGP,SIGMAT, .IC1,IC2,DGLAP1,DGLAP2,DGLAM1,DGLAM2,DGLA1,DGLA2,DL1,DL2,DI1,DI2, .KERRE) C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC CCOPTIO C DIMENSION SIGEL(*),DSIGP(*),SIGMAT(*) C ZR=0.D0 C GO TO (100,200,300,400,500,600,700,800),ICAS WRITE(IOIMP,10)ICAS KERRE=640 RETURN C C CAS DU CRITERE DE LA POROSITE (1) AVEC C LE CRITERE DE DRUCKER DUCTILE (2) C 100 A1=-0.3333333333333333333333333333333333333D0 IB1=0 H1=PENTE3 A2=ALFADV IB2=1 H2=0.D0 IC1=1 IC2=2 GO TO 2 C C CAS DU CRITERE DE LA POROSITE (1) AVEC C LE CRITERE DE VON MISES (2) C 200 A1=-0.33333333333333333333333333333333333333D0 IB1=0 H1=PENTE3 A2=0.D0 IB2=1 H2=PENTE1 IC1=1 IC2=3 GO TO 2 C C CAS DU CRITERE DE DRUCKER DUCTILE (1) AVEC C LE CRITERE DE VON MISES (2) C 300 A1=ALFADV IB1=1 H1=0.D0 A2=0.D0 IB2=1 H2=PENTE1 IC1=2 IC2=3 GO TO 2 C C CAS DU CRITERE DE DRUCKER DUCTILE (1) AVEC C LE CRITERE DE DRUCKER FRAGILE (2) C 400 A1=ALFADV IB1=1 H1=0.D0 A2=ALFAD1 IB2=1 H2=0.D0 IC1=2 IC2=4 GO TO 2 C C CAS DU CRITERE DE DRUCKER DUCTILE (1) AVEC C LE CRITERE DE DRUCKER ECROUISSABLE (2) C 500 A1=ALFADV IB1=1 H1=0.D0 A2=ALFAD2 IB2=1 H2=PENTE2 IC1=2 IC2=5 GO TO 2 C C CAS DU CRITERE DE VON MISES (1) AVEC C LE CRITERE DE DRUCKER ECROUISSABLE (2) C 600 A1=0.D0 IB1=1 H1=PENTE1 A2=ALFAD2 IB2=1 H2=PENTE2 IC1=3 IC2=5 GO TO 2 C C CAS DU CRITERE DE DRUCKER FRAGILE (1) AVEC C LE CRITERE DE DRUCKER ECROUISSABLE (2) C 700 A1=ALFAD1 IB1=1 H1=0.D0 A2=ALFAD2 IB2=1 H2=PENTE2 IC1=4 IC2=5 GO TO 2 C C CAS DU CRITERE DE VON MISES (1) AVEC C LE CRITERE DE DRUCKER FRAGILE (2) C 800 A1=0.D0 IB1=1 H1=PENTE1 A2=ALFAD1 IB2=1 H2=0.D0 IC1=3 IC2=4 C 2 SU=1.5D0*YUNG/(1.D0+XNU) DU=3.D0*YUNG/(1.D0-2.D0*XNU) C C CALCUL DU: A11, A22, A12 C A11=H1 IF(IB1.NE.0) A11=A11+SU IF(A1.NE.0.D0) A11=A11+A1*A1*DU A22=H2 IF(IB2.NE.0) A22=A22+SU IF(A2.NE.0.D0) A22=A22+A2*A2*DU A12=IB1*IB2*SU+A1*A2*DU C DET=A11*A22-A12*A12 IF(IIMPI.EQ.9) . WRITE(IOIMP,1000) DET,A11,A22,A12 C IF(DET.NE.0.D0) GO TO 3 WRITE(IOIMP,11) KERRE=640 RETURN C C CALCUL DU: DGLA1, DGLA2 C 3 TRSIGE=SIGEL(1)+SIGEL(2)+SIGEL(3) SIGEQ2=AVM(SIGEL,SIGEL) SIGEQ=SQRT(SIGEQ2) IF(SIGEQ.EQ.0.D0) GO TO 8 TRDSIG=DSIGP(1)+DSIGP(2)+DSIGP(3) C1=A1*TRDSIG IF(IB1.EQ.0)GO TO 4 FF=SIGEL(1)*DSIGP(1)+SIGEL(2)*DSIGP(2)+SIGEL(3)*DSIGP(3) ZZ=2.D0*(SIGEL(4)*DSIGP(4)+SIGEL(5)*DSIGP(5)+SIGEL(6)*DSIGP(6)) TRSIDS=FF+ZZ-TRSIGE*TRDSIG/3.D0 C1=C1+1.5D0*TRSIDS/SIGEQ IF(IIMPI.EQ.9) . WRITE(IOIMP,1001) C1,FF,ZZ,TRDSIG,TRSIDS,TRSIGE 4 C2=A2*TRDSIG IF(IB2.EQ.0) GO TO 5 FF=SIGEL(1)*DSIGP(1)+SIGEL(2)*DSIGP(2)+SIGEL(3)*DSIGP(3) ZZ=2.*(SIGEL(4)*DSIGP(4)+SIGEL(5)*DSIGP(5)+SIGEL(6)*DSIGP(6)) TRSIDS=FF+ZZ-TRSIGE*TRDSIG/3. C2=C2+1.5D0*TRSIDS/SIGEQ IF(IIMPI.EQ.9) . WRITE(IOIMP,1002) C2,FF,ZZ,TRDSIG,TRSIDS,TRSIGE 5 DGLA1=(C1*A22-C2*A12)/DET DGLA2=(C2*A11-C1*A12)/DET IF(IIMPI.EQ.9) . WRITE(IOIMP,1003) DGLA1,DGLA2 C C CALCUL DU: DGLAP1, DGLAP2 C TRSIGE=SIGMAT(1)+SIGMAT(2)+SIGMAT(3) SIGEQ2=AVM(SIGMAT,SIGMAT) SIGEQ=SQRT(SIGEQ2) IF(SIGEQ.EQ.0.D0) GO TO 8 TRDSIG=DSIGP(1)+DSIGP(2)+DSIGP(3) C1=A1*TRDSIG IF(IB1.EQ.0)GO TO 6 FF=SIGMAT(1)*DSIGP(1)+SIGMAT(2)*DSIGP(2)+SIGMAT(3)*DSIGP(3) ZZ=2.D0*(SIGMAT(4)*DSIGP(4)+SIGMAT(5)*DSIGP(5)+SIGMAT(6)*DSIGP(6)) TRSIDS=FF+ZZ-TRSIGE*TRDSIG/3.D0 C1=C1+1.5D0*TRSIDS/SIGEQ IF(IIMPI.EQ.9) . WRITE(IOIMP,1001) C1,FF,ZZ,TRDSIG,TRSIDS,TRSIGE 6 C2=A2*TRDSIG IF(IB2.EQ.0) GO TO 7 FF=SIGMAT(1)*DSIGP(1)+SIGMAT(2)*DSIGP(2)+SIGMAT(3)*DSIGP(3) ZZ=2.D0*(SIGMAT(4)*DSIGP(4)+SIGMAT(5)*DSIGP(5)+SIGMAT(6)*DSIGP(6)) TRSIDS=FF+ZZ-TRSIGE*TRDSIG/3.D0 C2=C2+1.5*TRSIDS/SIGEQ IF(IIMPI.EQ.9) . WRITE(IOIMP,1002) C2,FF,ZZ,TRDSIG,TRSIDS,TRSIGE 7 DGLAP1=(C1*A22-C2*A12)/DET DGLAP2=(C2*A11-C1*A12)/DET IF(IIMPI.EQ.9) . WRITE(IOIMP,1004) DGLAP1,DGLAP2 C C CALCUL DU: DGLAM1, DGLAM2 C CALL KRITER(IC1,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, . DPELA1,DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZR,SIGMAT,FSG,C1,KERRE) CALL KRITER(IC2,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, . DPELA1,DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZR,SIGMAT,FSG,C2,KERRE) DGLAM1=(C1*A22-C2*A12)/DET DGLAM2=(C2*A11-C1*A12)/DET IF(IIMPI.EQ.9) . WRITE(IOIMP,1005) DGLAM1,DGLAM2 C C CALCUL DU: DI1, DI2 C CALL KRITER(IC1,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, . DPELA1,DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZR,SIGEL,FSG,C1,KERRE) CALL KRITER(IC2,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, . DPELA1,DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZR,SIGEL,FSG,C2,KERRE) DI1=(C1*A22-C2*A12)/DET DI2=(C2*A11-C1*A12)/DET IF(IIMPI.EQ.9) . WRITE(IOIMP,1006) DI1,DI2 C C CALCUL DU: DL1, DL2 C DL1=DGLAM1-DGLAP1 DL2=DGLAM2-DGLAP2 IF(IIMPI.EQ.9) . WRITE(IOIMP,1007) DL1,DL2 GOTO 99 C 8 KERRE=640 WRITE(IOIMP,12) RETURN 99 CONTINUE C 10 FORMAT(1X,'ERREUR DANS BRILAM I =',I4) 11 FORMAT(1X,'ERREUR DANS BRILAM DET EGAL A ZERO') 12 FORMAT(1X,'ERREUR DANS BRILAM SIGEQ EGAL A ZERO') C 1000 FORMAT(1X,'DET =',1PD12.5,1X,'A11 =',1PD12.5, . 1X,'A22 =',1PD12.5,1X,'A12 =',1PD12.5) 1001 FORMAT(1X,'C1 =',1PD12.5,1X,'FF =',1PD12.5,/, . 1X,'ZZ =',1PD12.5,1X,'TRDSIG=',1PD12.5,/, . 1X,'TRSIDS=',1PD12.5,1X,'TRSIGE=',1PD12.5) 1002 FORMAT(1X,'C2 =',1PD12.5,1X,'FF =',1PD12.5,/, . 1X,'ZZ =',1PD12.5,1X,'TRDSIG=',1PD12.5,/, . 1X,'TRSIDS=',1PD12.5,1X,'TRSIGE=',1PD12.5) 1003 FORMAT(1X,'DGLA1 =',1PD12.5,1X,'DGLA2 =',1PD12.5) 1004 FORMAT(1X,'DGLAP1=',1PD12.5,1X,'DGLAP2=',1PD12.5) 1005 FORMAT(1X,'DGLAM1=',1PD12.5,1X,'DGLAM2=',1PD12.5) 1006 FORMAT(1X,'DI1 =',1PD12.5,1X,'DI2 =',1PD12.5) 1007 FORMAT(1X,'DL1 =',1PD12.5,1X,'DL2 =',1PD12.5) C RETURN END