Télécharger la plaquette Cast3M


fr en

Télécharger dp.eso

Retour à la liste

Numérotation des lignes : 

dp

  1. C DP        SOURCE    CB215821  26/10/26    21:15:28     12682          
  2.       SUBROUTINE DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP,
  3.      1 XLAM1,XLAM2,XLAM3,IDAM,ANG,IFISSU,EPPLDP,EPPLTR,ALPHA,KERRE)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9.       DIMENSION SIG(3),DSIG(3),SGG(3),DSGG(3),SFG(3),DSFG(3),
  10.      1 A(3),B(3),IDAM(3),EPC(3),EPDP(3),SSI(3),SI(3),EPC1(3),
  11.      1 EPPLDP(3),EPPLTR(3)
  12.       ITER=0
  13.       SIREF=1.E-6*YOUN
  14.       IF(IFISSU.EQ.1) BETA=ALPHA
  15.       IF(IFISSU.EQ.0) BETA=1.D0
  16.       DO 10 ITYP=1,3
  17.       EPPLTR(ITYP)=0.D0
  18.       EPPLDP(ITYP)=0.D0
  19.       EPDP(ITYP)=0.D0
  20.    10 CONTINUE
  21.       ISOR=0
  22.       XT=0.D0
  23.       IF(IIMPI.EQ.9) WRITE(IOIMP,9999)
  24. 9999  FORMAT(1X,'DP ECOULEMENT SUIVANT DRUCKER',/)
  25.  9998 FORMAT(1X,'DP ',I4,'ITERATIONS INTERNES',/)
  26. C-----------------------------------------------
  27. C     ON SEPLACE DANS LE REPERE DE FISSURATION
  28. C-----------------------------------------------
  29. C
  30.       CALL CHREP(SIG,SFG,ANG)
  31.       CALL CHREP(DSIG,DSFG,ANG)
  32. C
  33. C------------------------------------------------
  34. C     ECOULEMENT SUIVANT LE DRUCKER SEUL
  35. C------------------------------------------------
  36. C----------------------------------------------
  37. C     DEFINITION D UNE CONTRAINTE DE REFERENCE
  38. C     SI RMAX DU DRUCKER INFERIEURE A CETTE VALEUR
  39. C     ALORS SIGMA=0
  40. C----------------------------------------------
  41. C
  42.       RMAX=MAX((RDP/1.73D0),(RDP/(1.D0-2.D0*ADP)))
  43.       IF(SIREF.LT.RMAX) GOTO 29
  44.    19 DO 20 ITYP=1,3
  45.       SIG(ITYP)=SIG(ITYP)+DSIG(ITYP)
  46.    20 CONTINUE
  47.       CALL NORME(SIG,DL3)
  48.       DL3=DL3/YOUN*10.D0
  49.       XLAM3=XLAM3+DL3
  50.       RDP=0.D0
  51.       HDP=0.D0
  52.       ADP=0.D0
  53.       CALL CPHOIN(SIG,EPPLDP,YOUN,ANU)
  54.       DO 30 ITYP=1,3
  55.       IDAM(ITYP)=0
  56.       DSIG(ITYP)=0.D0
  57.       SIG(ITYP)=0.D0
  58.    30 CONTINUE
  59.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  60.       RETURN
  61. C
  62. C-----------------------------------------------------
  63. C     ESTIMATION DU PAS D'INCREMENT DE CONTRAINTES
  64. C-----------------------------------------------------
  65. C
  66. C  29 CALL GDP(SIG,DSIG,RDP,ADP,GAMDP)
  67. C     IF(GAMDP.GT.1.E-8) THEN
  68. C     IDAM(3)=0
  69. C     RETURN
  70. C
  71.    29 CALL SIJ(SFG,SI,SIETOI)
  72.       CALL EPSDP(SI,SIETOI,ADP,EPC)
  73.       CALL CPHOMO(EPC,SSI,YOUN,ANU,BETA)
  74.       CALL SCAL(SSI,DSFG,VAL)
  75.       CALL NORME(DSFG,VA1)
  76.       CALL NORME(SSI,VA2)
  77.       RMIN=MIN((RDP/1.73D0),(RDP/(1.D0+2.D0*ADP)))
  78.       IF(VA1.EQ.0.D0) THEN
  79.       IDAM(3)=0
  80.       RETURN
  81.       ENDIF
  82.       X=VAL/VA1/VA2
  83.       IF(X.GE.1.D0) THEN
  84.       X=1.D0
  85.       GOTO 31
  86.       ENDIF
  87.       X=RMIN/SQRT(1.0001D0-X*X)/VA1/8.D0
  88.       IF(X.GT.1.D0) X=1.D0
  89. C
  90. C----------------------------------------------------------
  91. C     ON ECOULE ET ON REGARDE LA VARIATION DE NORMALE
  92. C----------------------------------------------------------
  93. C
  94.    31 ITER=ITER+1
  95.       IF(ITER.GT.201) GOTO 653
  96.       DO 45 ITYP=1,3
  97.       DSGG(ITYP)=DSFG(ITYP)*X
  98.       A(ITYP)=SFG(ITYP)+DSGG(ITYP)
  99.       B(ITYP)=-SSI(ITYP)
  100.    45 CONTINUE
  101.       CALL SCAL2(EPC,SSI,VAL)
  102.       VAL=VAL-HDP
  103.       IF(VAL.LT.0.D0) THEN
  104.       KERRE=459
  105.       RETURN
  106.       ENDIF
  107.       ITER=ITER+1
  108.   653 IF(ITER.GT.200) THEN
  109.       KERRE=460
  110.       RETURN
  111.       ENDIF
  112.       CALL DLAMDP(A,B,DL3,RDP,ADP,HDP,ITEST)
  113.       IF(ITEST.EQ.1) THEN
  114.       X=X/2.D0
  115.       GOTO 31
  116.       ENDIF
  117.       DO 50 ITYP=1,3
  118.       SGG(ITYP)=A(ITYP)+DL3*B(ITYP)
  119.    50 CONTINUE
  120.       CALL SIJ(SGG,SI,SIETOI)
  121.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  122.       CALL SCAL(EPC,EPC1,VAL)
  123.       CALL NORME(EPC,VA1)
  124.       CALL NORME(EPC1,VA2)
  125.       CO=VAL/VA1/VA2
  126.       IF(CO.LT.0.99) THEN
  127.       X=X/2.D0
  128.       GOTO 31
  129.       ENDIF
  130.       IF(DL3.LT.0.D0) THEN
  131.       IDAM(3)=0
  132.       DL3=0.D0
  133.       ISOR=1
  134.       GOTO 525
  135.       ENDIF
  136.       RD=RDP-DL3*HDP
  137.       IF(RD.LT.SIREF) GOTO 19
  138.       IF(IFISSU.EQ.1) GOTO 100
  139.       CALL CTRSF(SGG,RT1,VAL)
  140.       IF(VAL.LE.0.D0) GOTO 500
  141. C
  142. C-------------------------------------------------
  143. C     CAS OU LA LIMITE EN TRACTION EST DEPASSEE
  144. C     MAIS ON NE CONNAIT PAS LE REPERE PRINCIPAL
  145. C     DE FISSURATION
  146. C-------------------------------------------------
  147.       IFISSU=1
  148.       CALL CANG(SGG,ANG,YOUN)
  149.       DO 55 ITYP=1,3
  150.       DSGG(ITYP)=SFG(ITYP)
  151.    55 CONTINUE
  152.       CALL CHREP(DSGG,SFG,ANG)
  153.       CALL CHREP(DSIG,DSFG,ANG)
  154.       CALL SIJ(SFG,SI,SIETOI)
  155.       CALL EPSDP(SI,SIETOI,ADP,EPC)
  156.       CALL CPHOMO(EPC,SSI,YOUN,ANU,BETA)
  157.       DO 60 ITYP=1,3
  158.       DSGG(ITYP)=DSFG(ITYP)*X
  159.       A(ITYP)=SFG(ITYP)+DSGG(ITYP)
  160.       B(ITYP)=-SSI(ITYP)
  161.   60  CONTINUE
  162.       CALL DLAMDP(A,B,DL3,RDP,ADP,HDP,ITEST)
  163.       DO 65 ITYP=1,3
  164.       SGG(ITYP)=A(ITYP)+DL3*B(ITYP)
  165.    65 CONTINUE
  166.       CALL CTRAF(SGG(1),RT1,VCTR1)
  167.       IF(VCTR1.LE.0.D0) GOTO 80
  168. C
  169. C------------------------------------
  170. C     ON ENDOMMAGE LA TRACTION 1
  171. C------------------------------------
  172. C
  173.       ISOR=1
  174.       IF(DSFG(1).NE.0.D0) THEN
  175.       E=(RT1-SFG(1))/DSFG(1)
  176.       F=SSI(1)/DSFG(1)
  177.       DO 70 ITYP=1,3
  178.       A(ITYP)=SFG(ITYP)+E*DSFG(ITYP)
  179.       B(ITYP)=-SSI(ITYP)+F*DSFG(ITYP)
  180.    70 CONTINUE
  181.       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  182.       DO 69 ITYP=1,3
  183.       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  184.       DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  185.    69 CONTINUE
  186.       CALL SIJ(SGG,SI,SIETOI)
  187.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  188.       CALL SCAL(EPC,EPC1,VAL)
  189.       CALL NORME(EPC,VA1)
  190.       CALL NORME(EPC1,VA2)
  191.       CO1=VAL/VA1/VA2
  192.       CALL SIJ(DSGG,SI,SIETOI)
  193.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  194.       CALL SCAL(EPC,EPC1,VAL)
  195.       CALL NORME(EPC,VA1)
  196.       CALL NORME(EPC1,VA2)
  197.       CO2=VAL/VA1/VA2
  198.       XIN1=E+F*DL31
  199.       XIN2=E+F*DL32
  200.       IF(XIN1.GT.-1.E-10.AND.XIN1.LE.X.AND.CO1.GT.0.9) THEN
  201.       X=XIN1
  202.       DL3=DL31
  203.       GOTO 71
  204.       ENDIF
  205.       IF(XIN2.GT.-1.E-10.AND.XIN2.LE.X.AND.CO2.GT.0.9) THEN
  206.       X=XIN2
  207.       DL3=DL32
  208.       GOTO 71
  209.       ENDIF
  210.       IF(IIMPI.EQ.9) WRITE(IOIMP,10101)
  211. 10101 FORMAT(1X,'ERREUR DP TRACTION 1 SF',/)
  212.       DL3=DL31
  213.       X=XIN1
  214.    71 DO 72 ITYP=1,3
  215.       SGG(ITYP)=A(ITYP)+DL3*B(ITYP)
  216.    72 CONTINUE
  217.       IDAM(1)=1
  218.       IDAM(2)=0
  219.       IDAM(3)=1
  220.       GOTO 80
  221.       ENDIF
  222.       DL3=(-RT1+SFG(1))/SSI(1)
  223.       RD=RDP-DL3*HDP
  224.       IF(RD.LT.SIREF) GOTO 19
  225.       DO 74 ITYP=1,3
  226.       A(ITYP)=SFG(ITYP)-DL3*SSI(ITYP)
  227.       B(ITYP)=DSFG(ITYP)
  228.    74 CONTINUE
  229.       CALL XDP(A,B,RD,ADP,X,ITEST)
  230.       DO 76 ITYP=1,3
  231.       SGG(ITYP)=A(ITYP)+X*B(ITYP)
  232.    76 CONTINUE
  233.       IDAM(1)=1
  234.       IDAM(2)=0
  235.       IDAM(3)=1
  236. C
  237. C------------------------------------
  238. C     ON ENDOMMAGE LA TRACTION 2
  239. C------------------------------------
  240. C
  241.    80 CALL CTRAF(SGG(2),RT2,VCTR2)
  242.       IF(VCTR2.LE.0.D0) GOTO 91
  243.       ISOR=1
  244.       IF(DSFG(2).NE.0.D0) THEN
  245.       E=(RT2-SFG(2))/DSFG(2)
  246.       F=SSI(2)/DSFG(2)
  247.       DO 82 ITYP=1,3
  248.       A(ITYP)=SFG(ITYP)+E*DSFG(ITYP)
  249.       B(ITYP)=-SSI(ITYP)+F*DSFG(ITYP)
  250.    82 CONTINUE
  251.       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  252.       DO 81 ITYP=1,3
  253.       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  254.       DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  255.    81 CONTINUE
  256.       CALL SIJ(SGG,SI,SIETOI)
  257.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  258.       CALL SCAL(EPC,EPC1,VAL)
  259.       CALL NORME(EPC,VA1)
  260.       CALL NORME(EPC1,VA2)
  261.       CO1=VAL/VA1/VA2
  262.       CALL SIJ(DSGG,SI,SIETOI)
  263.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  264.       CALL SCAL(EPC,EPC1,VAL)
  265.       CALL NORME(EPC,VA1)
  266.       CALL NORME(EPC1,VA2)
  267.       CO2=VAL/VA1/VA2
  268.       XIN1=E+F*DL31
  269.       XIN2=E+F*DL32
  270.       IF(XIN1.GT.-1.E-10.AND.XIN1.LE.X.AND.CO1.GT.0.9) THEN
  271.       X=XIN1
  272.       DL3=DL31
  273.       GOTO 83
  274.       ENDIF
  275.       IF(XIN2.GT.-1.E-10.AND.XIN2.LE.X.AND.CO2.GT.0.9) THEN
  276.       X=XIN2
  277.       DL3=DL32
  278.       GOTO 83
  279.       ENDIF
  280.       IF(IIMPI.EQ.9) WRITE(IOIMP,20202)
  281. 20202 FORMAT(1X,'ERREUR DP TRACTION 2 SF',/)
  282.       DL3=DL31
  283.       X=XIN1
  284.    83 DO 84 ITYP=1,3
  285.       SGG(ITYP)=A(ITYP)+DL3*B(ITYP)
  286.    84 CONTINUE
  287.       IDAM(1)=0
  288.       IDAM(2)=1
  289.       IDAM(3)=1
  290.       GOTO 91
  291.       ENDIF
  292.       DL3=(-RT2+SFG(2))/SSI(2)
  293.       RD=RDP-DL3*HDP
  294.       IF(RD.LT.SIREF) GOTO 19
  295.       DO 86 ITYP=1,3
  296.       A(ITYP)=SFG(ITYP)-DL3*SSI(ITYP)
  297.       B(ITYP)=DSFG(ITYP)
  298.    86 CONTINUE
  299.       CALL XDP(A,B,RD,ADP,X,ITEST)
  300.       DO 88 ITYP=1,3
  301.       SGG(ITYP)=A(ITYP)+X*B(ITYP)
  302.    88 CONTINUE
  303.       IDAM(1)=0
  304.       IDAM(2)=1
  305.       IDAM(3)=1
  306.    91 RDP=RDP-DL3*HDP
  307.       IF(RDP.LT.SIREF) THEN
  308.       ANG=0.D0
  309.       IFISSU=0
  310.       GOTO 19
  311.       ENDIF
  312.       XT=XT+X
  313.       DO 90 ITYP=1,3
  314.       SFG(ITYP)=SGG(ITYP)
  315.       DSFG(ITYP)=(1.D0-XT)*DSFG(ITYP)
  316.    90 CONTINUE
  317.       DSGG(1)=0.D0
  318.       DSGG(2)=0.D0
  319.       DSGG(3)=(1.D0-ALPHA)*DSFG(3)
  320.       CALL CPHOIN(DSGG,SGG,YOUN,ANU)
  321.       CALL CHREP(SGG,EPPLTR,-ANG)
  322.       DO 92 ITYP=1,3
  323.       SGG(ITYP)=DL3*EPC(ITYP)
  324.    92 CONTINUE
  325.       CALL CHREP(SGG,EPPLDP,-ANG)
  326.       DO 94 ITYP=1,3
  327.       EPPLDP(ITYP)=EPPLDP(ITYP)+EPDP(ITYP)
  328.    94 CONTINUE
  329.       CALL CHREP(SFG,SIG,-ANG)
  330.       DSFG(3)=ALPHA*DSFG(3)
  331.       CALL CHREP(DSFG,DSIG,-ANG)
  332.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  333.       CALL GDP(SIG,DSIG,RDP,ADP,GAMDP)
  334.       IF(GAMDP.GT.1.E-8) IDAM(3)=0
  335.       RETURN
  336. C
  337. C------------------------------------------------------------
  338. C     ON REGARDE SI ON N ENDOMMAGE PAS LES AUTRES CRITERES
  339. C     AUQUEL CAS IL FAUT CALCULER X POUR ARRIVER AU COUPLAGE
  340. C------------------------------------------------------------
  341. C------------------------------------
  342. C     ON ENDOMMAGE LA TRACTION 1
  343. C------------------------------------
  344. C
  345.  100  CONTINUE
  346.       CALL CTRAF(SGG(1),RT1,VCTR1)
  347.       CALL CCOAF(SGG(1),XLAM1,VCCO1)
  348.       IF(VCTR1.GT.0.D0) GOTO 105
  349.       IF(VCCO1.GT.0.D0) GOTO 200
  350.       CALL CTRAF(SGG(2),RT2,VCTR2)
  351.       CALL CCOAF(SGG(2),XLAM2,VCCO2)
  352.       IF(VCTR2.GT.0.D0) GOTO 300
  353.       IF(VCCO2.GT.0.D0) GOTO 400
  354.       GOTO 500
  355.   105 ISOR=1
  356.       IF(DSFG(1).NE.0.D0) THEN
  357.       E=(RT1-SFG(1))/DSFG(1)
  358.       F=SSI(1)/DSFG(1)
  359.       DO 110 ITYP=1,3
  360.       A(ITYP)=SFG(ITYP)+E*DSFG(ITYP)
  361.       B(ITYP)=-SSI(ITYP)+F*DSFG(ITYP)
  362.   110 CONTINUE
  363.       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  364.       DO 111 ITYP=1,3
  365.       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  366.       DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  367.   111 CONTINUE
  368.       CALL SIJ(SGG,SI,SIETOI)
  369.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  370.       CALL SCAL(EPC,EPC1,VAL)
  371.       CALL NORME(EPC,VA1)
  372.       CALL NORME(EPC1,VA2)
  373.       CO1=VAL/VA1/VA2
  374.       CALL SIJ(DSGG,SI,SIETOI)
  375.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  376.       CALL SCAL(EPC,EPC1,VAL)
  377.       CALL NORME(EPC,VA1)
  378.       CALL NORME(EPC1,VA2)
  379.       CO2=VAL/VA1/VA2
  380.       XIN1=E+F*DL31
  381.       XIN2=E+F*DL32
  382.       IF(XIN1.GT.-1.E-10.AND.XIN1.LE.X.AND.CO1.GT.0.9) THEN
  383.       X=XIN1
  384.       DL3=DL31
  385.       GOTO 119
  386.       ENDIF
  387.       IF(XIN2.GT.-1.E-10.AND.XIN2.LE.X.AND.CO2.GT.0.9) THEN
  388.       X=XIN2
  389.       DL3=DL32
  390.       GOTO 119
  391.       ENDIF
  392.       IF(IIMPI.EQ.9) WRITE(IOIMP,30303)
  393. 30303 FORMAT(1X,'ERREUR DP TRACTION 1 AF',/)
  394.       DL3=DL31
  395.       X=XIN1
  396.   119 DO 120 ITYP=1,3
  397.       SGG(ITYP)=A(ITYP)+DL3*B(ITYP)
  398.   120 CONTINUE
  399.       IDAM(1)=1
  400.       IDAM(2)=0
  401.       IDAM(3)=1
  402.       GOTO 150
  403.       ENDIF
  404.       DL3=(-RT1+SFG(1))/SSI(1)
  405.       RD=RDP-DL3*HDP
  406.       IF(RDP.LT.SIREF) GOTO 19
  407.       DO 130 ITYP=1,3
  408.       A(ITYP)=SFG(ITYP)-DL3*SSI(ITYP)
  409.       B(ITYP)=DSFG(ITYP)
  410.   130 CONTINUE
  411.       CALL XDP(A,B,RD,ADP,X,ITEST)
  412.       DO 140 ITYP=1,3
  413.       SGG(ITYP)=A(ITYP)+X*B(ITYP)
  414.   140 CONTINUE
  415.       IDAM(1)=1
  416.       IDAM(2)=0
  417.       IDAM(3)=1
  418.   150 CALL CTRAF(SGG(2),RT2,VCTR2)
  419.       CALL CCOAF(SGG(2),XLAM2,VCCO2)
  420.       IF(VCTR2.GT.0.D0) GOTO 300
  421.       IF(VCCO2.GT.0.D0) GOTO 400
  422.       GOTO 500
  423. C
  424. C------------------------------------
  425. C     ON ENDOMMAGE LA COMPRESSION 1
  426. C------------------------------------
  427. C
  428.   200 ISOR=1
  429.       IF(DSFG(1).NE.0.D0) THEN
  430.       E=SFG(1)/DSFG(1)
  431.       F=SSI(1)/DSFG(1)
  432.       DO 210 ITYP=1,3
  433.       A(ITYP)=SFG(ITYP)-E*DSFG(ITYP)
  434.       B(ITYP)=-SSI(ITYP)+F*DSFG(ITYP)
  435.   210 CONTINUE
  436.       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  437.       DO 211 ITYP=1,3
  438.       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  439.       DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  440.   211 CONTINUE
  441.       CALL SIJ(SGG,SI,SIETOI)
  442.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  443.       CALL SCAL(EPC,EPC1,VAL)
  444.       CALL NORME(EPC,VA1)
  445.       CALL NORME(EPC1,VA2)
  446.       CO1=VAL/VA1/VA2
  447.       CALL SIJ(DSGG,SI,SIETOI)
  448.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  449.       CALL SCAL(EPC,EPC1,VAL)
  450.       CALL NORME(EPC,VA1)
  451.       CALL NORME(EPC1,VA2)
  452.       CO2=VAL/VA1/VA2
  453.       XIN1=-E+F*DL31
  454.       XIN2=-E+F*DL32
  455.       IF(XIN1.GT.-1.E-10.AND.XIN1.LE.X.AND.CO1.GT.0.9) THEN
  456.       X=XIN1
  457.       DL3=DL31
  458.       GOTO 219
  459.       ENDIF
  460.       IF(XIN2.GT.-1.E-10.AND.XIN2.LE.X.AND.CO2.GT.0.9) THEN
  461.       X=XIN2
  462.       DL3=DL32
  463.       GOTO 219
  464.       ENDIF
  465.       IF(IIMPI.EQ.9) WRITE(IOIMP,40404)
  466. 40404 FORMAT(1X,'ERREUR DP COMPRESSION 1',/)
  467.       DL3=DL31
  468.       X=XIN1
  469.   219 DO 220 ITYP=1,3
  470.       SGG(ITYP)=A(ITYP)+DL3*B(ITYP)
  471.   220 CONTINUE
  472.       IDAM(1)=-1
  473.       IDAM(2)=0
  474.       IDAM(3)=1
  475.       GOTO 250
  476.       ENDIF
  477.       DL3=SFG(1)/SSI(1)
  478.       RD=RDP-DL3*HDP
  479.       IF(RD.LT.SIREF) GOTO 19
  480.       DO 230 ITYP=1,3
  481.       A(ITYP)=SFG(ITYP)-DL3*SSI(ITYP)
  482.       B(ITYP)=DSFG(ITYP)
  483.   230 CONTINUE
  484.       CALL XDP(A,B,RD,ADP,X,ITEST)
  485.       DO 240 ITYP=1,3
  486.       SGG(ITYP)=A(ITYP)+X*B(ITYP)
  487.   240 CONTINUE
  488.       IDAM(1)=-1
  489.       IDAM(2)=0
  490.       IDAM(3)=1
  491.   250 CALL CTRAF(SGG(2),RT2,VCTR2)
  492.       CALL CCOAF(SGG(2),XLAM2,VCCO2)
  493.       IF(VCTR2.GT.0.D0) GOTO 300
  494.       IF(VCCO2.GT.0.D0) GOTO 400
  495.       GOTO 500
  496. C
  497. C------------------------------------
  498. C     ON ENDOMMAGE LA TRACTION 2
  499. C------------------------------------
  500. C
  501.   300 ISOR=1
  502.       IF(DSFG(2).NE.0.D0) THEN
  503.       E=(RT2-SFG(2))/DSFG(2)
  504.       F=SSI(2)/DSFG(2)
  505.       DO 310 ITYP=1,3
  506.       A(ITYP)=SFG(ITYP)+E*DSFG(ITYP)
  507.       B(ITYP)=-SSI(ITYP)+F*DSFG(ITYP)
  508.   310 CONTINUE
  509.       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  510.       DO 311 ITYP=1,3
  511.       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  512.       DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  513.   311 CONTINUE
  514.       CALL SIJ(SGG,SI,SIETOI)
  515.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  516.       CALL SCAL(EPC,EPC1,VAL)
  517.       CALL NORME(EPC,VA1)
  518.       CALL NORME(EPC1,VA2)
  519.       CO1=VAL/VA1/VA2
  520.       CALL SIJ(DSGG,SI,SIETOI)
  521.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  522.       CALL SCAL(EPC,EPC1,VAL)
  523.       CALL NORME(EPC,VA1)
  524.       CALL NORME(EPC1,VA2)
  525.       CO2=VAL/VA1/VA2
  526.       XIN1=E+F*DL31
  527.       XIN2=E+F*DL32
  528.       IF(XIN1.GT.-1.E-10.AND.XIN1.LE.X.AND.CO1.GT.0.9) THEN
  529.       X=XIN1
  530.       DL3=DL31
  531.       GOTO 319
  532.       ENDIF
  533.       IF(XIN2.GT.-1.E-10.AND.XIN2.LE.X.AND.CO2.GT.0.9) THEN
  534.       X=XIN2
  535.       DL3=DL32
  536.       GOTO 319
  537.       ENDIF
  538.       IF(IIMPI.EQ.9) WRITE(IOIMP,50505)
  539. 50505 FORMAT(1X,'ERREUR DP TRACTION 2 AF',/)
  540.       DL3=DL31
  541.       X=XIN1
  542.   319 DO 320 ITYP=1,3
  543.       SGG(ITYP)=A(ITYP)+DL3*B(ITYP)
  544.   320 CONTINUE
  545.       IDAM(1)=0
  546.       IDAM(2)=1
  547.       IDAM(3)=1
  548.       GOTO 500
  549.       ENDIF
  550.       DL3=(-RT2+SFG(2))/SSI(2)
  551.       RD=RDP-DL3*HDP
  552.       IF(RD.LT.SIREF) GOTO 19
  553.       DO 330 ITYP=1,3
  554.       A(ITYP)=SFG(ITYP)-DL3*SSI(ITYP)
  555.       B(ITYP)=DSFG(ITYP)
  556.   330 CONTINUE
  557.       CALL XDP(A,B,RD,ADP,X,ITEST)
  558.       DO 340 ITYP=1,3
  559.       SGG(ITYP)=A(ITYP)+X*B(ITYP)
  560.   340 CONTINUE
  561.       IDAM(1)=0
  562.       IDAM(2)=1
  563.       IDAM(3)=1
  564.       GOTO 500
  565. C
  566. C------------------------------------
  567. C     ON ENDOMMAGE LA COMPRESSION 2
  568. C------------------------------------
  569. C
  570.   400 ISOR=1
  571.       IF(DSFG(2).NE.0.D0) THEN
  572.       E=SFG(2)/DSFG(2)
  573.       F=SSI(2)/DSFG(2)
  574.       DO 410 ITYP=1,3
  575.       A(ITYP)=SFG(ITYP)-E*DSFG(ITYP)
  576.       B(ITYP)=-SSI(ITYP)+F*DSFG(ITYP)
  577.   410 CONTINUE
  578.       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  579.       DO 411 ITYP=1,3
  580.       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  581.       DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  582.   411 CONTINUE
  583.       CALL SIJ(SGG,SI,SIETOI)
  584.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  585.       CALL SCAL(EPC,EPC1,VAL)
  586.       CALL NORME(EPC,VA1)
  587.       CALL NORME(EPC1,VA2)
  588.       CO1=VAL/VA1/VA2
  589.       CALL SIJ(DSGG,SI,SIETOI)
  590.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  591.       CALL SCAL(EPC,EPC1,VAL)
  592.       CALL NORME(EPC,VA1)
  593.       CALL NORME(EPC1,VA2)
  594.       CO2=VAL/VA1/VA2
  595.       XIN1=-E+F*DL31
  596.       XIN2=-E+F*DL32
  597.       IF(XIN1.GT.-1.E-10.AND.XIN1.LE.X.AND.CO1.GT.0.9) THEN
  598.       X=XIN1
  599.       DL3=DL31
  600.       GOTO 419
  601.       ENDIF
  602.       IF(XIN2.GT.-1.E-10.AND.XIN2.LE.X.AND.CO2.GT.0.9) THEN
  603.       X=XIN2
  604.       DL3=DL32
  605.       GOTO 419
  606.       ENDIF
  607.       IF(IIMPI.EQ.9) WRITE(IOIMP,60606)
  608. 60606 FORMAT(1X,'ERREUR DP COMPRESSION 2 ',/)
  609.       DL3=DL31
  610.       X=XIN1
  611.   419 DO 420 ITYP=1,3
  612.       SGG(ITYP)=A(ITYP)+DL3*B(ITYP)
  613.   420 CONTINUE
  614.       IDAM(1)=0
  615.       IDAM(2)=-1
  616.       IDAM(3)=1
  617.       GOTO 500
  618.       ENDIF
  619.       DO 430 ITYP=1,3
  620.       DL3=SFG(2)/SSI(2)
  621.       RD=RDP-DL3*HDP
  622.       IF(RD.LT.SIREF) GOTO 19
  623.       A(ITYP)=SFG(ITYP)-DL3*SSI(ITYP)
  624.       B(ITYP)=DSFG(ITYP)
  625.   430 CONTINUE
  626.       CALL XDP(A,B,RD,ADP,X,ITEST)
  627.       DO 440 ITYP=1,3
  628.       SGG(ITYP)=A(ITYP)+X*B(ITYP)
  629.   440 CONTINUE
  630.       IDAM(1)=0
  631.       IDAM(2)=-1
  632.       IDAM(3)=1
  633.   500 DO 510 ITYP=1,3
  634.       EPDP(ITYP)=DL3*EPC(ITYP)+EPDP(ITYP)
  635.       SFG(ITYP)=SGG(ITYP)
  636.   510 CONTINUE
  637. C
  638. C-------------------------------------------------------
  639. C     CAS OU LA LIMITE EN TRACTION N EST PAS DEPASSEE
  640. C-------------------------------------------------------
  641. C
  642.       RDP=RDP-DL3*HDP
  643.       IF(RDP.LT.SIREF) GOTO 19
  644.       XLAM3=XLAM3+DL3
  645.       XT=X+XT
  646.       C=1.D0-1.D-10
  647.       IF(XT.GT.C) THEN
  648.       DO 520 ITYP=1,3
  649.       IDAM(ITYP)=0
  650.       DSIG(ITYP)=0.D0
  651.   520 CONTINUE
  652.       CALL CHREP(SFG,SIG,-ANG)
  653.       CALL CHREP(EPDP,EPPLDP,-ANG)
  654.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  655.       RETURN
  656.       ENDIF
  657.   525 IF(ISOR.EQ.1) THEN
  658.       DO 530 ITYP=1,3
  659.       DSFG(ITYP)=(1D0-XT)*DSFG(ITYP)
  660.   530 CONTINUE
  661.       CALL CHREP(SFG,SIG,-ANG)
  662.       CALL CHREP(DSFG,DSIG,-ANG)
  663.       CALL CHREP(EPDP,EPPLDP,-ANG)
  664.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  665.       RETURN
  666.       ENDIF
  667.       X=2.D0*X
  668.       IF((XT+X).GT.1.D0) X=1.D0-XT
  669.       CALL SIJ(SFG,SI,SIETOI)
  670.       CALL EPSDP(SI,SIETOI,ADP,EPC)
  671.       CALL CPHOMO(EPC,SSI,YOUN,ANU,BETA)
  672.       IF(DL3.LT.0.D0) THEN
  673.       KERRE=461
  674.       RETURN
  675.       ENDIF
  676.       GOTO 31
  677.       END
  678.  
  679.  
  680.  
  681.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales