Télécharger la plaquette Cast3M


fr en

Télécharger c2dp.eso

Retour à la liste

Numérotation des lignes : 

c2dp

  1. C C2DP      SOURCE    CB215821  26/10/26    21:15:18     12682          
  2.       SUBROUTINE C2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP,
  3.      1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPPLDP,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),SSI(3),SI(3),EPC1(3),
  11.      1 EPDP(3),EC(3),EPPLDP(3),SG(3),AT(4),BT(2),TENS(3)
  12.       ITER=0
  13.       Y=YOUN/(1.D0-ANU*ANU)
  14.       SIREF=1.E-6*YOUN
  15.       DO 10 ITYP=1,3
  16.       EPDP(ITYP)=0.D0
  17.       EPPLDP(ITYP)=0.D0
  18.    10 CONTINUE
  19.       DL3=0.D0
  20.       XT=0.D0
  21.       IF(IIMPI.EQ.9) WRITE(IOIMP,9999)
  22. 9999  FORMAT(1X,'C2DP COUPLAGE COMP 2 DRUCKER',/)
  23.  9998 FORMAT(1X,'C2DP ',I4,'ITERATIONS INTERNES',/)
  24. C
  25. C------------------------------------------------
  26. C     COUPLAGE COMPRESSION 2 DRUCKER
  27. C------------------------------------------------
  28. C----------------------------------------------
  29. C     DEFINITION D UNE CONTRAINTE DE REFERENCE
  30. C     SI RMAX DU DRUCKER INFERIEURE A CETTE VALEUR
  31. C     ALORS SIGMA=0
  32. C----------------------------------------------
  33. C
  34.       RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP)))
  35.       IF(SIREF.GT.RMAX) THEN
  36.       DO 20 ITYP=1,3
  37.       SIG(ITYP)=SIG(ITYP)+DSIG(ITYP)
  38.   20  CONTINUE
  39.       RDP=0.D0
  40.       HDP=0.D0
  41.       ADP=0.D0
  42.       CALL CPHOIN(SIG,EPPLDP,YOUN,ANU)
  43.       CALL NORME(SIG,DL3)
  44.       DL3=DL3/YOUN*10.D0
  45.       XLAM3=XLAM3+DL3
  46.       DO 30 ITYP=1,3
  47.       IDAM(ITYP)=0
  48.       DSIG(ITYP)=0.D0
  49.       SIG(ITYP)=0.D0
  50.   30  CONTINUE
  51.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  52.       RETURN
  53.       ENDIF
  54. C-----------------------------------------------
  55. C     ON SEPLACE DANS LE REPERE DE FISSURATION
  56. C-----------------------------------------------
  57. C
  58.       CALL CHREP(SIG,SFG,ANG)
  59.       CALL CHREP(DSIG,DSFG,ANG)
  60. C
  61. C-----------------------------------------------------
  62. C     ESTIMATION DU PAS D'INCREMENT DE CONTRAINTES
  63. C-----------------------------------------------------
  64. C
  65.       CALL SIJ(SFG,SI,SIETOI)
  66.       CALL EPSDP(SI,SIETOI,ADP,EPC)
  67.       CALL CPHOMO(EPC,SSI,YOUN,ANU,ALPHA)
  68.       CALL SCAL2(EPC,SSI,VAL)
  69.       VAL=VAL-HDP
  70.       IF(VAL.LT.0.D0) THEN
  71.       KERRE=459
  72.       RETURN
  73.       ENDIF
  74.       CALL SCAL(SSI,DSFG,VAL)
  75.       CALL NORME(DSFG,VA1)
  76.       CALL NORME(SSI,VA2)
  77.       IF(VA1.EQ.0.D0) THEN
  78.       IDAM(1)=0
  79.       IDAM(2)=0
  80.       IDAM(3)=0
  81.       RETURN
  82.       ENDIF
  83.       RMIN=MIN((RDP/1.73),(RDP/(1.D0+2.D0*ADP)))
  84.       X=VAL/VA1/VA2
  85.       IF(X.GE.1.D0) THEN
  86.       X=1.D0
  87.       GOTO 41
  88.       ENDIF
  89.       X=1.D0/SQRT(1.0001D0-X*X)*RMIN/VA1/8.D0
  90.       IF(X.GE.1.D0) X=1.D0
  91. C
  92. C----------------------------------------------------------
  93. C     ON ECOULE ET ON REGARDE LA VARIATION DE NORMALE
  94. C----------------------------------------------------------
  95. C
  96. C
  97. C---------------------------------------
  98. C     RESOLUTION DU SYSTEME EN DL3
  99. C---------------------------------------
  100.    41 X=X/2.D0
  101.       EC(1)=0.D0
  102.       EC(2)=1.D0
  103.       EC(3)=0.D0
  104.       CALL CPHOOB(EC,SG,YOUN,ANU)
  105.   100 X=X*2.D0
  106.       CALL SIJ(SFG,SI,SIETOI)
  107.       CALL EPSDP(SI,SIETOI,ADP,EPC)
  108.       CALL CPHOMO(EPC,SSI,YOUN,ANU,ALPHA)
  109.       CALL SCAL2(EPC,SSI,VAL)
  110.       VAL=VAL-HDP
  111.       IF(VAL.LT.0.D0) THEN
  112.       KERRE=459
  113.       RETURN
  114.       ENDIF
  115.       IF((XT+X).GT.1.D0) X=1.D0-XT
  116.   110 RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP)))
  117. C
  118. C --------------------------------------------------
  119. C     CAS OU LE RAYON MAXIMAL DU DRUCKER-PRAGER
  120. C     INFERIEUR A LA CONTRAINTE DE REFERENCE
  121. C --------------------------------------------------
  122. C
  123.       IF(SIREF.LT.RMAX) GOTO 131
  124.       DO 120 ITYP=1,3
  125.       SFG(ITYP)=SFG(ITYP)+(1.D0-XT)*DSFG(ITYP)
  126.   120 CONTINUE
  127.       RDP=0.D0
  128.       ADP=0.D0
  129.       HDP=0.D0
  130.       CALL NORME(SFG,DL3)
  131.       DL3=DL3/YOUN*10.D0
  132.       XLAM3=XLAM3+DL3
  133.       CALL CPHOIN(SFG,EPPLDP,YOUN,ANU)
  134.       DO 130 ITYP=1,3
  135.       IDAM(ITYP)=0
  136.       EPDP(ITYP)=EPDP(ITYP)+EPPLDP(ITYP)
  137.       DSIG(ITYP)=0.D0
  138.       SIG(ITYP)=0.D0
  139.   130 CONTINUE
  140.       CALL CHREP(EPDP,EPPLDP,-ANG)
  141.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  142.       RETURN
  143.   131 ITER=ITER+1
  144.       IF(ITER.GT.200) THEN
  145.       KERRE=460
  146.       RETURN
  147.       ENDIF
  148. C
  149. C---------------------------------
  150. C     ON REALISE LE COUPLAGE
  151. C---------------------------------
  152. C
  153.       E=-(SFG(2)+X*DSFG(2))/SG(2)
  154.       F=SSI(2)/SG(2)
  155.       DO 140 ITYP=1,3
  156.       DSGG(ITYP)=X*DSFG(ITYP)
  157.       A(ITYP)=SFG(ITYP)+DSGG(ITYP)+E*SG(ITYP)
  158.       B(ITYP)=-SSI(ITYP)+F*SG(ITYP)
  159.   140 CONTINUE
  160.       CALL DLAMDP(A,B,DL3,RDP,ADP,HDP,ITEST)
  161.       IF(ITEST.EQ.1) THEN
  162.       X=X/2.D0
  163.       GOTO 131
  164.       ENDIF
  165.       DL2=-E-F*DL3
  166.       DO 145 ITYP=1,3
  167.       SGG(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-DL2*SG(ITYP)-DL3*SSI(ITYP)
  168.   145 CONTINUE
  169. C
  170. C----------------------------------------------
  171. C     SI UN DES DLAMDA < 0  FAUX COUPLAGE
  172. C----------------------------------------------
  173. C
  174.       IF(DL2.GT.0.D0) IDAM(2)=0
  175.       IF(DL3.LT.0.D0) IDAM(3)=0
  176.       IF(IDAM(2).EQ.0.OR.IDAM(3).EQ.0) THEN
  177.       DL2=0.D0
  178.       DL3=0.D0
  179.       X=0.D0
  180.       GOTO 3000
  181.       ENDIF
  182. C
  183. C-----------------------------------------------------
  184. C     ON VERIFIE QUE LA NORMALE SUIVANT LE DRUCKER
  185. C     PRAGER TOURNE PEU
  186. C-----------------------------------------------------
  187. C
  188.       CALL SIJ(SGG,SI,SIETOI)
  189.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  190.       CALL SCAL(EPC,EPC1,VAL)
  191.       CALL NORME(EPC,VA1)
  192.       CALL NORME(EPC1,VA2)
  193.       CO=VAL/VA1/VA2
  194.       IF(CO.LT.0.99) THEN
  195.       X=X/2.D0
  196.       GOTO 131
  197.       ENDIF
  198.       IF((DL2+XLAM2).GE.0.D0) GOTO 200
  199. C
  200. C------------------------------------------------
  201. C     CAS OU LA FISSURE EST COMPLETEMENT FERMEE
  202. C------------------------------------------------
  203. C
  204.       IDAM(2)=0
  205.       DL2=-XLAM2
  206.       IF(DSFG(2).EQ.0.D0) GOTO 160
  207.       E=(DL2*SG(2)-SFG(2))/DSFG(2)
  208.       F=SSI(2)/DSFG(2)
  209.       DO 150 ITYP=1,3
  210.       A(ITYP)=SFG(ITYP)-DL2*SG(ITYP)+E*DSFG(ITYP)
  211.       B(ITYP)=F*DSFG(ITYP)-SSI(ITYP)
  212.   150 CONTINUE
  213.       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  214.       DO 151 ITYP=1,3
  215.       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  216.       DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  217.   151 CONTINUE
  218.       CALL SIJ(SGG,SI,SIETOI)
  219.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  220.       CALL SCAL(EPC,EPC1,VAL)
  221.       CALL NORME(EPC,VA1)
  222.       CALL NORME(EPC1,VA2)
  223.       CO1=VAL/VA1/VA2
  224.       CALL SIJ(DSGG,SI,SIETOI)
  225.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  226.       CALL SCAL(EPC,EPC1,VAL)
  227.       CALL NORME(EPC,VA1)
  228.       CALL NORME(EPC1,VA2)
  229.       CO2=VAL/VA1/VA2
  230.       XIN1=E+F*DL31
  231.       XIN2=E+F*DL32
  232.       IF(XIN1.GT.-1.D-10.AND.XIN1.LE.X.AND.CO1.GT.0.9) THEN
  233.       DL3=DL31
  234.       X=XIN1
  235.       GOTO 200
  236.       ENDIF
  237.       IF(XIN2.GT.-1.D-10.AND.XIN2.LE.X.AND.CO2.GT.0.9) THEN
  238.       DL3=DL32
  239.       X=XIN2
  240.       GOTO 200
  241.       ENDIF
  242.       IF(IIMPI.EQ.9) WRITE(IOIMP,10101)
  243. 10101 FORMAT(1X,'ERREUR DANS C2DP FERM ',/)
  244.       DL3=DL31
  245.       X=XIN1
  246.       GOTO 200
  247.   160 DL3=(SFG(2)-DL2*SG(2))/SSI(2)
  248.       RD=RDP-HDP*DL3
  249.       IF(RD.LT.0.D0) THEN
  250.       RDP=0.D0
  251.       GOTO 110
  252.       ENDIF
  253.       DO 170 ITYP=1,3
  254.       A(ITYP)=SFG(ITYP)-DL2*SG(ITYP)-DL3*SSI(ITYP)
  255.       B(ITYP)=DSFG(ITYP)
  256.   170 CONTINUE
  257.       CALL XDP(A,B,RD,ADP,X,ITEST)
  258.   200 CONTINUE
  259.       DO 205 ITYP=1,3
  260.       DSGG(ITYP)=X*DSFG(ITYP)
  261.       SGG(ITYP)=SFG(ITYP)+DSGG(ITYP)-DL2*SG(ITYP)-DL3*SSI(ITYP)
  262.   205 CONTINUE
  263. C
  264. C-----------------------------------------------
  265. C     ON REGARDE SI ON ENDOMMAGE PAS LES AUTRES
  266. C     CRITERES
  267. C-----------------------------------------------
  268. C-------------------------------------
  269. C     ON ENDOMMAGE LA TRACTION 1
  270. C-------------------------------------
  271. C
  272.       CALL CTRAF(SGG(1),RT1,VCTR)
  273.       IF(VCTR.LE.0.D0) GOTO 1000
  274.       IDAM(1)=1
  275.       IDAM(2)=-1
  276.       IDAM(3)=1
  277.       AT(1)=-DSFG(1)
  278.       AT(4)=Y
  279.       AT(2)=Y*ANU
  280.       AT(3)=-DSFG(2)
  281.       BT(1)=SFG(1)-RT1
  282.       BT(2)=SFG(2)
  283.       CALL SYLIN2(AT,BT,X1,DL21)
  284.       BT(1)=-SSI(1)
  285.       BT(2)=-SSI(2)
  286.       CALL SYLIN2(AT,BT,X2,DL22)
  287.       DO 230 ITYP=1,3
  288.       A(ITYP)=SFG(ITYP)-DL21*SG(ITYP)+X1*DSFG(ITYP)
  289.       B(ITYP)=-DL22*SG(ITYP)+X2*DSFG(ITYP)-SSI(ITYP)
  290.   230 CONTINUE
  291.       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  292.       DO 231 ITYP=1,3
  293.       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  294.       DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  295.   231 CONTINUE
  296.       CALL SIJ(SGG,SI,SIETOI)
  297.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  298.       CALL SCAL(EPC,EPC1,VAL)
  299.       CALL NORME(EPC,VA1)
  300.       CALL NORME(EPC1,VA2)
  301.       CO1=VAL/VA1/VA2
  302.       CALL SIJ(DSGG,SI,SIETOI)
  303.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  304.       CALL SCAL(EPC,EPC1,VAL)
  305.       CALL NORME(EPC,VA1)
  306.       CALL NORME(EPC1,VA2)
  307.       CO2=VAL/VA1/VA2
  308.       DLIN1=DL21+DL31*DL22
  309.       DLIN2=DL21+DL32*DL22
  310.       XIN1=X1+DL31*X2
  311.       XIN2=X1+DL32*X2
  312.       IF(XIN1.GT.-1.D-10.AND.DLIN1.LT.1.E-10.AND.XIN1.LE.X
  313.      1 .AND.CO1.GT.0.9) THEN
  314.       DL3=DL31
  315.       X=XIN1
  316.       DL2=DLIN1
  317.       GOTO 3000
  318.       ENDIF
  319.       IF(XIN2.GT.-1.D-10.AND.DLIN2.LT.1.E-10.AND.XIN2.LE.X
  320.      1 .AND.CO2.GT.0.9) THEN
  321.       DL3=DL32
  322.       X=XIN2
  323.       DL2=DLIN2
  324.       GOTO 3000
  325.       ENDIF
  326.       IF(IIMPI.EQ.9) WRITE(IOIMP,20202)
  327. 20202 FORMAT(1X,'ERREUR DANS C2DP TRAC ',/)
  328.       DL3=DL31
  329.       DL2=DLIN1
  330.       X=XIN1
  331.       GOTO 3000
  332. C
  333. C-------------------------------------
  334. C     ON ENDOMMAGE LA COMPRESSION 1
  335. C-------------------------------------
  336. C
  337.  1000 CALL CCOAF(SGG(1),XLAM1,VCCO1)
  338.       IF(VCCO1.LE.0.D0) GOTO 2000
  339.       IDAM(1)=-1
  340.       IDAM(3)=1
  341.       IDAM(2)=-1
  342.       AT(1)=-DSFG(1)
  343.       AT(4)=Y
  344.       AT(2)=Y*ANU
  345.       AT(3)=-DSFG(2)
  346.       BT(1)=SFG(1)
  347.       BT(2)=SFG(2)
  348.       CALL SYLIN2(AT,BT,X1,DL21)
  349.       BT(1)=-SSI(1)
  350.       BT(2)=-SSI(2)
  351.       CALL SYLIN2(AT,BT,X2,DL22)
  352.       DO 1010 ITYP=1,3
  353.       A(ITYP)=SFG(ITYP)-DL21*SG(ITYP)+X1*DSFG(ITYP)
  354.       B(ITYP)=-DL22*SG(ITYP)+X2*DSFG(ITYP)-SSI(ITYP)
  355.  1010 CONTINUE
  356.       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  357.       DO 1011 ITYP=1,3
  358.       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  359.       DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  360.  1011 CONTINUE
  361.       CALL SIJ(SGG,SI,SIETOI)
  362.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  363.       CALL SCAL(EPC,EPC1,VAL)
  364.       CALL NORME(EPC,VA1)
  365.       CALL NORME(EPC1,VA2)
  366.       CO1=VAL/VA1/VA2
  367.       CALL SIJ(DSGG,SI,SIETOI)
  368.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  369.       CALL SCAL(EPC,EPC1,VAL)
  370.       CALL NORME(EPC,VA1)
  371.       CALL NORME(EPC1,VA2)
  372.       CO2=VAL/VA1/VA2
  373. *     DLIN1=DL11+DL31*DL12   CORRECTION PV ???
  374. *     DLIN2=DL11+DL32*DL12   SUITE ERREUR APPOLO
  375.       DLIN1=DL21+DL31*DL22
  376.       DLIN2=DL21+DL32*DL22
  377.       XIN1=X1+DL31*X2
  378.       XIN2=X1+DL32*X2
  379.       IF(XIN1.GT.-1.D-10.AND.DLIN1.LT.1.E-10.AND.XIN1.LE.X
  380.      1 .AND.CO1.GT.0.9) THEN
  381.       DL3=DL31
  382.       X=XIN1
  383.       DL2=DLIN1
  384.       GOTO 3000
  385.       ENDIF
  386.       IF(XIN2.GT.-1.D-10.AND.DLIN2.LT.1.E-10.AND.XIN2.LE.X
  387.      1 .AND.CO2.GT.0.9) THEN
  388.       DL3=DL32
  389.       X=XIN2
  390.       DL2=DLIN2
  391.       GOTO 3000
  392.       ENDIF
  393.       IF(IIMPI.EQ.9) WRITE(IOIMP,30303)
  394. 30303 FORMAT(1X,'ERREUR DANS C2DP COMP ',/)
  395.       DL3=DL31
  396.       DL2=DLIN1
  397.       X=XIN1
  398.       GOTO 3000
  399.  2000 CONTINUE
  400. C
  401. C------------------------------------------------
  402. C     CAS OU AUCUN AUTRE CRITERE EST ENDOMMAGE
  403. C------------------------------------------------
  404. C-----------------------------------
  405. C     REMISE A JOUR DES VARIABLES
  406. C     PUIS NOUVEAU PAS SI TOUT
  407. C     L INCREMENT N EST PAS ECOULE
  408. C-----------------------------------
  409. C
  410.       XT=XT+X
  411.       RDP=RDP-DL3*HDP
  412.       RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP)))
  413.       IF(SIREF.GT.RMAX) THEN
  414.       RDP=0.D0
  415.       GOTO 110
  416.       ENDIF
  417.       DO 2010 ITYP=1,3
  418.       SFG(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-DL2*SG(ITYP)-DL3*SSI(ITYP)
  419.       EPDP(ITYP)=DL3*EPC(ITYP)+EPDP(ITYP)
  420.  2010 CONTINUE
  421.       XLAM2=XLAM2+DL2
  422.       XLAM3=XLAM3+DL3
  423.       IF(XLAM2.LT.1.E-10) XLAM2=0.D0
  424.       IF(XLAM2.LT.1.E-10) IDAM(2)=0
  425.       C=1.D0-1.D-10
  426.       IF(XT.LT.C) GOTO 2020
  427.       DO 2015 ITYP=1,3
  428.       IDAM(ITYP)=0
  429.       DSIG(ITYP)=0.D0
  430.  2015 CONTINUE
  431.       CALL CHREP(SFG,SIG,-ANG)
  432.       CALL CHREP(EPDP,EPPLDP,-ANG)
  433.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  434.       RETURN
  435.  2020 IF(IDAM(2).EQ.-1) GOTO 100
  436.       XLAM2=0.D0
  437.       GAMDP=10.D0
  438.       GAMTR1=10.D0
  439.       GAMTR2=10.D0
  440.       GAMCO1=10.D0
  441.       DO 2030 ITYP=1,3
  442.       DSFG(ITYP)=DSFG(ITYP)*(1.D0-XT)
  443.       TENS(ITYP)=SFG(ITYP)+DSFG(ITYP)
  444.  2030 CONTINUE
  445.       CALL CTRAF(TENS(1),RT1,VCTR1)
  446.       CALL CTRAF(TENS(2),RT2,VCTR2)
  447.       CALL CCOAF(TENS(1),XLAM1,VCCO1)
  448.       CALL CDP(TENS,ADP,RDP,VCDP)
  449.       IF(VCTR1.GT.0.D0) CALL GAMTAF(SFG(1),DSFG(1),RT1,GAMTR1)
  450.       IF(VCTR2.GT.0.D0) CALL GAMTAF(SFG(2),DSFG(2),RT2,GAMTR2)
  451.       IF(VCCO1.GT.0.D0) CALL GAMCAF(SFG(1),DSFG(1),GAMCO1)
  452.       IF(VCDP.GT.0.D0) CALL GDP(SFG,DSFG,RDP,ADP,GAMDP)
  453.       IDAM(1)=0
  454.       IDAM(2)=0
  455.       IDAM(3)=0
  456.       GAM=MIN(GAMTR1,GAMTR2,GAMCO1,GAMDP)
  457.       IF(GAM.GE.1.D0) THEN
  458.       DO 2040 ITYP=1,3
  459.       SFG(ITYP)=SFG(ITYP)+DSFG(ITYP)
  460.       DSIG(ITYP)=0.D0
  461.  2040 CONTINUE
  462.       CALL CHREP(SFG,SIG,-ANG)
  463.       RETURN
  464.       ENDIF
  465.       IF(ABS(GAM-GAMTR1).LE.1.E-10) IDAM(1)=1
  466.       IF(ABS(GAM-GAMTR2).LE.1.E-10) IDAM(2)=1
  467.       IF(ABS(GAM-GAMCO1).LE.1.E-10) IDAM(1)=-1
  468.       IF(ABS(GAM-GAMDP).LE.1.E-10) IDAM(3)=1
  469.       DO 2050 ITYP=1,3
  470.       SFG(ITYP)=SFG(ITYP)-GAM*DSFG(ITYP)
  471.       DSFG(ITYP)=(1.D0-GAM)*DSFG(ITYP)
  472.  2050 CONTINUE
  473.       CALL CHREP(SFG,SIG,-ANG)
  474.       CALL CHREP(DSFG,DSIG,-ANG)
  475.       CALL CHREP(EPDP,EPPLDP,-ANG)
  476.       RETURN
  477.  3000 RDP=RDP-DL3*HDP
  478.       RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP)))
  479.       IF(SIREF.GT.RMAX) THEN
  480.       RDP=0.D0
  481.       GOTO 110
  482.       ENDIF
  483.       XT=XT+X
  484.       DO 3010 ITYP=1,3
  485.       SFG(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-DL2*SG(ITYP)-DL3*SSI(ITYP)
  486.       DSFG(ITYP)=(1.D0-XT)*DSFG(ITYP)
  487.       EPDP(ITYP)=DL3*EPC(ITYP)+EPDP(ITYP)
  488.  3010 CONTINUE
  489.       CALL CHREP(SFG,SIG,-ANG)
  490.       CALL CHREP(DSFG,DSIG,-ANG)
  491.       CALL CHREP(EPDP,EPPLDP,-ANG)
  492.       XLAM2=XLAM2+DL2
  493.       XLAM3=XLAM3+DL3
  494.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  495.       RETURN
  496.       END
  497.  
  498.  
  499.  

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