Sources Esope | Cast3M

brilam
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 PPARAM
-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