Télécharger druck2.eso

Retour à la liste

Numérotation des lignes :

  1. C DRUCK2 SOURCE LJASON 07/11/12 21:15:13 5965
  2. C DRUCK2
  3. SUBROUTINE DRUCK2(SIG0,NSTRS,DEPST,VAR0,XMAT,IVAL,NCOMAT,
  4. & XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR,KERRE,
  5. & IB,IGAU,IFOURB,XLCARA,MELE)
  6. C----------------------------------------------------------------------
  7. C
  8. C ENTREES:
  9. C -------
  10. C NSTRS = NBR. DE COMPOSANTES DES CONTR. OU DES DEFORM.
  11. C SIG0(NSTRS) = CONTR. AU DEBUT DU PAS D'INTEGRATION
  12. C DEPST(NSTRS) = INCREMENT DES DEFORM. TOTALES
  13. C NVARI = NBR. DE VARIABLES INTERNES
  14. C VAR0(NVARI) = VARIABLES INTERNES AU DEBUT DU PAS D'INTEGRATION
  15. C
  16. C NCOMAT = NBR. DE CARACTERISTIQUES MECANIQUES DU MATERIAU
  17. C IVAL(NCOMAT) = INDICE DES COMPOSANTES DE MATERIAU
  18. C XMAT(NCOMAT) = CARACTERISTIQUES MECANIQUES DU MATERIAU
  19. C MFR = INDICE DE LA FORMULATION MECANIQUE
  20. C ICARA = NBR. DE CARACT. GEOMETRIQUES DES ELEMENTS FINIS
  21. C XCAR(ICARA) = CARACT. GEOMETRIQUES DES ELEMENTS FINIS
  22. C
  23. C SORTIES:
  24. C -------
  25. C SIGF(NSTRS)= CONTR. A LA FIN DU PAS D'INTEGRATION
  26. C VARF(NVARI)= VARIABLES INTERNES A LA FIN DU PAS D'INTEGRATION
  27. C DEFP(NSTRS)= INCREMENT DES DEFORM. PLASTIQUES A LA FIN DU PAS
  28. C D'INTEGRATION
  29. C KERRE = INDICE QUI REGIT LES ERREURS
  30. C = 99 SI LA FORMULATION MECANIQUE N'EST PAS DISPONIBLE
  31. C POUR LE MODELE CONSIDERE OU S'IL Y A INCOMPATIBILITE
  32. C ENTRE MFR ET IFOUR
  33. C
  34. C
  35. IMPLICIT REAL*8(A-H,O-Z)
  36. -INC CCOPTIO
  37. -INC CCREEL
  38. C
  39. PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0)
  40. PARAMETER (QUATRE=4.D0)
  41. C
  42. DIMENSION SIG0(*),DEPST(*),VAR0(*),XMAT(*),XCAR(*),SIGF(*),
  43. & IVAL(*),VARF(*),DEFP(*)
  44. DIMENSION DDAUX(6,6),S(6),SINI(3),DS(6),SD(3),SDINI(3)
  45. DIMENSION SIG33(3,3),SIGPP(3),R(3,3),RT(3,3),XMS(3,3),TRAV(3,3)
  46.  
  47. C----------------------------------------------------------------------
  48. C CARACTERISTIQUES
  49. C----------------------------------------------------------------------
  50.  
  51. KERRE=0
  52.  
  53. YOUN=XMAT(1)
  54. XNU=XMAT(2)
  55. FT=XMAT(5)
  56. FC=XMAT(6)
  57. FB=XMAT(7)
  58. FY=XMAT(8)
  59. EPSU=XMAT(9)
  60. EPSU2=XMAT(10)
  61. XLC=XMAT(11)
  62. GF=XMAT(12)
  63.  
  64. G=UNDEMI*YOUN/(UN+XNU)
  65.  
  66. **-- Parametres pour le critere en compression
  67.  
  68. XK=YOUN/TROIS/(UN-DEUX*XNU)
  69. ALPHA=SQRT(UN/TROIS)*(FC-FB)/(FC-DEUX*FB)
  70. XK0=SQRT(UN/TROIS)*FB/(DEUX*FB-FC)
  71. EPSPU=EPSU+FC/YOUN
  72. XU=SQRT(TROIS)*EPSPU/(SQRT(TROIS)*ALPHA-UN)
  73. OMEGA=FY/FC
  74. XU2=SQRT(TROIS)*EPSU2/(SQRT(TROIS)*ALPHA-UN)
  75. OM1=OMEGA-UN
  76. XUXU=XU*XU
  77.  
  78. AUX3=G+9.D0*XK*ALPHA*ALPHA
  79.  
  80. **-- Longueur caracteristique pour le critere en traction
  81.  
  82. **-- Elements lineaires
  83. * IF (MELE.EQ.8) THEN
  84. * XLC=SQRT(DEUX*XLCARA)
  85. * ELSE IF (MELE.EQ.10) THEN
  86. **-- Elements quadratiques
  87. * XLC=SQRT(XLCARA)
  88. * ELSE
  89. * PRINT*,'pas le bon type d element'
  90. * STOP
  91. * ENDIF
  92.  
  93. * PRINT*,'XLC1', XLC
  94. * XLC = XLCARA
  95. * PRINT*,'XLC', XLC
  96. * PRINT*,'XLCARA', XLCARA
  97.  
  98. IF(IVAL(9).EQ.0) THEN
  99. XKU=XZER
  100. ELSE
  101. ** XKU=DEUX*GF/(XLC*FT)
  102. XKU=GF/(XLC*FT*(UN-EXP(-UN)))
  103. * PRINT*,'GF', GF
  104. * PRINT*,'FT', FT
  105. * PRINT*,'XLC', XLC
  106. * PRINT*,'XKU', XKU
  107. ENDIF
  108.  
  109. * print*,'xku : ',xku
  110.  
  111.  
  112. C----------------------------------------------------------------------
  113. C CALCUL DU PREDICTEUR ELASTIQUE
  114. C----------------------------------------------------------------------
  115.  
  116. **-- Matrice de Hooke DDAUX
  117.  
  118. DO I=1,NSTRS
  119. DO J=1,NSTRS
  120. DDAUX(I,J)=XZER
  121. ENDDO
  122. ENDDO
  123.  
  124. AUX0=UN/((UN+XNU)*(UN-DEUX*XNU))
  125. D11=YOUN*AUX0*(UN-XNU)
  126. D12=YOUN*AUX0*XNU
  127. AUX2=YOUN*UNDEMI/(UN+XNU)
  128.  
  129. DDAUX(1,1)=D11
  130. DDAUX(1,2)=D12
  131. DDAUX(1,3)=D12
  132.  
  133. DDAUX(2,1)=D12
  134. DDAUX(2,2)=D11
  135. DDAUX(2,3)=D12
  136.  
  137. DDAUX(3,1)=D12
  138. DDAUX(3,2)=D12
  139. DDAUX(3,3)=D11
  140.  
  141. DO I=4,NSTRS
  142. DO J=4,NSTRS
  143. IF(I.EQ.J) DDAUX(I,J)=AUX2
  144. ENDDO
  145. ENDDO
  146.  
  147. DO I=1,NSTRS
  148. SOM=XZER
  149. DO J=1,NSTRS
  150. SOM=SOM+DDAUX(I,J)*DEPST(J)
  151. ENDDO
  152. S(I)=SIG0(I)+SOM
  153. ENDDO
  154.  
  155. C--- calcul des contraintes principales
  156.  
  157. CALL ENDOCB(S,SIG33,1,IFOURB)
  158. CALL JACOB3 (SIG33,3,SIGPP,R)
  159.  
  160. C----------------------------------------------------------------------
  161. C CALCUL DES CRITERES PHI1 ET PHI2
  162. C PHI1 = DRUCKER-PRAGER , PHI2 = RANKINE
  163. C----------------------------------------------------------------------
  164.  
  165. ICOMPT=0
  166. PREC0=1.D-8
  167. PREC1=1.D-7
  168. XP1=VAR0(1)
  169. XP2=VAR0(2)
  170. DL1=XZER
  171. DL2=XZER
  172. DL2B=XZER
  173. DL2C=XZER
  174.  
  175. DIFF=VAR0(1)-XU
  176. IF (VAR0(1).LT.XU) THEN
  177. ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  178. ELSE IF ((VAR0(1).GE.XU).AND.(VAR0(1).LT.XU2)) THEN
  179. ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  180. ELSE IF (VAR0(1).GE.XU2) THEN
  181. ZETA=XZER
  182. ENDIF
  183.  
  184. XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  185.  
  186. **-- calcul du deviateur des contraintes SD
  187.  
  188. SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  189. SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  190. SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  191.  
  192. **-- calcul de la contrainte equivalente SEQ =0.5*S*S
  193.  
  194. SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  195. & +(SIGPP(3)-SIGPP(1))**2
  196. SEQ=SQRT(SEQ/6.D0)
  197.  
  198. PHI1=SEQ+ALPHA*XI1-ZETA
  199.  
  200. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  201. PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  202. PHI2C=SIGPP(3)-FT*TX2(XP2,XKU)
  203.  
  204.  
  205. PHI10=ABS(PHI1)
  206. PHI20=ABS(PHI2)
  207.  
  208. **-- sauvegarde du predicteur
  209.  
  210. F1INI=PHI1
  211. F2INI=PHI2
  212. F2BINI=PHI2B
  213. SEQI=SEQ
  214. DO I=1,3
  215. SINI(I)=SIGPP(I)
  216. SDINI(I)=SD(I)
  217. ENDDO
  218.  
  219. IF((PHI1.LT.XZER).AND.(PHI2.LT.XZER)) THEN
  220. * print*,'cas elastique'
  221. C----------------------------------------------------------------------
  222. C ON N A PAS PLASTIFIE
  223. C----------------------------------------------------------------------
  224. DO I=1,NSTRS
  225. SIGF(I)=S(I)
  226. DEFP(I)=XZER
  227. ENDDO
  228. VARF(1)=VAR0(1)
  229. VARF(2)=VAR0(2)
  230. VARF(3)=VAR0(3)
  231. VARF(4)=VAR0(4)
  232. VARF(5)=VAR0(5)
  233. GO TO 999
  234.  
  235. ELSE IF((PHI1.LT.XZER).AND.(PHI2.GE.XZER)) THEN
  236. * print*,'cas Rankine'
  237. IF(PHI2B.LT.XZER) THEN
  238. C----------------------------------------------------------------------
  239. C RANKINE - UN CRITERE ACTIF (f2)
  240. C----------------------------------------------------------------------
  241. *** debut bloc 20
  242. DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  243. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  244. ICOMPT=ICOMPT+1
  245.  
  246. **-- calcul du multiplicateur
  247.  
  248. DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  249. XP2=XP2+DDL2
  250. DL2=DL2+DDL2
  251. IF(DL2.LT.XZER) THEN
  252. PRINT*,'Multiplicateur negatif (Rankine 1 Critere)'
  253. STOP
  254. ENDIF
  255.  
  256. SIGPP(1)=SIGPP(1)-DDL2*D11
  257. SIGPP(2)=SIGPP(2)-DDL2*D12
  258. SIGPP(3)=SIGPP(3)-DDL2*D12
  259.  
  260. **-- calcul du nouveau critere phi2
  261.  
  262. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  263. PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  264. END DO
  265. **-- test de convergence
  266.  
  267. IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  268. & (ABS(PHI2).LT.PREC1)) THEN
  269. * PRINT*,'boucle rankine', ICOMPT
  270. GO TO 998
  271. ELSE
  272. IF(ICOMPT.GE.20) THEN
  273. PRINT*,'le nombre d iterations internes depasse 20
  274. & (Rankine 1 Critere)'
  275.  
  276. STOP
  277. ENDIF
  278. ENDIF
  279. *** fin bloc 20
  280. ELSE IF (PHI2C.LT.XZER) THEN
  281. C----------------------------------------------------------------------
  282. C RANKINE - 2 CRITERES ACTIFS (f2 et f2b)
  283. C----------------------------------------------------------------------
  284. * debut bloc 21
  285. DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  286. & ((ABS(PHI2).LT.(PREC0*PHI20)).OR.(ABS(PHI2).LT.PREC1)))
  287. ICOMPT=ICOMPT+1
  288.  
  289. **-- calcul des 2 multiplicateurs
  290.  
  291. A11=D11-DF2DX(XP2,XKU,FT)
  292. A12=D12-DF2DX(XP2,XKU,FT)
  293. XX=A11**2-A12**2
  294. DDL2=(A11*PHI2-A12*PHI2B)/XX
  295. DDL2B=(A11*PHI2B-A12*PHI2)/XX
  296.  
  297. XP2=XP2+DDL2+DDL2B
  298. DL2=DL2+DDL2
  299. DL2B=DL2B+DDL2B
  300.  
  301. IF(DL2.LT.XZER) THEN
  302. PRINT*,'Multiplicateur negatif (Rankine 2 Critere)'
  303. STOP
  304. ENDIF
  305.  
  306. SIGPP(1)=SIGPP(1)-DDL2*D11-DDL2B*D12
  307. SIGPP(2)=SIGPP(2)-DDL2*D12-DDL2B*D11
  308. SIGPP(3)=SIGPP(3)-DDL2*D12-DDL2B*D12
  309.  
  310. **-- calcul des nouveaux criteres phi2 et phi2b
  311.  
  312. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  313. PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  314. END DO
  315. **-- test de convergence
  316.  
  317. IF((ABS(PHI2).LT.(PREC0*PHI20))
  318. & .OR.(ABS(PHI2).LT.PREC1)) THEN
  319.  
  320. IF (DL2B.LT.XZER) THEN
  321. ICOMPT=0
  322. DL2=XZER
  323. PHI2=F2INI
  324. XP2=VAR0(2)
  325. DO I=1,3
  326. SIGPP(I)= SINI(I)
  327. END DO
  328. * PRINT*,'** 2e Multiplicateur negatif **'
  329. ** appel bloc 20
  330. DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  331. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  332. ICOMPT=ICOMPT+1
  333.  
  334. **-- calcul du multiplicateur
  335.  
  336. DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  337. XP2=XP2+DDL2
  338. DL2=DL2+DDL2
  339. IF(DL2.LT.XZER) THEN
  340. PRINT*,'Multiplicateur negatif (Rankine 1 Critere)'
  341. STOP
  342. ENDIF
  343.  
  344. SIGPP(1)=SIGPP(1)-DDL2*D11
  345. SIGPP(2)=SIGPP(2)-DDL2*D12
  346. SIGPP(3)=SIGPP(3)-DDL2*D12
  347.  
  348. **-- calcul du nouveau critere phi2
  349.  
  350. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  351. PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  352. END DO
  353. **-- test de convergence
  354.  
  355. IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  356. & (ABS(PHI2).LT.PREC1)) THEN
  357. GO TO 998
  358. ELSE
  359. IF(ICOMPT.GE.20) THEN
  360. PRINT*,'le nombre d iterations internes depasse 20
  361. & (Rankine 1 Critere)'
  362.  
  363. STOP
  364. ENDIF
  365. ENDIF
  366. *** fin bloc 20
  367. ENDIF
  368. GO TO 998
  369. ELSE IF(ICOMPT.GE.20) THEN
  370. PRINT*,'le nombre d iterations internes depasse 20
  371. & (Rankine 2 Critere)'
  372. STOP
  373. ENDIF
  374. Cfin bloc 21
  375.  
  376. *** deux endif en attente
  377.  
  378. ELSE
  379. C----------------------------------------------------------------------
  380. C RANKINE - 3 CRITERES ACTIFS (f2, f2b et f2c)
  381. C----------------------------------------------------------------------
  382. * début bloc 22
  383. DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  384. & ((ABS(PHI2).LT.(PREC0*PHI20)).OR.(ABS(PHI2).LT.PREC1)))
  385.  
  386. ICOMPT=ICOMPT+1
  387.  
  388. **-- calcul des 3 multiplicateurs
  389.  
  390. A11=D11-DF2DX(XP2,XKU,FT)
  391. A12=D12-DF2DX(XP2,XKU,FT)
  392. XX=A11**2-DEUX*A12**2+A11*A12
  393. DDL2=((A11+A12)*PHI2-A12*(PHI2B+PHI2C))/XX
  394. DDL2B=((A11+A12)*PHI2B-A12*(PHI2+PHI2C))/XX
  395. DDL2C=((A11+A12)*PHI2C-A12*(PHI2+PHI2B))/XX
  396.  
  397. XP2=XP2+DDL2+DDL2B+DDL2C
  398. DL2=DL2+DDL2
  399. DL2B=DL2B+DDL2B
  400. DL2C=DL2C+DDL2C
  401.  
  402. IF(DL2.LT.XZER) THEN
  403. PRINT*,'Multiplicateur negatif (Rankine 3 Critere)'
  404. STOP
  405. ENDIF
  406.  
  407. SIGPP(1)=SIGPP(1)-DDL2*D11-DDL2B*D12-DDL2C*D12
  408. SIGPP(2)=SIGPP(2)-DDL2*D12-DDL2B*D11-DDL2C*D12
  409. SIGPP(3)=SIGPP(3)-DDL2*D12-DDL2B*D12-DDL2C*D11
  410.  
  411. **-- calcul des nouveaux criteres phi2 et phi2b
  412.  
  413. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  414. PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  415. PHI2C=SIGPP(3)-FT*TX2(XP2,XKU)
  416.  
  417. END DO
  418. **-- test de convergence
  419.  
  420. IF((ABS(PHI2).LT.(PREC0*PHI20))
  421. & .OR.(ABS(PHI2).LT.PREC1)) THEN
  422.  
  423. IF ((DL2B.LT.XZER).AND.(DL2C.LT.XZER)) THEN
  424. ICOMPT=0
  425. DL2=XZER
  426. PHI2=F2INI
  427. XP2=VAR0(2)
  428. DO I=1,3
  429. SIGPP(I)=SINI(I)
  430. END DO
  431. * debut appel bloc 20
  432. DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  433. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  434. ICOMPT=ICOMPT+1
  435.  
  436. **-- calcul du multiplicateur
  437.  
  438. DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  439. XP2=XP2+DDL2
  440. DL2=DL2+DDL2
  441. IF(DL2.LT.XZER) THEN
  442. PRINT*,'Multiplicateur negatif (Rankine 1 Critere)'
  443. STOP
  444. ENDIF
  445.  
  446. SIGPP(1)=SIGPP(1)-DDL2*D11
  447. SIGPP(2)=SIGPP(2)-DDL2*D12
  448. SIGPP(3)=SIGPP(3)-DDL2*D12
  449.  
  450. **-- calcul du nouveau critere phi2
  451.  
  452. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  453. PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  454. END DO
  455. **-- test de convergence
  456.  
  457. IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  458. & (ABS(PHI2).LT.PREC1)) THEN
  459. GO TO 998
  460. ELSE
  461. IF(ICOMPT.GE.20) THEN
  462. PRINT*,'le nombre d iterations internes depasse 20
  463. & (Rankine 1 Critere)'
  464.  
  465. STOP
  466. ENDIF
  467. ENDIF
  468. *** fin bloc 20
  469.  
  470. ENDIF
  471.  
  472. IF ((DL2B.GE.XZER).AND.(DL2C.LT.XZER)) THEN
  473. ICOMPT=0
  474. DL2=XZER
  475. DL2B=XZER
  476. PHI2=F2INI
  477. PHI2B=F2BINI
  478. XP2=VAR0(2)
  479. DO I=1,3
  480. SIGPP(I)=SINI(I)
  481. END DO
  482. * debut appel bloc 21
  483. DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  484. & ((ABS(PHI2).LT.(PREC0*PHI20)).OR.(ABS(PHI2).LT.PREC1)))
  485. ICOMPT=ICOMPT+1
  486.  
  487. **-- calcul des 2 multiplicateurs
  488.  
  489. A11=D11-DF2DX(XP2,XKU,FT)
  490. A12=D12-DF2DX(XP2,XKU,FT)
  491. XX=A11**2-A12**2
  492. DDL2=(A11*PHI2-A12*PHI2B)/XX
  493. DDL2B=(A11*PHI2B-A12*PHI2)/XX
  494.  
  495. XP2=XP2+DDL2+DDL2B
  496. DL2=DL2+DDL2
  497. DL2B=DL2B+DDL2B
  498.  
  499. IF(DL2.LT.XZER) THEN
  500. PRINT*,'Multiplicateur negatif (Rankine 2 Critere)'
  501. STOP
  502. ENDIF
  503.  
  504. SIGPP(1)=SIGPP(1)-DDL2*D11-DDL2B*D12
  505. SIGPP(2)=SIGPP(2)-DDL2*D12-DDL2B*D11
  506. SIGPP(3)=SIGPP(3)-DDL2*D12-DDL2B*D12
  507.  
  508. **-- calcul des nouveaux criteres phi2 et phi2b
  509.  
  510. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  511. PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  512. END DO
  513. **-- test de convergence
  514.  
  515. IF((ABS(PHI2).LT.(PREC0*PHI20))
  516. & .OR.(ABS(PHI2).LT.PREC1)) THEN
  517.  
  518. IF (DL2B.LT.XZER) THEN
  519. ICOMPT=0
  520. DL2=XZER
  521. PHI2=F2INI
  522. XP2=VAR0(2)
  523. DO I=1,3
  524. SIGPP(I)= SINI(I)
  525. END DO
  526. * PRINT*,'** 2e Multiplicateur negatif **'
  527. ** appel bloc 20
  528. DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  529. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  530. ICOMPT=ICOMPT+1
  531.  
  532. **-- calcul du multiplicateur
  533.  
  534. DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  535. XP2=XP2+DDL2
  536. DL2=DL2+DDL2
  537. IF(DL2.LT.XZER) THEN
  538. PRINT*,'Multiplicateur negatif (Rankine 1 Critere)'
  539. STOP
  540. ENDIF
  541.  
  542. SIGPP(1)=SIGPP(1)-DDL2*D11
  543. SIGPP(2)=SIGPP(2)-DDL2*D12
  544. SIGPP(3)=SIGPP(3)-DDL2*D12
  545.  
  546. **-- calcul du nouveau critere phi2
  547.  
  548. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  549. PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  550. END DO
  551. **-- test de convergence
  552.  
  553. IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  554. & (ABS(PHI2).LT.PREC1)) THEN
  555. GO TO 998
  556. ELSE
  557. IF(ICOMPT.GE.20) THEN
  558. PRINT*,'le nombre d iterations internes depasse 20
  559. & (Rankine 1 Critere)'
  560.  
  561. STOP
  562. ENDIF
  563. ENDIF
  564. *** fin bloc 20
  565. ENDIF
  566. GO TO 998
  567. ELSE IF(ICOMPT.GE.20) THEN
  568. PRINT*,'le nombre d iterations internes depasse 20
  569. & (Rankine 2 Critere)'
  570. STOP
  571. ENDIF
  572. Cfin bloc 21
  573. ENDIF
  574.  
  575. GO TO 998
  576. ELSE IF(ICOMPT.GE.20) THEN
  577. PRINT*,'le nombre d iterations internes depasse 20
  578. & (Rankine 3 Critere)'
  579. STOP
  580. ENDIF
  581. * fin bloc 22
  582.  
  583. ENDIF
  584.  
  585. ELSE IF((PHI1.GE.XZER).AND.(PHI2.LT.XZER)) THEN
  586.  
  587. C----------------------------------------------------------------------
  588. C DRUCKER-PRAGER
  589. C----------------------------------------------------------------------
  590. ** début bloc 9
  591. IF(XP1.GE.XU2) THEN
  592. DO I=1,NSTRS
  593. SIGF(I)=XZER
  594. DEFP(I)=DEPST(I)
  595. END DO
  596. DDL1=PHI1/AUX3
  597. VARF(1)=XP1+DDL1
  598. VARF(2)=XP2
  599. VARF(3)=VARF(1)+VARF(2)
  600. VARF(4)=VARF(1)/XU
  601. VARF(5)=EXP(-VARF(2)/XKU)/FT
  602. GO TO 999
  603. ENDIF
  604. *** debut bloc 10
  605. DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  606. & ((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1)))
  607. ICOMPT=ICOMPT+1
  608.  
  609. DIFF=XP1-XU
  610. IF (XP1.LT.XU) THEN
  611. DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU
  612. ELSE IF((XP1.GE.XU)) THEN
  613. DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2)
  614. ENDIF
  615.  
  616. **-- calcul du multiplicateur
  617.  
  618. DDL1=PHI1/(AUX3-DFDX)
  619. XP1=XP1+DDL1
  620. DL1=DL1+DDL1
  621.  
  622. IF(XP1.GE.XU2) THEN
  623. DO I=1,NSTRS
  624. SIGF(I)=XZER
  625. DEFP(I)=DEPST(I)
  626. ENDDO
  627. VARF(1)=XP1-DDL1+(PHI1/AUX3)
  628. VARF(2)=XP2
  629. VARF(3)=VARF(1)+VARF(2)
  630. VARF(4)=VARF(1)/XU
  631. VARF(5)=EXP(-VARF(2)/XKU)/FT
  632. GO TO 999
  633. ENDIF
  634.  
  635. SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)
  636. SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)
  637. SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)
  638.  
  639. **-- calcul du nouveau critere phi1
  640.  
  641. XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  642.  
  643. SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  644. SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  645. SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  646.  
  647. SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  648. & +(SIGPP(3)-SIGPP(1))**2
  649. SEQ=SQRT(SEQ/6.D0)
  650.  
  651. DIFF=XP1-XU
  652. IF (XP1.LT.XU) THEN
  653. ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  654. ELSE IF ((XP1.GE.XU)) THEN
  655. ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  656. ENDIF
  657. PHI1=SEQ+ALPHA*XI1-ZETA
  658. END DO
  659.  
  660. **-- test de convergence
  661.  
  662. IF((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1))THEN
  663. GO TO 998
  664. ELSE IF(ICOMPT.GE.20) THEN
  665. PRINT*,'le nombre d iterations internes depasse 20
  666. & (Drucker-Prager 1 Critere)'
  667. STOP
  668. ENDIF
  669. *** fin bloc 10
  670. *** fin bloc 9
  671.  
  672. ELSE IF((PHI1.GE.XZER).AND.(PHI2.GE.XZER)) THEN
  673.  
  674. IF(PHI2B.LT.XZER) THEN
  675.  
  676. C-----------------------------------------------------------------------
  677. C RANKINE ET DRUCKER-PRAGER - 2 CRITERES ACTIFS (f1 et f2)
  678. C-----------------------------------------------------------------------
  679. * debut bloc 29
  680. IF(XP1.GE.XU2) THEN
  681. DO I=1,NSTRS
  682. SIGF(I)=XZER
  683. DEFP(I)=DEPST(I)
  684. END DO
  685. DDL1=PHI1/AUX3
  686. VARF(1)=XP1+DDL1
  687. VARF(2)=XP2
  688. VARF(3)=VARF(1)+VARF(2)
  689. VARF(4)=VARF(1)/XU
  690. VARF(5)=EXP(-VARF(2)/XKU)/FT
  691. GO TO 999
  692. ENDIF
  693.  
  694. * debut bloc 30
  695. DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  696. & ((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20)
  697. & .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)))
  698. ICOMPT=ICOMPT+1
  699. DIFF=XP1-XU
  700. IF (XP1.LT.XU) THEN
  701. DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU
  702. ELSE IF((XP1.GE.XU)) THEN
  703. DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2)
  704. ENDIF
  705.  
  706. **-- calcul des 2 multiplicateurs dl1 et dl2
  707.  
  708. A11=AUX3-DFDX
  709. A12=G*SD(1)/SEQ+TROIS*XK*ALPHA
  710. A22=D11-DF2DX(XP2,XKU,FT)
  711. XX=A11*A22-A12**2
  712. DDL1=(A22*PHI1-A12*PHI2)/XX
  713. DDL2=(A11*PHI2-A12*PHI1)/XX
  714.  
  715. XP1=XP1+DDL1
  716. DL1=DL1+DDL1
  717. XP2=XP2+DDL2
  718. DL2=DL2+DDL2
  719.  
  720. IF(XP1.GE.XU2) THEN
  721. DO I=1,NSTRS
  722. SIGF(I)=XZER
  723. DEFP(I)=DEPST(I)
  724. END DO
  725. VARF(1)=XP1-DDL1+(PHI1/AUX3)
  726. VARF(2)=XP2
  727. VARF(3)=VARF(1)+VARF(2)
  728. VARF(4)=VARF(1)/XU
  729. VARF(5)=EXP(-VARF(2)/XKU)/FT
  730. GO TO 999
  731. ENDIF
  732.  
  733. SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)
  734. & -DDL2*D11
  735. SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)
  736. & -DDL2*D12
  737. SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)
  738. & -DDL2*D12
  739.  
  740. **-- calcul des nouveaux criteres phi1 et phi2
  741.  
  742. XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  743.  
  744. SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  745. SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  746. SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  747.  
  748. SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  749. & +(SIGPP(3)-SIGPP(1))**2
  750. SEQ=SQRT(SEQ/6.D0)
  751.  
  752. DIFF=XP1-XU
  753. IF (XP1.LT.XU) THEN
  754. ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  755. ELSE IF ((XP1.GE.XU)) THEN
  756. ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  757. ENDIF
  758. PHI1=SEQ+ALPHA*XI1-ZETA
  759.  
  760. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  761.  
  762. END DO
  763. **-- test de convergence
  764.  
  765. IF((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20)
  766. & .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)) THEN
  767.  
  768. IF(DL1.LT.XZER) THEN
  769. * PRINT*,'1er multiplicateur negatif (D.P.-Rankine)'
  770. ICOMPT=0
  771. DL2=XZER
  772. PHI2=F2INI
  773. XP1=VAR0(1)
  774. XP2=VAR0(2)
  775. DO I=1,3
  776. SIGPP(I)=SINI(I)
  777. END DO
  778. * debut appel bloc 20
  779. *** debut bloc 20
  780. DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  781. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  782. ICOMPT=ICOMPT+1
  783.  
  784. **-- calcul du multiplicateur
  785.  
  786. DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  787. XP2=XP2+DDL2
  788. DL2=DL2+DDL2
  789. IF(DL2.LT.XZER) THEN
  790. PRINT*,'Multiplicateur negatif (Rankine 1 Critere)'
  791. STOP
  792. ENDIF
  793.  
  794. SIGPP(1)=SIGPP(1)-DDL2*D11
  795. SIGPP(2)=SIGPP(2)-DDL2*D12
  796. SIGPP(3)=SIGPP(3)-DDL2*D12
  797.  
  798. **-- calcul du nouveau critere phi2
  799.  
  800. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  801. PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  802. END DO
  803. **-- test de convergence
  804.  
  805. IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  806. & (ABS(PHI2).LT.PREC1)) THEN
  807. GO TO 998
  808. ELSE
  809. IF(ICOMPT.GE.20) THEN
  810. PRINT*,'le nombre d iterations internes depasse 20
  811. & (Rankine 1 Critere)'
  812.  
  813. STOP
  814. ENDIF
  815. ENDIF
  816. *** fin bloc 20
  817. * fin appel bloc 20
  818. ENDIF
  819.  
  820. IF (DL2.LT.XZER) THEN
  821. * PRINT*,'2eme multiplicateur negatif (D.P.-Rankine)'
  822. ICOMPT=0
  823. DL1=XZER
  824. PHI1=F1INI
  825. XP1=VAR0(1)
  826. XP2=VAR0(2)
  827. SEQ=SEQI
  828. DO I=1,3
  829. SIGPP(I)=SINI(I)
  830. SD(I)=SDINI(I)
  831. END DO
  832. * debut appel bloc 9
  833. ** début bloc 9
  834. IF(XP1.GE.XU2) THEN
  835. DO I=1,NSTRS
  836. SIGF(I)=XZER
  837. DEFP(I)=DEPST(I)
  838. END DO
  839. DDL1=PHI1/AUX3
  840. VARF(1)=XP1+DDL1
  841. VARF(2)=XP2
  842. VARF(3)=VARF(1)+VARF(2)
  843. VARF(4)=VARF(1)/XU
  844. VARF(5)=EXP(-VARF(2)/XKU)/FT
  845. GO TO 999
  846. ENDIF
  847. *** debut bloc 10
  848. DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  849. & ((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1)))
  850. ICOMPT=ICOMPT+1
  851.  
  852. DIFF=XP1-XU
  853. IF (XP1.LT.XU) THEN
  854. DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU
  855. ELSE IF((XP1.GE.XU)) THEN
  856. DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2)
  857. ENDIF
  858.  
  859. **-- calcul du multiplicateur
  860.  
  861. DDL1=PHI1/(AUX3-DFDX)
  862. XP1=XP1+DDL1
  863. DL1=DL1+DDL1
  864.  
  865. IF(XP1.GE.XU2) THEN
  866. DO I=1,NSTRS
  867. SIGF(I)=XZER
  868. DEFP(I)=DEPST(I)
  869. END DO
  870. VARF(1)=XP1-DDL1+(PHI1/AUX3)
  871. VARF(2)=XP2
  872. VARF(3)=VARF(1)+VARF(2)
  873. VARF(4)=VARF(1)/XU
  874. VARF(5)=EXP(-VARF(2)/XKU)/FT
  875. GO TO 999
  876. ENDIF
  877.  
  878. SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)
  879. SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)
  880. SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)
  881.  
  882. **-- calcul du nouveau critere phi1
  883.  
  884. XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  885.  
  886. SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  887. SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  888. SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  889.  
  890. SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  891. & +(SIGPP(3)-SIGPP(1))**2
  892. SEQ=SQRT(SEQ/6.D0)
  893.  
  894. DIFF=XP1-XU
  895. IF (XP1.LT.XU) THEN
  896. ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  897. ELSE IF ((XP1.GE.XU)) THEN
  898. ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  899. ENDIF
  900. PHI1=SEQ+ALPHA*XI1-ZETA
  901. END DO
  902.  
  903. **-- test de convergence
  904.  
  905. IF((ABS(PHI1).LT.(PREC0*PHI10)).OR.
  906. & (ABS(PHI1).LT.PREC1))THEN
  907. GO TO 998
  908. ELSE IF(ICOMPT.GE.20) THEN
  909. PRINT*,'le nombre d iterations internes depasse 20
  910. & (Drucker-Prager 1 Critere)'
  911. STOP
  912. ENDIF
  913. *** fin bloc 10
  914. *** fin bloc 9
  915. * fin appel bloc 9
  916. ENDIF
  917. GO TO 998
  918. ELSE IF(ICOMPT.GE.20) THEN
  919. PRINT*,'le nombre d iterations internes depasse 20
  920. & (D.P.-Rankine)'
  921. STOP
  922. ENDIF
  923. * fin bloc 30
  924. * fin bloc 29
  925. ENDIF
  926.  
  927. ELSE
  928.  
  929. C-----------------------------------------------------------------------
  930. C RANKINE ET DRUCKER-PRAGER - 3 CRITERES ACTIFS (f1, f2 et f2b)
  931. C-----------------------------------------------------------------------
  932.  
  933. IF(XP1.GE.XU2) THEN
  934. * print*,'On est au dessus de xu2'
  935. DO I=1,NSTRS
  936. SIGF(I)=XZER
  937. DEFP(I)=DEPST(I)
  938. END DO
  939. DDL1=PHI1/AUX3
  940. VARF(1)=XP1+DDL1
  941. VARF(2)=XP2
  942. VARF(3)=VARF(1)+VARF(2)
  943. VARF(4)=VARF(1)/XU
  944. VARF(5)=EXP(-VARF(2)/XKU)/FT
  945. GO TO 999
  946. ENDIF
  947. ** debut bloc 31
  948. DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  949. & ((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20)
  950. & .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)))
  951.  
  952. ICOMPT=ICOMPT+1
  953. DIFF=XP1-XU
  954. IF (XP1.LT.XU) THEN
  955. DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU
  956. ELSE IF((XP1.GE.XU)) THEN
  957. DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2)
  958. ENDIF
  959.  
  960. **-- calcul des 3 multiplicateurs dl1, dl2 et dl2b
  961.  
  962. A11=AUX3-DFDX
  963. A12=G*SD(1)/SEQ+TROIS*XK*ALPHA
  964. A13=G*SD(2)/SEQ+TROIS*XK*ALPHA
  965. A22=D11-DF2DX(XP2,XKU,FT)
  966. A23=D12-DF2DX(XP2,XKU,FT)
  967. XX=A11*A22**2-A22*A13**2-A22*A12**2-A11*A23**2
  968. & +DEUX*A23*A12*A13
  969. DDL1=((A22**2-A23**2)*PHI1+(A13*A23-A12*A22)*PHI2
  970. & +(A12*A23-A13*A22)*PHI2B)/XX
  971. DDL2=((A23*A13-A12*A22)*PHI1+(A11*A22-A13**2)*PHI2
  972. & +(A13*A12-A11*A23)*PHI2B)/XX
  973. DDL2B=((A23*A12-A22*A13)*PHI1+(A13*A12-A11*A23)*PHI2
  974. & +(A11*A22-A12**2)*PHI2B)/XX
  975. XP1=XP1+DDL1
  976. DL1=DL1+DDL1
  977. XP2=XP2+DDL2+DDL2B
  978. DL2=DL2+DDL2
  979. DL2B=DL2B+DDL2B
  980.  
  981.  
  982. IF(XP1.GE.XU2) THEN
  983. * print*,'On est au dessus de xu2'
  984. DO I=1,NSTRS
  985. SIGF(I)=XZER
  986. DEFP(I)=DEPST(I)
  987. END DO
  988. VARF(1)=XP1-DDL1+(PHI1/AUX3)
  989. VARF(2)=XP2
  990. VARF(3)=VARF(1)+VARF(2)
  991. VARF(4)=VARF(1)/XU
  992. VARF(5)=EXP(-VARF(2)/XKU)/FT
  993. GO TO 999
  994. ENDIF
  995.  
  996. SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)-DDL2*D11
  997. & -DDL2B*D12
  998. SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)-DDL2*D12
  999. & -DDL2B*D11
  1000. SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)-DDL2*D12
  1001. & -DDL2B*D12
  1002.  
  1003. **-- calcul des nouveaux criteres phi1 et phi2
  1004.  
  1005. XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  1006.  
  1007. SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  1008. SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  1009. SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  1010.  
  1011. SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  1012. & +(SIGPP(3)-SIGPP(1))**2
  1013. SEQ=SQRT(SEQ/6.D0)
  1014.  
  1015. DIFF=XP1-XU
  1016. IF (XP1.LT.XU) THEN
  1017. ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  1018. ELSE IF ((XP1.GE.XU)) THEN
  1019. ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  1020. ENDIF
  1021. PHI1=SEQ+ALPHA*XI1-ZETA
  1022.  
  1023. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  1024. PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  1025. END DO
  1026.  
  1027. **-- test de convergence
  1028.  
  1029. IF((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20)
  1030. & .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)) THEN
  1031.  
  1032. IF(DL1.LT.XZER) THEN
  1033. IF(DL2.LT.XZER)THEN
  1034. print*,'mutiplicateurs negatifs'
  1035. STOP
  1036. ELSE
  1037. IF(DL2B.LT.XZER)THEN
  1038. * PRINT*,'multiplicateur negatif (D.P.-Rankine) 20'
  1039. ICOMPT=0
  1040. DL2=XZER
  1041. PHI2=F2INI
  1042. XP1=VAR0(1)
  1043. XP2=VAR0(2)
  1044. DO I=1,3
  1045. SIGPP(I)=SINI(I)
  1046. END DO
  1047. *** debut appel bloc 20
  1048. *** debut bloc 20
  1049. DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  1050. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  1051. ICOMPT=ICOMPT+1
  1052.  
  1053. **-- calcul du multiplicateur
  1054.  
  1055. DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  1056. XP2=XP2+DDL2
  1057. DL2=DL2+DDL2
  1058. IF(DL2.LT.XZER) THEN
  1059. PRINT*,'Multiplicateur negatif (Rankine 1 Critere)'
  1060. STOP
  1061. ENDIF
  1062.  
  1063. SIGPP(1)=SIGPP(1)-DDL2*D11
  1064. SIGPP(2)=SIGPP(2)-DDL2*D12
  1065. SIGPP(3)=SIGPP(3)-DDL2*D12
  1066.  
  1067. **-- calcul du nouveau critere phi2
  1068.  
  1069. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  1070. PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  1071. END DO
  1072. **-- test de convergence
  1073.  
  1074. IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  1075. & (ABS(PHI2).LT.PREC1)) THEN
  1076. GO TO 998
  1077. ELSE
  1078. IF(ICOMPT.GE.20) THEN
  1079. PRINT*,'le nombre d iterations internes depasse 20
  1080. & (Rankine 1 Critere)'
  1081.  
  1082. STOP
  1083. ENDIF
  1084. ENDIF
  1085. *** fin bloc 20
  1086. *** fin appel bloc 20
  1087. ELSE
  1088. * PRINT*,'multiplicateur negatif (D.P.-Rankine) 21 '
  1089. ICOMPT=0
  1090. DL2=XZER
  1091. DL2B=XZER
  1092. PHI2=F2INI
  1093. PHI2B=F2BINI
  1094. XP1=VAR0(1)
  1095. XP2=VAR0(2)
  1096. DO I=1,3
  1097. SIGPP(I)=SINI(I)
  1098. END DO
  1099. * debut appel bloc 21
  1100. DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  1101. & ((ABS(PHI2).LT.(PREC0*PHI20)).OR.(ABS(PHI2).LT.PREC1)))
  1102. ICOMPT=ICOMPT+1
  1103.  
  1104. **-- calcul des 2 multiplicateurs
  1105.  
  1106. A11=D11-DF2DX(XP2,XKU,FT)
  1107. A12=D12-DF2DX(XP2,XKU,FT)
  1108. XX=A11**2-A12**2
  1109. DDL2=(A11*PHI2-A12*PHI2B)/XX
  1110. DDL2B=(A11*PHI2B-A12*PHI2)/XX
  1111.  
  1112. XP2=XP2+DDL2+DDL2B
  1113. DL2=DL2+DDL2
  1114. DL2B=DL2B+DDL2B
  1115.  
  1116. IF(DL2.LT.XZER) THEN
  1117. PRINT*,'Multiplicateur negatif (Rankine 2 Critere)'
  1118. STOP
  1119. ENDIF
  1120.  
  1121. SIGPP(1)=SIGPP(1)-DDL2*D11-DDL2B*D12
  1122. SIGPP(2)=SIGPP(2)-DDL2*D12-DDL2B*D11
  1123. SIGPP(3)=SIGPP(3)-DDL2*D12-DDL2B*D12
  1124.  
  1125. **-- calcul des nouveaux criteres phi2 et phi2b
  1126.  
  1127. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  1128. PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  1129. END DO
  1130. **-- test de convergence
  1131.  
  1132. IF((ABS(PHI2).LT.(PREC0*PHI20))
  1133. & .OR.(ABS(PHI2).LT.PREC1)) THEN
  1134.  
  1135. IF (DL2B.LT.XZER) THEN
  1136. ICOMPT=0
  1137. DL2=XZER
  1138. PHI2=F2INI
  1139. XP2=VAR0(2)
  1140. DO I=1,3
  1141. SIGPP(I)= SINI(I)
  1142. END DO
  1143. * PRINT*,'** 2e Multiplicateur negatif **'
  1144. ** appel bloc 20
  1145. DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  1146. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  1147. ICOMPT=ICOMPT+1
  1148.  
  1149. **-- calcul du multiplicateur
  1150.  
  1151. DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  1152. XP2=XP2+DDL2
  1153. DL2=DL2+DDL2
  1154. IF(DL2.LT.XZER) THEN
  1155. PRINT*,'Multiplicateur negatif
  1156. & (Rankine 1 Critere)'
  1157. STOP
  1158. ENDIF
  1159.  
  1160. SIGPP(1)=SIGPP(1)-DDL2*D11
  1161. SIGPP(2)=SIGPP(2)-DDL2*D12
  1162. SIGPP(3)=SIGPP(3)-DDL2*D12
  1163.  
  1164. **-- calcul du nouveau critere phi2
  1165.  
  1166. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  1167. PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  1168. END DO
  1169. **-- test de convergence
  1170.  
  1171. IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  1172. & (ABS(PHI2).LT.PREC1)) THEN
  1173. GO TO 998
  1174. ELSE
  1175. IF(ICOMPT.GE.20) THEN
  1176. PRINT*,'le nombre d iterations
  1177. & internes depasse 20
  1178. & (Rankine 1 Critere)'
  1179.  
  1180. STOP
  1181. ENDIF
  1182. ENDIF
  1183. *** fin bloc 20
  1184. ENDIF
  1185. GO TO 998
  1186. ELSE IF(ICOMPT.GE.20) THEN
  1187. PRINT*,'le nombre d iterations internes depasse 20
  1188. & (Rankine 2 Critere)'
  1189. STOP
  1190. ENDIF
  1191. Cfin bloc 21
  1192. * fin appel bloc 21
  1193. ENDIF
  1194. ENDIF
  1195. ELSE
  1196.  
  1197. IF (DL2.LT.XZER) THEN
  1198. * PRINT*,'multiplicateur negatif (D.P.-Rankine) 9'
  1199. ICOMPT=0
  1200. DL1=XZER
  1201. PHI1=F1INI
  1202. XP1=VAR0(1)
  1203. XP2=VAR0(2)
  1204. SEQ=SEQI
  1205. DO I=1,3
  1206. SIGPP(I)=SINI(I)
  1207. SD(I)=SDINI(I)
  1208. END DO
  1209. * debut appel bloc 9
  1210. ** début bloc 9
  1211. IF(XP1.GE.XU2) THEN
  1212. DO I=1,NSTRS
  1213. SIGF(I)=XZER
  1214. DEFP(I)=DEPST(I)
  1215. END DO
  1216. DDL1=PHI1/AUX3
  1217. VARF(1)=XP1+DDL1
  1218. VARF(2)=XP2
  1219. VARF(3)=VARF(1)+VARF(2)
  1220. VARF(4)=VARF(1)/XU
  1221. VARF(5)=EXP(-VARF(2)/XKU)/FT
  1222. GO TO 999
  1223. ENDIF
  1224. *** debut bloc 10
  1225. DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  1226. & ((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1)))
  1227. ICOMPT=ICOMPT+1
  1228.  
  1229. DIFF=XP1-XU
  1230. IF (XP1.LT.XU) THEN
  1231. DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU
  1232. ELSE IF((XP1.GE.XU)) THEN
  1233. DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2)
  1234. ENDIF
  1235.  
  1236. **-- calcul du multiplicateur
  1237.  
  1238. DDL1=PHI1/(AUX3-DFDX)
  1239. XP1=XP1+DDL1
  1240. DL1=DL1+DDL1
  1241.  
  1242. IF(XP1.GE.XU2) THEN
  1243. DO I=1,NSTRS
  1244. SIGF(I)=XZER
  1245. DEFP(I)=DEPST(I)
  1246. ENDDO
  1247. VARF(1)=XP1-DDL1+(PHI1/AUX3)
  1248. VARF(2)=XP2
  1249. VARF(3)=VARF(1)+VARF(2)
  1250. VARF(4)=VARF(1)/XU
  1251. VARF(5)=EXP(-VARF(2)/XKU)/FT
  1252. GO TO 999
  1253. ENDIF
  1254.  
  1255. SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)
  1256. SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)
  1257. SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)
  1258.  
  1259. **-- calcul du nouveau critere phi1
  1260.  
  1261. XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  1262.  
  1263. SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  1264. SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  1265. SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  1266.  
  1267. SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  1268. & +(SIGPP(3)-SIGPP(1))**2
  1269. SEQ=SQRT(SEQ/6.D0)
  1270.  
  1271. DIFF=XP1-XU
  1272. IF (XP1.LT.XU) THEN
  1273. ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  1274. ELSE IF ((XP1.GE.XU)) THEN
  1275. ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  1276. ENDIF
  1277. PHI1=SEQ+ALPHA*XI1-ZETA
  1278. END DO
  1279.  
  1280. **-- test de convergence
  1281.  
  1282. IF((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1))THEN
  1283. GO TO 998
  1284. ELSE IF(ICOMPT.GE.20) THEN
  1285. PRINT*,'le nombre d iterations internes depasse 20
  1286. & (Drucker-Prager 1 Critere)'
  1287. STOP
  1288. ENDIF
  1289. *** fin bloc 10
  1290. *** fin bloc 9
  1291. * fin appel bloc 9
  1292. ELSE
  1293. IF(DL2B.LT.XZER)THEN
  1294. * PRINT*,'multiplicateur negatif (D.P.-Rankine) 29 '
  1295. ICOMPT=0
  1296. DL1=XZER
  1297. DL2=XZER
  1298. PHI1=F1INI
  1299. PHI2=F2INI
  1300. XP1=VAR0(1)
  1301. XP2=VAR0(2)
  1302. SEQ=SEQI
  1303. DO I=1,3
  1304. SIGPP(I)=SINI(I)
  1305. SD(I)=SDINI(I)
  1306. END DO
  1307. * debut appel bloc 29
  1308. IF(XP1.GE.XU2) THEN
  1309. DO I=1,NSTRS
  1310. SIGF(I)=XZER
  1311. DEFP(I)=DEPST(I)
  1312. END DO
  1313. DDL1=PHI1/AUX3
  1314. VARF(1)=XP1+DDL1
  1315. VARF(2)=XP2
  1316. VARF(3)=VARF(1)+VARF(2)
  1317. VARF(4)=VARF(1)/XU
  1318. VARF(5)=EXP(-VARF(2)/XKU)/FT
  1319. GO TO 999
  1320. ENDIF
  1321.  
  1322. * debut bloc 30
  1323. DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  1324. & ((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20)
  1325. & .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)))
  1326. ICOMPT=ICOMPT+1
  1327. DIFF=XP1-XU
  1328. IF (XP1.LT.XU) THEN
  1329. DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU
  1330. ELSE IF((XP1.GE.XU)) THEN
  1331. DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2)
  1332. ENDIF
  1333.  
  1334. **-- calcul des 2 multiplicateurs dl1 et dl2
  1335.  
  1336. A11=AUX3-DFDX
  1337. A12=G*SD(1)/SEQ+TROIS*XK*ALPHA
  1338. A22=D11-DF2DX(XP2,XKU,FT)
  1339. XX=A11*A22-A12**2
  1340. DDL1=(A22*PHI1-A12*PHI2)/XX
  1341. DDL2=(A11*PHI2-A12*PHI1)/XX
  1342.  
  1343. XP1=XP1+DDL1
  1344. DL1=DL1+DDL1
  1345. XP2=XP2+DDL2
  1346. DL2=DL2+DDL2
  1347.  
  1348. IF(XP1.GE.XU2) THEN
  1349. DO I=1,NSTRS
  1350. SIGF(I)=XZER
  1351. DEFP(I)=DEPST(I)
  1352. END DO
  1353. VARF(1)=XP1-DDL1+(PHI1/AUX3)
  1354. VARF(2)=XP2
  1355. VARF(3)=VARF(1)+VARF(2)
  1356. VARF(4)=VARF(1)/XU
  1357. VARF(5)=EXP(-VARF(2)/XKU)/FT
  1358. GO TO 999
  1359. ENDIF
  1360.  
  1361. SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)
  1362. & -DDL2*D11
  1363. SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)
  1364. & -DDL2*D12
  1365. SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)
  1366. & -DDL2*D12
  1367.  
  1368. **-- calcul des nouveaux criteres phi1 et phi2
  1369.  
  1370. XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  1371.  
  1372. SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  1373. SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  1374. SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  1375.  
  1376. SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  1377. & +(SIGPP(3)-SIGPP(1))**2
  1378. SEQ=SQRT(SEQ/6.D0)
  1379.  
  1380. DIFF=XP1-XU
  1381. IF (XP1.LT.XU) THEN
  1382. ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  1383. ELSE IF ((XP1.GE.XU)) THEN
  1384. ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  1385. ENDIF
  1386. PHI1=SEQ+ALPHA*XI1-ZETA
  1387.  
  1388. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  1389.  
  1390. END DO
  1391. **-- test de convergence
  1392.  
  1393. IF((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20)
  1394. & .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)) THEN
  1395.  
  1396. IF(DL1.LT.XZER) THEN
  1397. * PRINT*,'1er multiplicateur negatif (D.P.-Rankine)'
  1398. ICOMPT=0
  1399. DL2=XZER
  1400. PHI2=F2INI
  1401. XP1=VAR0(1)
  1402. XP2=VAR0(2)
  1403. DO I=1,3
  1404. SIGPP(I)=SINI(I)
  1405. END DO
  1406. * debut appel bloc 20
  1407. *** debut bloc 20
  1408. DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  1409. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  1410. ICOMPT=ICOMPT+1
  1411.  
  1412. **-- calcul du multiplicateur
  1413.  
  1414. DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  1415. XP2=XP2+DDL2
  1416. DL2=DL2+DDL2
  1417. IF(DL2.LT.XZER) THEN
  1418. PRINT*,'Multiplicateur negatif (Rankine 1 Critere)'
  1419. STOP
  1420. ENDIF
  1421.  
  1422. SIGPP(1)=SIGPP(1)-DDL2*D11
  1423. SIGPP(2)=SIGPP(2)-DDL2*D12
  1424. SIGPP(3)=SIGPP(3)-DDL2*D12
  1425.  
  1426. **-- calcul du nouveau critere phi2
  1427.  
  1428. PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  1429. PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  1430. END DO
  1431. **-- test de convergence
  1432.  
  1433. IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  1434. & (ABS(PHI2).LT.PREC1)) THEN
  1435. GO TO 998
  1436. ELSE
  1437. IF(ICOMPT.GE.20) THEN
  1438. PRINT*,'le nombre d iterations internes depasse 20
  1439. & (Rankine 1 Critere)'
  1440.  
  1441. STOP
  1442. ENDIF
  1443. ENDIF
  1444. *** fin bloc 20
  1445. * fin appel bloc 20
  1446. ENDIF
  1447.  
  1448. IF (DL2.LT.XZER) THEN
  1449. * PRINT*,'2eme multiplicateur negatif (D.P.-Rankine)'
  1450. ICOMPT=0
  1451. DL1=XZER
  1452. PHI1=F1INI
  1453. XP1=VAR0(1)
  1454. XP2=VAR0(2)
  1455. SEQ=SEQI
  1456. DO I=1,3
  1457. SIGPP(I)=SINI(I)
  1458. SD(I)=SDINI(I)
  1459. END DO
  1460. * debut appel bloc 9
  1461. ** début bloc 9
  1462. IF(XP1.GE.XU2) THEN
  1463. DO I=1,NSTRS
  1464. SIGF(I)=XZER
  1465. DEFP(I)=DEPST(I)
  1466. END DO
  1467. DDL1=PHI1/AUX3
  1468. VARF(1)=XP1+DDL1
  1469. VARF(2)=XP2
  1470. VARF(3)=VARF(1)+VARF(2)
  1471. VARF(4)=VARF(1)/XU
  1472. VARF(5)=EXP(-VARF(2)/XKU)/FT
  1473. GO TO 999
  1474. ENDIF
  1475. *** debut bloc 10
  1476. DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  1477. & ((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1)))
  1478. ICOMPT=ICOMPT+1
  1479.  
  1480. DIFF=XP1-XU
  1481. IF (XP1.LT.XU) THEN
  1482. DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU
  1483. ELSE IF((XP1.GE.XU)) THEN
  1484. DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2)
  1485. ENDIF
  1486.  
  1487. **-- calcul du multiplicateur
  1488.  
  1489. DDL1=PHI1/(AUX3-DFDX)
  1490. XP1=XP1+DDL1
  1491. DL1=DL1+DDL1
  1492.  
  1493. IF(XP1.GE.XU2) THEN
  1494. DO I=1,NSTRS
  1495. SIGF(I)=XZER
  1496. DEFP(I)=DEPST(I)
  1497. END DO
  1498. VARF(1)=XP1-DDL1+(PHI1/AUX3)
  1499. VARF(2)=XP2
  1500. VARF(3)=VARF(1)+VARF(2)
  1501. VARF(4)=VARF(1)/XU
  1502. VARF(5)=EXP(-VARF(2)/XKU)/FT
  1503. GO TO 999
  1504. ENDIF
  1505.  
  1506. SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)
  1507. SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)
  1508. SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)
  1509.  
  1510. **-- calcul du nouveau critere phi1
  1511.  
  1512. XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  1513.  
  1514. SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  1515. SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  1516. SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  1517.  
  1518. SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  1519. & +(SIGPP(3)-SIGPP(1))**2
  1520. SEQ=SQRT(SEQ/6.D0)
  1521.  
  1522. DIFF=XP1-XU
  1523. IF (XP1.LT.XU) THEN
  1524. ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  1525. ELSE IF ((XP1.GE.XU)) THEN
  1526. ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  1527. ENDIF
  1528. PHI1=SEQ+ALPHA*XI1-ZETA
  1529. END DO
  1530.  
  1531. **-- test de convergence
  1532.  
  1533. IF((ABS(PHI1).LT.(PREC0*PHI10)).OR.
  1534. & (ABS(PHI1).LT.PREC1))THEN
  1535. GO TO 998
  1536. ELSE IF(ICOMPT.GE.20) THEN
  1537. PRINT*,'le nombre d iterations internes depasse 20
  1538. & (Drucker-Prager 1 Critere)'
  1539. STOP
  1540. ENDIF
  1541. *** fin bloc 10
  1542. *** fin bloc 9
  1543. * fin appel bloc 9
  1544. ENDIF
  1545. GO TO 998
  1546. ELSE IF(ICOMPT.GE.20) THEN
  1547. PRINT*,'le nombre d iterations internes depasse 20
  1548. & (D.P.-Rankine)'
  1549. STOP
  1550. ENDIF
  1551. * fin bloc 30
  1552. * fin bloc 29
  1553. * fin appel bloc 29
  1554. ENDIF
  1555. ENDIF
  1556. ENDIF
  1557. GO TO 998
  1558. ELSE
  1559. IF(ICOMPT.GE.20) THEN
  1560. PRINT*,'le nombre d iterations internes depasse 20
  1561. & (D.P.-Rankine)'
  1562. STOP
  1563. ENDIF
  1564. ENDIF
  1565. ** fin bloc 31
  1566. ENDIF
  1567.  
  1568. * PRINT*,'pas dedans'
  1569. 998 DO I=1,3
  1570. DO J=1,3
  1571. XMS(I,J)=XZER
  1572. IF(I.EQ.J) XMS(I,J)=SIGPP(I)
  1573. ENDDO
  1574. ENDDO
  1575. * PRINT*,'dedans'
  1576. **-- calcul de sigf = R * sigpp * RT
  1577.  
  1578. CALL TRSPOD (R,3,3,RT)
  1579. CALL MULMAT(TRAV,XMS,RT,3,3,3)
  1580. CALL MULMAT(XMS,R,TRAV,3,3,3)
  1581.  
  1582. SIGF(1)=XMS(1,1)
  1583. SIGF(2)=XMS(2,2)
  1584. SIGF(3)=XMS(3,3)
  1585. SIGF(4)=XMS(1,2)
  1586. IF (IFOURB.EQ.2) THEN
  1587. SIGF(5)=XMS(1,3)
  1588. SIGF(6)=XMS(2,3)
  1589. ENDIF
  1590. DO I=1,NSTRS
  1591. DS(I)=S(I)-SIGF(I)
  1592. ENDDO
  1593. CALL EPSIG0(DS,DEFP,MFR,IFOURB,YOUN,XNU,XCAR,NSTRS)
  1594. VARF(1)=XP1
  1595. VARF(2)=XP2
  1596. VARF(3)=VARF(1)+VARF(2)
  1597. VARF(4)=VARF(1)/XU
  1598. VARF(5)=EXP(-VARF(2)/XKU)/FT
  1599. 999 RETURN
  1600. END
  1601.  
  1602. FUNCTION DF2DX(XP2,XKU,FT)
  1603. IMPLICIT REAL*8(A-H,O-Z)
  1604. IF (XKU.EQ.0.D0) THEN
  1605. DF2DX=0.D0
  1606. ELSE
  1607. DF2DX=FT*EXP(-XP2/XKU)/XKU
  1608. ENDIF
  1609. END
  1610.  
  1611. FUNCTION TX2(XP2,XKU)
  1612. IMPLICIT REAL*8(A-H,O-Z)
  1613. IF (XKU.EQ.0.D0) THEN
  1614. TX2=1.D0
  1615. ELSE
  1616. TX2=EXP(-XP2/XKU)
  1617. ENDIF
  1618. END
  1619.  
  1620.  
  1621.  
  1622.  
  1623.  
  1624.  
  1625.  
  1626.  

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