1 : C ECUBI1 SOURCE CHAT 05/01/12 23:28:00 5004 2 : SUBROUTINE ECUBI1(SOG1,DSOG1,GAMMA1,PHI1,PSI1,NCAS,TRA1,XNU, 3 : 1 YOUNG,COHE1,TSUG,DEFPL,DLAM1,CO11,SI11,HACHE1,IDAM,KERRE) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : DIMENSION DEFPL(*),TSUG1(4),SOG1(*),DSOG1(*),DSAG1(4),SAG1(4), 7 : 1 DSUG1(4),SYG1(4),SUG1(4),TSUG(4),DEFPL1(4),DSUG(4),DSEG1(4) 8 : ITER=0 9 : ZER=0.D0 10 : DLA1=0.D0 11 : IDAM=1 12 : DO 48 ITYP=1,4 13 : DEFPL(ITYP)=0.D0 14 : 48 CONTINUE 15 : C --------------------------------------------------------- 16 : C ON EFFECTUE L'ECOULEMENT1 .PAS DE 2EME CRITERE 17 : C --------------------------------------------------------- 18 : C ---------------------------------------------- 19 : C ON SE PLACE SUR LE CRITERE 1 20 : C 21 : DO 90 ITYP=1,4 22 : SAG1(ITYP)=SOG1(ITYP)+GAMMA1*DSOG1(ITYP) 23 : DSAG1(ITYP)=(1.D0-GAMMA1)*DSOG1(ITYP) 24 : 90 CONTINUE 25 : C ---------------------------------------------- 26 : C -------------------------------------------------------- 27 : C CALCUL DE DLAMDA 28 : C 29 : CIS1=SIGN(1.D0,SAG1(4)) 30 : 457 VCRIT1=VCRITE(SAG1(2),SAG1(4),PHI1,COHE1) 31 : DLA1=(PHI1*DSAG1(2)+CIS1 32 : 1 *DSAG1(4)+VCRIT1)/HACHE1 33 : C-------------------------- 34 : C CAS DEFO PLANES 35 : C 35 : IF(NCAS.NE.1) CALL DPHOOK(ZER,PSI1*DLA1,ZER,CIS1 36 : 1 *DLA1,DSUG1(1),DSUG1(2),DSUG1(3),DSUG1(4),XNU,YOUNG) 37 : C-------------------------- 38 : C CAS CONT PLANES 39 : C 39 : IF(NCAS.EQ.1) CALL CPHOOK(ZER,PSI1*DLA1,ZER, 40 : # CIS1*DLA1,DSUG1(1),DSUG1(2) 41 : # ,DSUG1(3),DSUG1(4),XNU,YOUNG) 42 : C-------------------------- 43 : DO 91 ITYP=1,4 44 : TSUG1(ITYP)=DSAG1(ITYP)+SAG1(ITYP)-DSUG1(ITYP) 45 : 91 CONTINUE 46 : C--------------------------------------------------------- 47 : C---------------------------------------------------- 48 : C CAS OU ON DEPASSE LA LIMITE EN TRACTION 49 : C ON CALCULE UN NOUVEAU DLAMDA 50 : C 51 : IF(ITER.EQ.0) GO TO 234 52 : DO 77 ITYP=1,4 53 : DSUG1(ITYP)=DSOG1(ITYP)+SOG1(ITYP)-TSUG1(ITYP) 54 : 77 CONTINUE 55 : DLAM1=DLAM1+DLA1 56 : GO TO 700 57 : 234 IF(TSUG1(2).LE.TRA1) DLAM1=DLAM1+DLA1 58 : IF(TSUG1(2).LE.TRA1) GO TO 700 59 : C-------------------------- 60 : C CAS DEFO PLANES 61 : C 61 : IF(NCAS.NE.1) CALL DPHOOK(ZER,PSI1,ZER,CIS1 62 : 1 ,SYG1(1),SYG1(2),SYG1(3),SYG1(4),XNU,YOUNG) 63 : C-------------------------- 64 : C CAS CONT PLANES 65 : C 65 : IF(NCAS.EQ.1) CALL CPHOOK(ZER,PSI1,ZER,CIS1 66 : 1 ,SYG1(1),SYG1(2),SYG1(3),SYG1(4),XNU,YOUNG) 67 : C-------------------------- 68 : C ON CALCULE UN NOUVEAU DLAMDA 69 : C 70 : XAT=(TRA1-SAG1(2)+VCRIT1*SYG1(2)/HACHE1)/(DSAG1(2)-SYG1(2)*(DLA1 71 : 1 -VCRIT1/HACHE1)) 72 : DLA1=XAT*(DLA1-VCRIT1/HACHE1)+VCRIT1/HACHE1 73 : C----------------------------------------------------- 74 : C ON CALCULE LES CONTRAINTES A LA POINTE ET 75 : C L INCREMENT DE CONTRAINTES 76 : C ON EFFECTUE L ECOULEMENT EN RAMENANT A LA POINTE 77 : C DU CRITERE 78 : C AVANT ON REGARDE SI ON PEUT ECOULER SUIVANT L'AUTRE 79 : C DIRECTION D'ECOULEMENT 80 : C----------------------------------------------------- 81 : C 82 : DO 92 ITYP=1,4 83 : TSUG1(ITYP)=SAG1(ITYP)+XAT*DSAG1(ITYP)-DLA1*SYG1(ITYP) 84 : DSEG1(ITYP)=DSAG1(ITYP)*(1.D0-XAT) 85 : 92 CONTINUE 86 : VCRT=-DSEG1(2)+PSI1*ABS(DSEG1(4)) 87 : IF(VCRT.LE.0.D0.OR.ITER.GT.0) GO TO 456 88 : ITER=ITER+1 89 : CIS1=SIGN(1.D0,DSEG1(4)) 90 : DLAM1=DLAM1+DLA1 91 : DO 97 ITYP=1,4 92 : SAG1(ITYP)=TSUG1(ITYP) 93 : DSAG1(ITYP)=DSEG1(ITYP) 94 : 97 CONTINUE 95 : GO TO 457 96 : C----------------------------------------------------- 97 : C CAS DEFO PLANES 98 : C 99 : 456 CONTINUE 100 : IF (NCAS.NE.1) HOOK=YOUNG/(1.D0+XNU)/(1.D0-2.D0*XNU) 101 : IF (NCAS.NE.1) ALPHA=(DSEG1(2)+TSUG1(2)-TRA1)/HOOK /(1.D0-XNU) 102 : IF (NCAS.NE.1) BETA=(DSEG1(4)+TSUG1(4))/HOOK/(1.D0-2.D0*XNU) 103 : C-------------------------- 104 : C CAS CONT PLANES 105 : C 106 : IF (NCAS.EQ.1) HOOK=YOUNG/(1.D0-XNU*XNU) 107 : IF (NCAS.EQ.1) ALPHA=(DSEG1(2)+TSUG1(2)-TRA1)/HOOK 108 : IF (NCAS.EQ.1) BETA=(DSEG1(4)+TSUG1(2))/HOOK/(1.D0-XNU) 109 : C----------------------------------------------------- 109 : IF(NCAS.EQ.1) CALL CPHOOK(ZER,ALPHA,ZER, 110 : # BETA,DSAG1(1),DSAG1(2) 111 : # ,DSAG1(3),DSAG1(4),XNU,YOUNG) 111 : IF(NCAS.NE.1) CALL DPHOOK(ZER,ALPHA,ZER, 112 : # BETA,DSAG1(1),DSAG1(2) 113 : # ,DSAG1(3),DSAG1(4),XNU,YOUNG) 114 : DO 453 ITYP=1,4 115 : TSUG1(ITYP)=TSUG1(ITYP)+DSEG1(ITYP)-DSAG1(ITYP) 116 : DSUG1(ITYP)=DSOG1(ITYP)+SOG1(ITYP)-TSUG1(ITYP) 117 : 453 CONTINUE 118 : DLAM1=DLA1+SQRT((ALPHA*ALPHA+BETA*BETA)/(PSI1*PSI1+1.D0))+DLAM1 118 : 700 CALL CHREPE (CO11,-SI11,DSUG1,DSUG) 118 : CALL CHREPE (CO11,-SI11,TSUG1,TSUG) 119 : C----------------------------------------------------- 120 : C CAS DEFO PLANES 121 : C 121 : IF(NCAS.NE.1) CALL DPCONT(DSUG,DEFPL,XNU,YOUNG) 122 : C-------------------------- 123 : C CAS CONT PLANES 124 : C 124 : IF (NCAS.EQ.1) CALL CPCONT(DSUG,DEFPL,XNU,YOUNG) 125 : C----------------------------------------------------- 126 : RETURN 127 : END 128 :
© Cast3M 2003 - All rights reserved.
Disclaimer