Esope source files

   1 : C TUFIEC    SOURCE    CHAT      05/01/13    03:55:31     5004           
   2 :       SUBROUTINE TUFIEC(XM,XP,DELTAM,DELTAP,THETA,XJP,EP,FIP,
   3 :      &     DLAM1,DLAM2,PRECIS,IRET,XM0,XP0,RAYOM,XLAM0,WORK,EPAI,YOUN,
   4 :      &     THETA0,KERRE)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8(A-H,O-Z)
   7 : C=====================================================================
   8 : C    CE SOUS PROGRAMME REALISE L ECOULEMENT PLASTIQUE
   9 : C      SANS PROPAGATION
  10 : C    IL EST APPELE PAR TUFIPA
  11 : C
  12 : C     ENTREES : XM,XP CONTRAINTES SUR LE CRITERE
  13 : C               DELTAM,DELTAP INCREMENT EN ELASTIQUE
  14 : C               THETA ANGLE DE LA FISSURE
  15 : C               XJP VALEUR DE JP AU DEBUT
  16 : C               IRET REGION OU L ON SE TROUVE
  17 : C
  18 : C     SORTIES : XJP VALEUR DE JP A LA FIN
  19 : C               EP,FIP INCREMENT DE DEFORMATIONS PLASTIQUES
  20 : C               DLAM1,DLAM2 INCREMENT DE LAMBDA
  21 : C=======================================================================
  22 : -INC CCREEL
  23 : *- 
  24 : -INC CCOPTIO
  25 :       SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D)
  26 :       DIMENSION DTUFI(2,2),CTUFI(2,2)
  27 :       XM0SS0=4.D0*RAYOM*RAYOM*EPAI
  28 :       XP0SS0=2.D0*XPI*RAYOM*EPAI
  29 :       NCOURB=SIG(/1)
  30 :       IBI=0
  31 : C
  32 :       IF(IIMPI.EQ.999)WRITE (IOIMP,*) 'ENTREE DANS TUFIEC'
  33 : C
  34 : C  ON TESTE SUR QUELLE SURFACE ON DOIT PROJETTER
  35 : C
  36 : *    CAS DE L OUVERTURE
  37 :       IF(IRET.EQ.1) SENS=1.d0
  38 : *    CAS DE LA FERMETURE
  39 :       IF(IRET.EQ.3) SENS=-1.D0
  40 : *    POINTS SINGULIERS
  41 :       IF(IRET.NE.1.AND.IRET.NE.3) GOTO 2
  42 : C
  43 : C      POINTS NON SINGULIERS   ON FAIT L ECOULEMENT
  44 : C
  45 :       NBIT=0
  45 :       CALL TUFIHO(THETA0,DTUFI,CTUFI,YOUN,RAYOM,EPAI)
  46 : C
  47 : C       1ERE ESTIMATION : TOUT EST ELASTIQUE
  48 : C
  49 :       EP1=0.D0
  50 :       FIP1=0.D0
  51 :       XM1=XM+DELTAM
  52 :       XP1=XP+DELTAP
  53 :       XLAM1=XLAM0
  53 :       CALL TRACTI(SIGMA1,XLAM1,SIG,XLAM,NCOURB,2,IBI)
  54 :       IF(IBI.EQ.1) THEN
  55 :           KERRE=75
  56 :           RETURN
  57 :       ENDIF
  58 :       XM0=XM0SS0*SIGMA1
  59 :       XP0=XP0SS0*SIGMA1
  60 :       F1=CRIT1(XM1,XP1,THETA0,XM0,XP0)
  61 : 
  62 : C
  63 : C       2EME ESTIMATION : TOUT EST PLASTIQUE
  64 : C  SI BEAUCOUP TROP GRAND , ESTIMATION A PARTIR COURBE (M,PHIP)
  65 : C
  65 :       CALL TRACTI(PENTE1,XLAM1,SIG,XLAM,NCOURB,1,IBI)
  66 :       FIP21=DABS((DELTAM/XM0SS0)/PENTE1)
  67 :       FIP2=CTUFI(1,1)*DELTAM+CTUFI(1,2)*DELTAP
  68 :       AFIP2=SENS*FIP2
  69 :       IF (FIP21.LT.AFIP2) FIP2=FIP21*SENS
  70 :       FIP=CTUFI(1,1)*DELTAM+CTUFI(1,2)*DELTAP
  71 :       EP=CTUFI(1,2)*DELTAM+CTUFI(2,2)*DELTAP
  72 :       ALPH=EP/FIP
  73 :       EP2=ALPH*FIP2
  74 : 
  75 :       XLAM2=XLAM0+FIP2*SENS
  75 :       CALL TRACTI(SIGMA2,XLAM2,SIG,XLAM,NCOURB,2,IBI)
  76 :       IF(IBI.EQ.1) THEN
  77 :           KERRE=75
  78 :           RETURN
  79 :       ENDIF
  80 :       XM0=XM0SS0*SIGMA2
  81 :       XP0=XP0SS0*SIGMA2
  82 :       DM2=DELTAM-DTUFI(1,1)*FIP2-DTUFI(1,2)*EP2
  83 :       DP2=DELTAP-DTUFI(1,2)*FIP2-DTUFI(2,2)*EP2
  84 :       XM2=XM+DM2
  85 :       XP2=XP+DP2
  86 :       F2=CRIT1(XM2,XP2,THETA0,XM0,XP0)
  87 :       IF (ABS(F2).LT.PRECIS) THEN
  88 :          FIP3=FIP2
  89 :          EP3=EP2
  90 :          XM3=XM2
  91 :          XP3=XP2
  92 :          SIGMA3=SIGMA2
  93 :          GOTO 20
  94 :       ENDIF
  95 : C
  96 : C    DETERMINATION DE DELTA LAMBDA PAR DICHOTOMIE
  97 : C
  98 :  11   CONTINUE
  99 :       NBIT=NBIT+1
 100 : C
 101 : C   TEST SUR LE NOMBRE D ITERATIONS INTERNES
 102 : C
 103 :       IF(NBIT.GT.50) THEN
 104 :          KERRE=2
 105 :          RETURN
 106 :       ENDIF
 107 :       FP=(FIP2-FIP1)/(F2-F1)
 108 :       FIP3=FIP1-FP*F1
 109 :       XLAM3=XLAM0+FIP3*SENS
 109 :       CALL TRACTI(SIGMA3,XLAM3,SIG,XLAM,NCOURB,2,IBI)
 110 :       IF(IBI.EQ.1) THEN
 111 :           KERRE=75
 112 :           RETURN
 113 :       ENDIF
 114 :       XM0=XM0SS0*SIGMA3
 115 :       XP0=XP0SS0*SIGMA3
 116 :       EP3=ALPH*FIP3
 117 :       DM3=DELTAM-DTUFI(1,1)*FIP3-DTUFI(1,2)*EP3
 118 :       DP3=DELTAP-DTUFI(1,2)*FIP3-DTUFI(2,2)*EP3
 119 :       XM3=XM+DM3
 120 :       XP3=XP+DP3
 121 :       F3=CRIT1(XM3,XP3,THETA0,XM0,XP0)
 122 : C
 123 : C    TESTS DE CONVERGENCE
 124 : C
 125 :       IF (ABS(F3).LT.PRECIS) GOTO 20
 126 : C
 127 :       IF ((F1*F3).LT.0.D0) THEN
 128 :          FIP2=FIP3
 129 :          F2=F3
 130 :          GO TO 11
 131 :       ENDIF
 132 :       IF (((F1*F2).GT.0.D0).OR.((F3*F2).LT.0.D0)) THEN
 133 :          FIP1=FIP3
 134 :          F1=F3
 135 :          GO TO 11
 136 :       ENDIF
 137 :  20   CONTINUE
 138 :       IF(IRET.EQ.1) THEN
 139 :          DLAM1=FIP3
 140 :          DLAM2=0.D0
 141 :       ELSE
 142 :          DLAM1=0.D0
 143 :          DLAM2=FIP3*SENS
 144 :       ENDIF
 145 :       FIP=FIP3
 146 :       EP=EP3
 147 :       XM=XM3
 148 :       XP=XP3
 149 : C     DJP=RAYOM*COS(THETA)*DLAM1/XM0
 150 : C     DJP=RAYOM*COS(THETA)*FIP
 151 : C     DJP=SIGMA3*(DJP+EP)
 152 :       DJP=RAYOM*SIGMA3*(COS(THETA)+SIN(THETA/2.D0))*FIP*SENS
 153 :       XJP=XJP+DJP
 154 :       IF(IIMPI.EQ.999)THEN
 155 :          WRITE (IOIMP,*) 'NBRE ITERATIONS',NBIT
 156 :          WRITE (IOIMP,*)'SORTIE DE TUFIEC'
 157 :       ENDIF
 158 :       RETURN
 159 : C
 160 : C    CAS DES POINTS SINGULIERS DE LA SURFACE
 161 : C
 162 :  2    CONTINUE
 163 :       XM1=XM+DELTAM
 164 :       XP1=XP+DELTAP
 165 :       IF(IIMPI.EQ.999)WRITE(IOIMP,*)'ON EST SUR UNE POINTE'
 166 :       KERRE=21
 167 : C
 168 : C    ON CHERCHE OU L ON VA PROJETTER
 169 : C
 169 : C     CALL TUFINO(XM1,XP1,THETA,ISOR,XM0,XP0)
 170 : C     IF(ISOR.EQ.1) GO TO 10
 171 : C     IF(ISOR.EQ.3) GO TO 30
 172 : C
 173 : C   ON PROJETTE SUR LA POINTE
 174 : C
 175 : C     IF(IIMPI.EQ.999)WRITE(IOIMP,*)'ON PROJETTE SUR LA POINTE'
 175 : C     CALL TUFIHO(THETA,DTUFI,CTUFI,YOUN,RAYOM,EPAI)
 176 : C     FIP=CTUFI(1,1)*DELTAM+CTUFI(1,2)*DELTAP
 177 : C     EP=CTUFI(1,2)*DELTAM+CTUFI(2,2)*DELTAP
 178 : C     DJP=SIGMA0*ABS(EP)
 179 : C     XJP=XJP+DJP
 180 :       IF(IIMPI.EQ.999)WRITE (IOIMP,*) 'SORTIE DE TUFIEC'
 181 :       RETURN
 182 :       END
 183 : 
 184 : 
 185 : 
 186 :  
 187 :  
 188 :