Télécharger ecbecp.eso

Retour à la liste

Numérotation des lignes :

  1. C ECBECP SOURCE CHAT 05/01/12 23:20:16 5004
  2. SUBROUTINE ECBECP(W1,W2,XLAMBD,DEFPLA,YOUN,ANU,IFISSU,ANG,BETA,
  3. . RT1,PENTT1,RT2,PENTT2,DPELA2,ADP,PENTE2,IDAMA,SIGEL,LETYP,
  4. . KERRE)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. -INC CCOPTIO
  8. DIMENSION SIG(3),DSIG(3),TENS(3),
  9. 1 TSIG(3),TSFG(3),SFG(3),DSFG(3),IDAM(3),
  10. 1 EPPLTR(3),EPPLDP(3),EPT(3),EPDP(3),DEFPLA(6),
  11. 1 W1(6),W2(6),XLAMBD(6),DLAMBD(6),SIGEL(6),IDA(6)
  12. C
  13. C INITIALISATION
  14. C
  15. H1=-PENTT1
  16. H2=-PENTT2
  17. HDP=-PENTE2
  18. RDP=DPELA2-XLAMBD(3)*HDP
  19. C
  20. C VALEURS DE REFERENCES
  21. C
  22. RFSIG=YOUN*1.D-8
  23. RFEPS=1.D-8
  24. C
  25. IF(RT1.LE.1.E-11) H1=0.D0
  26. IF(RT1.LE.1.E-11) RT1=0.D0
  27. IF(RT2.LE.1.E-11) H2=0.D0
  28. IF(RT2.LE.1.E-11) RT2=0.
  29. IF(RDP.LE.0.) HDP=0.D0
  30. IF(RDP.LE.0.) ADP=0.D0
  31. IF(RDP.LE.0.) RDP=0.D0
  32. C
  33. RT=RT1
  34. ITER=0
  35. ICHR=0
  36. IERRE=0
  37. 12121 XLAM1=XLAMBD(1)
  38. XLAM2=XLAMBD(2)
  39. XLAM3=XLAMBD(3)
  40. IDA(1)=0
  41. IDA(2)=0
  42. IDA(3)=0
  43. IDA(4)=0
  44. IDA(5)=0
  45. IDA(6)=0
  46. *
  47.  
  48.  
  49. * LETYP = 2 COQUES ( AXISYM ET DEF PLANES )
  50. * LETYP = 7 COQUES EN CONTRAINTES PLANES
  51. * LETYP = 6 MASSIF CONTRAINTES PLANES
  52.  
  53.  
  54. SIG(1)=W1(1)
  55. SIG(2)=W1(2)
  56. IF(LETYP.EQ.6) SIG(3)=W1(4)
  57. IF(LETYP.EQ.2.OR.LETYP.EQ.7) SIG(3)=W1(3)
  58. DSIG(1)=W2(1)
  59. DSIG(2)=W2(2)
  60. IF(LETYP.EQ.6) DSIG(3)=W2(4)
  61. IF(LETYP.EQ.2.OR.LETYP.EQ.7) DSIG(3)=W2(3)
  62. *
  63. IF(XLAM2.LT.RFEPS) XLAM2=0.D0
  64. IF(XLAM1.LT.RFEPS) XLAM1=0.D0
  65. CALL ZDANUL(DLAMBD,6)
  66. CALL ZDANUL(EPPLTR,3)
  67. CALL ZDANUL(EPPLDP,3)
  68. CALL ZDANUL(EPT,3)
  69. CALL ZDANUL(EPDP,3)
  70. IF(IIMPI.EQ.9) THEN
  71. WRITE(IOIMP,9998) YOUN,ANU
  72. 9998 FORMAT(1X,'ECBECP',3X,'YOUNG',1X,1PE12.5,3X,'NU',1X,1PE12.5)
  73. WRITE(IOIMP,10004) IFISSU,ANG,BETA
  74. 10004 FORMAT(1X,'ECBECP',3X,'IFISSU',1X,I3,3X,'ANGFIS',1X,
  75. 1 1PE12.5,3X,'CISRES',1X,1PE12.5,/)
  76. WRITE(IOIMP,10001) RT1,H1,XLAM1
  77. 10001 FORMAT(1X,'ECBECP',3X,'LIMTR1',1X,1PE12.5,3X,'PENTT1',
  78. 1 1X,1PE12.5,3X,'OUVER1',1X,1PE12.5,/)
  79. WRITE(IOIMP,10002) RT2,H2,XLAM2
  80. 10002 FORMAT(1X,'ECBECP',3X,'LIMTR2',1X,1PE12.5,3X,'PENTT2',
  81. 1 1X,1PE12.5,3X,'OUVER2',1X,1PE12.5,/)
  82. WRITE(IOIMP,10003) RDP,ADP,HDP,XLAM3
  83. 10003 FORMAT(1X,'ECBECP',3X,'RAYDRU',1X,1PE12.5,3X,'ALPDRU',
  84. 1 1X,1PE12.5,3X,'ECRDRU',1X,1PE12.5,3X,'OUVDRU',1X,1PE12.5,/)
  85. WRITE(IOIMP,10020) (W1(I),I=1,4)
  86. 10020 FORMAT(1X,'ECBECP',3X,'SIGMA ',4(1X,1PE12.5),/)
  87. WRITE(IOIMP,10021) (W2(I),I=1,4)
  88. 10021 FORMAT(1X,'ECBECP',3X,'DSIGMA ',4(1X,1PE12.5),/)
  89. WRITE(IOIMP,10005) (XLAMBD(I),I=1,6)
  90. 10005 FORMAT(1X,'ECBECP',3X,'XLAMBD',6(1X,1PE12.5),/)
  91. WRITE(IOIMP,10006) (DLAMBD(I),I=1,6)
  92. 10006 FORMAT(1X,'ECBECP',3X,'DLAMBD',6(1X,1PE12.5),/)
  93. ENDIF
  94. IF(ICHR.GT.0)THEN
  95. KERRE=462
  96. WRITE(IOIMP,*) 'ICHR',ICHR
  97. RETURN
  98. ENDIF
  99. IF(IFISSU.EQ.1) THEN
  100. CALL CHREP(DSIG,DSFG,ANG)
  101. EPT(1)=0.D0
  102. EPT(2)=0.D0
  103. EPT(3)=(1.D0-BETA)*DSFG(3)
  104. CALL CHREP(EPT,TENS,-ANG)
  105. CALL CPHOIN(TENS,EPT,YOUN,ANU)
  106. DO 10 ITYP=1,3
  107. 10 EPPLTR(ITYP)=EPPLTR(ITYP)+EPT(ITYP)
  108. DSFG(3)=BETA*DSFG(3)
  109. CALL CHREP(DSFG,DSIG,-ANG)
  110. CALL CHREP(SIG,SFG,ANG)
  111. IF(SFG(1).GT.RT1) THEN
  112. DSFG(1)=DSFG(1)+SFG(1)-RT1
  113. SFG(1)=RT1
  114. ENDIF
  115. IF(SFG(2).GT.RT2) THEN
  116. DSFG(2)=DSFG(2)+SFG(2)-RT2
  117. SFG(2)=RT2
  118. ENDIF
  119. IF(SFG(1).LT.0.D0.AND.XLAM1.GE.RFEPS) THEN
  120. DSFG(1)=DSFG(1)+SFG(1)
  121. SFG(1)=0.D0
  122. ENDIF
  123. IF(SFG(2).LT.0.D0.AND.XLAM2.GE.RFEPS) THEN
  124. DSFG(2)=DSFG(2)+SFG(2)
  125. SFG(2)=0.D0
  126. ENDIF
  127. CALL CDP(SFG,ADP,RDP,VCDP)
  128. IF(VCDP.LE.0.D0) GOTO 30
  129. TSFG(1)=0.D0
  130. TSFG(2)=0.D0
  131. TSFG(3)=0.D0
  132. CALL XDP(TSFG,SFG,RDP,ADP,X,ITEST)
  133. DO 20 ITYP=1,3
  134. DSFG(ITYP)=DSFG(ITYP)+(1.D0-X)*SFG(ITYP)
  135. 20 SFG(ITYP)=SFG(ITYP)*X
  136. 30 CALL CHREP(SFG,SIG,-ANG)
  137. CALL CHREP(DSFG,DSIG,-ANG)
  138. GOTO 100
  139. ENDIF
  140. DO 50 ITYP=1,3
  141. 50 TSIG(ITYP)=0.D0
  142. CALL CDP(SIG,ADP,RDP,VCDP)
  143. IF(VCDP.GT.0.D0) THEN
  144. CALL XDP(TSIG,SIG,RDP,ADP,X,ITEST)
  145. DO 60 ITYP=1,3
  146. DSIG(ITYP)=DSIG(ITYP)+(1.D0-X)*SIG(ITYP)
  147. 60 SIG(ITYP)=X*SIG(ITYP)
  148. ENDIF
  149. CALL CTRSF(SIG,RT,VCTR)
  150. IF(VCTR.LE.0.D0) GOTO 100
  151. CALL GAMTSF(TSIG,SIG,RT,X)
  152. DO 70 ITYP=1,3
  153. DSIG(ITYP)=DSIG(ITYP)+(1.D0-X)*SIG(ITYP)
  154. 70 SIG(ITYP)=X*SIG(ITYP)
  155. 100 GAMDP=10.D0
  156. GAMTR1=10.D0
  157. GAMTR2=10.D0
  158. GAMCO1=10.D0
  159. GAMCO2=10.D0
  160. DO 110 ITYP=1,3
  161. 110 TSIG(ITYP)=SIG(ITYP)+DSIG(ITYP)
  162. CALL CDP(TSIG,ADP,RDP,VCDP)
  163. IF(VCDP.GT.0.D0) CALL GDP(SIG,DSIG,RDP,ADP,GAMDP)
  164. IF(IFISSU.EQ.1) GOTO 1000
  165. CALL CTRSF(TSIG,RT,VCTR)
  166. IF(VCTR.LE.0.D0) GOTO 2000
  167. CALL GAMTSF(SIG,DSIG,RT,GAMTR)
  168. IF((GAMTR-GAMDP).GT.RFEPS) GOTO 2000
  169. DO 120 ITYP=1,3
  170. 120 TENS(ITYP)=SIG(ITYP)+GAMTR*DSIG(ITYP)
  171. CALL CANG(TENS,ANG,YOUN)
  172. CALL CHREP(DSIG,DSFG,ANG)
  173. CALL CHREP(SIG,SFG,ANG)
  174. SFG(3)=BETA*SFG(3)
  175. CALL CHREP(SFG,SIG,-ANG)
  176. EPT(1)=0.D0
  177. EPT(2)=0.D0
  178. EPT(3)=(1.D0-BETA)*(DSFG(3)+SFG(3))
  179. CALL CHREP(EPT,TENS,-ANG)
  180. CALL CPHOIN(TENS,EPT,YOUN,ANU)
  181. DO 130 ITYP=1,3
  182. 130 EPPLTR(ITYP)=EPPLTR(ITYP)+EPT(ITYP)
  183. DSFG(3)=DSFG(3)*BETA
  184. CALL CHREP(DSFG,DSIG,-ANG)
  185. IFISSU=1
  186. 1000 DO 200 ITYP=1,3
  187. 200 TSIG(ITYP)=SIG(ITYP)+DSIG(ITYP)
  188. CALL CHREP(SIG,SFG,ANG)
  189. CALL CHREP(DSIG,DSFG,ANG)
  190. CALL CHREP(TSIG,TSFG,ANG)
  191. CALL CDP(TSFG,ADP,RDP,VCDP)
  192. IF(VCDP.GT.0.D0) CALL GDP(SFG,DSFG,RDP,ADP,GAMDP)
  193. CALL CTRAF(TSFG(1),RT1,VCTR1)
  194. CALL CTRAF(TSFG(2),RT2,VCTR2)
  195. IF(VCTR1.GT.0.D0) CALL GAMTAF(SFG(1),DSFG(1),RT1,GAMTR1)
  196. IF(VCTR2.GT.0.D0) CALL GAMTAF(SFG(2),DSFG(2),RT2,GAMTR2)
  197. CALL CCOAF(TSFG(1),XLAM1,VCCO1)
  198. CALL CCOAF(TSFG(2),XLAM2,VCCO2)
  199. IF(VCCO1.GT.0.D0) CALL GAMCAF(SFG(1),DSFG(1),GAMCO1)
  200. IF(VCCO2.GT.0.D0) CALL GAMCAF(SFG(2),DSFG(2),GAMCO2)
  201. 2000 GAM=MIN(GAMTR1,GAMTR2,GAMCO1,GAMCO2,GAMDP)
  202. IF(GAM.GE.1.D0) GAM=1.D0
  203. DO 230 ITYP=1,3
  204. SIG(ITYP)=SIG(ITYP)+GAM*DSIG(ITYP)
  205. 230 DSIG(ITYP)=(1.D0-GAM)*DSIG(ITYP)
  206. CALL CDP(SIG,ADP,RDP,VCDP)
  207. IF(VCDP.GT.RFSIG.AND.IIMPI.EQ.9)
  208. . WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  209. AT1=ABS(GAMTR1-GAM)
  210. AT2=ABS(GAMTR2-GAM)
  211. AC1=ABS(GAMCO1-GAM)
  212. AC2=ABS(GAMCO2-GAM)
  213. AD3=ABS(GAMDP-GAM)
  214. IF(IIMPI.EQ.9) THEN
  215. WRITE(IOIMP,10012) GAMDP,GAMTR1,GAMTR2
  216. 10012 FORMAT(1X,'ECBECP',3X,'GAMDRU',1X,1PE12.5,3X,'GAMTR1',1X,
  217. 1 1PE12.5,3X,'GAMTR2',1X,1PE12.5,/)
  218. WRITE(IOIMP,20012) GAMCO1,GAMCO2,GAM
  219. 20012 FORMAT(1X,'ECBECP',3X,'GAMCO1',1X,1PE12.5,3X,'GAMCO2',1X,
  220. 1 1PE12.5,3X,'GAM',1X,1PE12.5,/)
  221. ENDIF
  222. IDAM(1)=0
  223. IDAM(2)=0
  224. IDAM(3)=0
  225. IDAMA=0
  226. IF(IFISSU.EQ.1) IDAMA=1
  227. IF(GAM.EQ.1.D0) GOTO 99997
  228. IF(AT1.LT.RFEPS) IDAM(1)=1
  229. IF(AT2.LT.RFEPS) IDAM(2)=1
  230. IF(AC1.LT.RFEPS) IDAM(1)=-1
  231. IF(AC2.LT.RFEPS) IDAM(2)=-1
  232. IF(AD3.LT.RFEPS) IDAM(3)=1
  233. IDAMA=ABS(IDAM(1))+ABS(IDAM(2))+IDAM(3)
  234. CALL CDP(SIG,ADP,RDP,VCDP)
  235. IDA(1)=IDAM(1)
  236. IDA(2)=IDAM(2)
  237. IDA(3)=IDAM(3)
  238. 99998 CONTINUE
  239. IF(IIMPI.EQ.9) THEN
  240. CALL CHREP(SIG,SFG,ANG)
  241. CALL CHREP(DSIG,DSFG,ANG)
  242. CALL CDP(SFG,ADP,RDP,VCDP)
  243. CALL CTRAF(SFG(1),RT1,VCTR1)
  244. CALL CTRAF(SFG(2),RT2,VCTR2)
  245. CALL CCOAF(SFG(1),XLAM1,VCCO1)
  246. CALL CCOAF(SFG(2),XLAM2,VCCO2)
  247. WRITE(IOIMP,10097) (SFG(I),I=1,3)
  248. WRITE(IOIMP,10097) (DSFG(I),I=1,3)
  249. WRITE(IOIMP,10004) IFISSU,ANG,BETA
  250. WRITE(IOIMP,10001) RT1,H1,XLAM1
  251. WRITE(IOIMP,10002) RT2,H2,XLAM2
  252. WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  253. WRITE(IOIMP,20008) VCCO1,VCCO2
  254. ENDIF
  255. ITER=ITER+1
  256. CALL CHREP(SIG,SFG,ANG)
  257. CALL CHREP(DSIG,DSFG,ANG)
  258. CALL CDP(SFG,ADP,RDP,VCDP)
  259. CALL CTRAF(SFG(1),RT1,VCTR1)
  260. CALL CTRAF(SFG(2),RT2,VCTR2)
  261. CALL CCOAF(SFG(1),XLAM1,VCCO1)
  262. CALL CCOAF(SFG(2),XLAM2,VCCO2)
  263. ****************************************************************
  264. IF(VCCO1.GT.RFSIG.OR.VCCO2.GT.RFSIG.OR.VCTR1.GT.RFSIG) THEN
  265. ICHR=1
  266. WRITE(IOIMP,*) 'VCCO1 =',VCCO1
  267. WRITE(IOIMP,*) 'VCCO2 =',VCCO2
  268. WRITE(IOIMP,*) 'VCTR1 =',VCTR1
  269. WRITE(IOIMP,*) 'RFSIG =',RFSIG
  270. ****************************************************************
  271. IF(IIMPI.EQ.9) THEN
  272. WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  273. WRITE(IOIMP,20008) VCCO1,VCCO2
  274. ENDIF
  275. ENDIF
  276. ****************************************************************
  277. IF(VCTR2.GT.RFSIG.OR.VCDP.GT.RFSIG) THEN
  278. ICHR=2
  279. WRITE(IOIMP,*) 'VCTR2 =',VCTR2
  280. WRITE(IOIMP,*) 'VCDP =',VCDP
  281. WRITE(IOIMP,*) 'RFSIG =',RFSIG
  282. ****************************************************************
  283. IF(IIMPI.EQ.9) THEN
  284. WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  285. WRITE(IOIMP,20008) VCCO1,VCCO2
  286. ENDIF
  287. ENDIF
  288. ****************************************************************
  289. IF(XLAM1.LT.-RFEPS.AND.IDAM(1).EQ.-1) THEN
  290. ICHR=3
  291. WRITE(IOIMP,*) 'XLAM1 =',XLAM1
  292. ****************************************************************
  293. IF(IIMPI.EQ.9) THEN
  294. WRITE(IOIMP,876)
  295. 876 FORMAT(1X,'ERREUR C1',/)
  296. WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  297. WRITE(IOIMP,20008) VCCO1,VCCO2
  298. WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  299. WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  300. WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  301. ENDIF
  302. ENDIF
  303. ****************************************************************
  304. IF(VCTR1.LT.-RFSIG.AND.IDAM(1).EQ.1) THEN
  305. ICHR=4
  306. WRITE(IOIMP,*) 'VCTR1 =',VCTR1
  307. ****************************************************************
  308. IF(IIMPI.EQ.9) THEN
  309. WRITE(IOIMP,875)
  310. 875 FORMAT(1X,'ERREUR T1',/)
  311. WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  312. WRITE(IOIMP,20008) VCCO1,VCCO2
  313. ENDIF
  314. ENDIF
  315. ****************************************************************
  316. IF(XLAM2.LT.-RFEPS.AND.IDAM(2).EQ.-1) THEN
  317. ICHR=5
  318. WRITE(IOIMP,*) 'XLAM2 =',XLAM2
  319. ****************************************************************
  320. IF(IIMPI.EQ.9) THEN
  321. WRITE(IOIMP,874)
  322. 874 FORMAT(1X,'ERREUR C2',/)
  323. WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  324. WRITE(IOIMP,20008) VCCO1,VCCO2
  325. WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  326. WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  327. WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  328. ENDIF
  329. ENDIF
  330. ****************************************************************
  331. IF(VCTR2.LT.-RFSIG.AND.IDAM(2).EQ.1) THEN
  332. ICHR=6
  333. WRITE(IOIMP,*) 'VCTR2 =',VCTR2
  334. ****************************************************************
  335. IF(IIMPI.EQ.9) THEN
  336. WRITE(IOIMP,873)
  337. 873 FORMAT(1X,'ERREUR T2',/)
  338. WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  339. WRITE(IOIMP,20008) VCCO1,VCCO2
  340. WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  341. WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  342. WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  343. ENDIF
  344. ENDIF
  345. ****************************************************************
  346. IF(VCDP.LT.-RFSIG.AND.IDAM(3).EQ.1) THEN
  347. ICHR=7
  348. WRITE(IOIMP,*) 'VCDP =',VCDP
  349. ****************************************************************
  350. IF(IIMPI.EQ.9) THEN
  351. WRITE(IOIMP,872)
  352. 872 FORMAT(1X,'ERREUR DP',/)
  353. WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  354. WRITE(IOIMP,20008) VCCO1,VCCO2
  355. WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  356. WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  357. WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  358. ENDIF
  359. ENDIF
  360. ****************************************************************
  361. IF(XLAM1.LT.-RFEPS) THEN
  362. ICHR=8
  363. WRITE(IOIMP,*) 'XLAM1 =',XLAM1
  364. ****************************************************************
  365. IF(IIMPI.EQ.9) THEN
  366. WRITE(IOIMP,1876)
  367. 1876 FORMAT(1X,'ERREUR XLAM1',/)
  368. WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  369. WRITE(IOIMP,20008) VCCO1,VCCO2
  370. WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  371. WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  372. WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  373. ENDIF
  374. ENDIF
  375. ****************************************************************
  376. IF(XLAM2.LT.-RFEPS) THEN
  377. ICHR=9
  378. WRITE(IOIMP,*) 'XLAM2 =',XLAM2
  379. ****************************************************************
  380. IF(IIMPI.EQ.9) THEN
  381. WRITE(IOIMP,1877)
  382. 1877 FORMAT(1X,'ERREUR XLAM2',/)
  383. WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  384. WRITE(IOIMP,20008) VCCO1,VCCO2
  385. WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  386. WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  387. WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  388. ENDIF
  389. ENDIF
  390. ****************************************************************
  391. IF(XLAM3.LT.-RFEPS) THEN
  392. ICHR=10
  393. WRITE(IOIMP,*) 'XLAM3 =',XLAM3
  394. ****************************************************************
  395. IF(IIMPI.EQ.9) THEN
  396. WRITE(IOIMP,1878)
  397. 1878 FORMAT(1X,'ERREUR XLAM3',/)
  398. WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  399. WRITE(IOIMP,20008) VCCO1,VCCO2
  400. WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  401. WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  402. WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  403. ENDIF
  404. ENDIF
  405. CALL NORME(DSIG,VA1)
  406. IF(ITER.EQ.16) THEN
  407. IF(IIMPI.EQ.9) WRITE(IOIMP,10011)
  408. 10011 FORMAT(1X,'ERREUR OSCILLATION DE BOITE',/)
  409. ENDIF
  410. IF(ICHR.GT.0) GOTO 12121
  411. IF(ITER.GT.24) RETURN
  412. CALL ZDANUL(EPT,3)
  413. CALL ZDANUL(EPDP,3)
  414. IF(IIMPI.EQ.9) WRITE(IOIMP,10000) IDAM(1),IDAM(2),IDAM(3)
  415. 10000 FORMAT(1X,'IDAM1',I3,3X,'IDAM2',I3,3X,'IDAM3',I3)
  416. IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.0) GOTO 99997
  417. IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.0) THEN
  418. CALL T1(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,RDP,ADP,
  419. 1 XLAM1,XLAM2,IDAM,ANG)
  420. GOTO 99999
  421. ENDIF
  422. IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.0) THEN
  423. CALL C1(SIG,DSIG,YOUN,ANU,RT2,RDP,ADP,XLAM1,XLAM2,IDAM,ANG)
  424. GOTO 99999
  425. ENDIF
  426. IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.0) THEN
  427. CALL T2(SIG,DSIG,YOUN,ANU,RT1,RT2,H2,RDP,ADP,
  428. 1 XLAM1,XLAM2,IDAM,ANG)
  429. GOTO 99999
  430. ENDIF
  431. IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.0) THEN
  432. CALL C2(SIG,DSIG,YOUN,ANU,RT1,RDP,ADP,
  433. 1 XLAM1,XLAM2,IDAM,ANG)
  434. GOTO 99999
  435. ENDIF
  436. IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.1) THEN
  437. CALL DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP,
  438. 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,IFISSU,EPDP,EPT,BETA,KERRE)
  439. IF(KERRE.NE.0) RETURN
  440. GOTO 99999
  441. ENDIF
  442. IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.0) THEN
  443. CALL T1T2(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,H2,RDP,ADP,
  444. 1 XLAM1,XLAM2,IDAM,ANG)
  445. GOTO 99999
  446. ENDIF
  447. IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.0) THEN
  448. CALL T1C2(SIG,DSIG,YOUN,ANU,RT1,H1,RDP,ADP,
  449. 1 XLAM1,XLAM2,IDAM,ANG)
  450. GOTO 99999
  451. ENDIF
  452. IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.1) THEN
  453. CALL T1DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,RDP,ADP,HDP,
  454. 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  455. IF(KERRE.NE.0) RETURN
  456. GOTO 99999
  457. ENDIF
  458. IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.0) THEN
  459. CALL T2C1(SIG,DSIG,YOUN,ANU,RT2,H2,RDP,ADP,
  460. 1 XLAM1,XLAM2,IDAM,ANG)
  461. GOTO 99999
  462. ENDIF
  463. IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.0) THEN
  464. CALL C1C2(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,
  465. 1 XLAM1,XLAM2,IDAM,ANG)
  466. GOTO 99999
  467. ENDIF
  468. IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.1) THEN
  469. CALL C1DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP,
  470. 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  471. IF(KERRE.NE.0) RETURN
  472. GOTO 99999
  473. ENDIF
  474. IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.1) THEN
  475. CALL T2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H2,RDP,ADP,HDP,
  476. 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  477. IF(KERRE.NE.0) RETURN
  478. GOTO 99999
  479. ENDIF
  480. IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.1) THEN
  481. CALL C2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP,
  482. 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  483. IF(KERRE.NE.0) RETURN
  484. GOTO 99999
  485. ENDIF
  486. IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.1) THEN
  487. CALL T1T2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,H2,RDP,ADP,HDP,
  488. 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  489. IF(KERRE.NE.0) RETURN
  490. GOTO 99999
  491. ENDIF
  492. IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.1) THEN
  493. CALL T1C2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,RDP,ADP,HDP,
  494. 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  495. IF(KERRE.NE.0) RETURN
  496. GOTO 99999
  497. ENDIF
  498. IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.1) THEN
  499. CALL T2C1DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H2,RDP,ADP,HDP,
  500. 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  501. IF(KERRE.NE.0) RETURN
  502. GOTO 99999
  503. ENDIF
  504. IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.1) THEN
  505. CALL C1C2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP,
  506. 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  507. IF(KERRE.NE.0) RETURN
  508. GOTO 99999
  509. ENDIF
  510. 99999 DO 300 ITYP=1,3
  511. EPPLTR(ITYP)=EPPLTR(ITYP)+EPT(ITYP)
  512. 300 EPPLDP(ITYP)=EPPLDP(ITYP)+EPDP(ITYP)
  513. C
  514. C
  515. CALL CHREP(SIG,SFG,ANG)
  516. CALL CDP(SFG,ADP,RDP,VCDP)
  517. CALL CTRAF(SFG(1),RT1,VCTR1)
  518. CALL CTRAF(SFG(2),RT2,VCTR2)
  519. CALL CCOAF(SFG(1),XLAM1,VCCO1)
  520. CALL CCOAF(SFG(2),XLAM2,VCCO2)
  521. ****************************************************************
  522. IF(VCCO1.GT.RFSIG.OR.VCCO2.GT.RFSIG.OR.VCTR1.GT.RFSIG) THEN
  523. ICHR=11
  524. WRITE(IOIMP,*) 'VCCO1 =',VCCO1
  525. WRITE(IOIMP,*) 'VCCO2 =',VCCO2
  526. WRITE(IOIMP,*) 'VCTR1 =',VCTR1
  527. WRITE(IOIMP,*) 'RFSIG =',RFSIG
  528. ****************************************************************
  529. IF(IIMPI.EQ.9) THEN
  530. WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  531. WRITE(IOIMP,20008) VCCO1,VCCO2
  532. WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  533. WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  534. WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  535. ENDIF
  536. ENDIF
  537. ****************************************************************
  538. IF(VCTR2.GT.RFSIG.OR.VCDP.GT.RFSIG)THEN
  539. ICHR=12
  540. WRITE(IOIMP,*) 'VCTR2 =',VCTR2
  541. WRITE(IOIMP,*) 'VCDP =',VCDP
  542. WRITE(IOIMP,*) 'RFSIG =',RFSIG
  543. ****************************************************************
  544. IF(IIMPI.EQ.9) THEN
  545. WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  546. WRITE(IOIMP,20008) VCCO1,VCCO2
  547. WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  548. WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  549. WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  550. ENDIF
  551. ENDIF
  552. C
  553. CALL NORME(DSIG,VA2)
  554. VA=VA2-VA1
  555. IF(VA.GT.RFSIG) THEN
  556. ****************************************************************
  557. ICHR=13
  558. WRITE(IOIMP,*) 'VA1 =',VA1
  559. WRITE(IOIMP,*) 'VA2 =',VA2
  560. WRITE(IOIMP,*) 'VA =',VA
  561. WRITE(IOIMP,*) 'RFSIG =',RFSIG
  562. ****************************************************************
  563. IF(IIMPI.EQ.9) THEN
  564. WRITE(IOIMP,22222)
  565. 22222 FORMAT(1X,'ERREUR DSIGMA CROISSANT',/)
  566. WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  567. WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  568. WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  569. 22223 FORMAT(1X,'IDAM1 ',I3,'IDAM2 ',I3,'IDAM3 ',I3,/)
  570. 22224 FORMAT(1X,'IDA1 ',I4,'IDA2 ',I4,'IDA3 ',I4,/)
  571. 22225 FORMAT(1X,'IDA4 ',I4,'IDA5 ',I4,'IDA6 ',I4,/)
  572. ENDIF
  573. ENDIF
  574. IDA(4)=IDA(1)
  575. IDA(5)=IDA(2)
  576. IDA(6)=IDA(3)
  577. IDA(1)=IDAM(1)
  578. IDA(2)=IDAM(2)
  579. IDA(3)=IDAM(3)
  580. VA=ABS(VA)
  581. IF(VA.LT.RFSIG) IERRE=IERRE+1
  582. IF(VA.GT.RFSIG) IERRE=0
  583. IF(IERRE.GE.8) THEN
  584. IDAM(1)=-(IDA(1)+IDA(4)-2)
  585. IDAM(2)=-(IDA(2)+IDA(5)-2)
  586. IDAM(3)=-(IDA(3)+IDA(6)-2)
  587. IF(IDAM(1).EQ.3) IDAM(1)=-1
  588. IF(IDAM(2).EQ.3) IDAM(2)=-1
  589. IF(ABS(IDAM(1)).GT.1) IDAM(1)=0
  590. IF(ABS(IDAM(2)).GT.1) IDAM(2)=0
  591. IF(IDAM(3).GT.1) IDAM(3)=0
  592. GOTO 99998
  593. ENDIF
  594. IF(XLAM1.LE.RFEPS.AND.IDAM(1).EQ.-1) THEN
  595. XLAM1=0.D0
  596. IDAM(1)=0
  597. IDAM(2)=0
  598. IDAM(3)=0
  599. ENDIF
  600. IF(XLAM2.LE.RFEPS.AND.IDAM(2).EQ.-1) THEN
  601. XLAM2=0.D0
  602. IDAM(1)=0
  603. IDAM(2)=0
  604. IDAM(3)=0
  605. ENDIF
  606. IF(VA2.LT.RFSIG) GOTO 99998
  607. ID=ABS(IDAM(1))+ABS(IDAM(2))+ABS(IDAM(3))
  608. IF(ID.EQ.0) GOTO 100
  609. C
  610. C
  611. IF(ICHR.GT.0) GOTO 12121
  612. GOTO 99998
  613. 99997 DO 310 ITYP=1,3
  614. 310 SIG(ITYP)=SIG(ITYP)+DSIG(ITYP)
  615. SIGEL(1)=SIG(1)
  616. SIGEL(2)=SIG(2)
  617. IF(LETYP.EQ.6) THEN
  618. SIGEL(3)=W1(3)+W2(3)
  619. SIGEL(4)=SIG(3)
  620. ENDIF
  621. IF(LETYP.EQ.2.OR.LETYP.EQ.7) THEN
  622. SIGEL(3)=SIG(3)
  623. SIGEL(4)=W1(4)+W2(4)
  624. ENDIF
  625. SIGEL(5)=W1(5)+W2(5)
  626. SIGEL(6)=W1(6)+W2(6)
  627. DLAMBD(1)=XLAM1-XLAMBD(1)
  628. DLAMBD(2)=XLAM2-XLAMBD(2)
  629. DLAMBD(3)=XLAM3-XLAMBD(3)
  630. TENS(1)=DLAMBD(1)
  631. TENS(2)=DLAMBD(2)
  632. TENS(3)=0.D0
  633. CALL CHREP(TENS,EPT,-ANG)
  634. DO 320 ITYP=1,3
  635. EPPLTR(ITYP)=EPPLTR(ITYP)+EPT(ITYP)
  636. DLAMBD(ITYP+3)=EPPLDP(ITYP)
  637. 320 CONTINUE
  638. DO 330 ITYP=1,3
  639. DEFPLA(ITYP)=EPPLTR(ITYP)+EPPLDP(ITYP)
  640. 330 CONTINUE
  641. IF(LETYP.EQ.6) THEN
  642. DEFPLA(4)=DEFPLA(3)
  643. DEFPLA(3)=0.D0
  644. ENDIF
  645. IF(LETYP.EQ.2.OR.LETYP.EQ.7) DEFPLA(4)=0.D0
  646. DEFPLA(5)=0.D0
  647. DEFPLA(6)=0.D0
  648. XLAMBD(1)=XLAM1
  649. XLAMBD(2)=XLAM2
  650. XLAMBD(3)=XLAM3
  651. IF(IIMPI.EQ.9) THEN
  652. WRITE(IOIMP,10010) ITER
  653. 10010 FORMAT(1X,'ECBECP',3X,'NOMBRE DE CHANGEMENT DE BOITE',1X,
  654. 1 I3,/)
  655. WRITE(IOIMP,10004) IFISSU,ANG,BETA
  656. WRITE(IOIMP,10001) RT1,H1,XLAM1
  657. WRITE(IOIMP,10002) RT2,H2,XLAM2
  658. WRITE(IOIMP,10003) RDP,ADP,HDP,XLAM3
  659. WRITE(IOIMP,10005) (XLAMBD(I),I=1,6)
  660. WRITE(IOIMP,10006) (DLAMBD(I),I=1,6)
  661. WRITE(IOIMP,10009) (EPPLTR(I),I=1,3)
  662. 10009 FORMAT(1X,'ECBECP',3X,'EPPLTR',3(1X,1PE12.5),' GLOBAL',/)
  663. CALL CHREP(EPPLTR,EPT,ANG)
  664. WRITE(IOIMP,10099) (EPT(I),I=1,3)
  665. 10099 FORMAT(1X,'ECBECP',3X,'EPPLTR',3(1X,1PE12.5),' LOCAL',/)
  666. WRITE(IOIMP,10999) (EPPLDP(I),I=1,3)
  667. 10999 FORMAT(1X,'ECBECP',3X,'EPPLDP',3(1X,1PE12.5),' GLOBAL',/)
  668. CALL CHREP(EPPLDP,EPDP,ANG)
  669. WRITE(IOIMP,19999) (EPDP(I),I=1,3)
  670. 19999 FORMAT(1X,'ECBECP',3X,'EPPLDP',3(1X,1PE12.5),' LOCAL',/)
  671. WRITE(IOIMP,10007) (SIGEL(I),I=1,4)
  672. 10007 FORMAT(1X,'ECBECP',3X,'SIGEL ',4(1X,1PE12.5),/)
  673. CALL CHREP(SIG,SFG,ANG)
  674. WRITE(IOIMP,10097) (SFG(I),I=1,3)
  675. 10097 FORMAT(1X,'ECBECP',3X,'SIGEL ',3(1X,1PE12.5),' LOCAL',/)
  676. CALL CDP(SFG,ADP,RDP,VCDP)
  677. CALL CTRAF(SFG(1),RT1,VCTR1)
  678. CALL CTRAF(SFG(2),RT2,VCTR2)
  679. CALL CCOAF(SFG(1),XLAM1,VCCO1)
  680. CALL CCOAF(SFG(2),XLAM2,VCCO2)
  681. WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  682. 10008 FORMAT(1X,'ECBECP',3X,'CRIDRU',1X,1PE12.5,3X,'CRITR1',1X,
  683. 1 1PE12.5,3X,'CRITR2',1X,1PE12.5,/)
  684. WRITE(IOIMP,20008) VCCO1,VCCO2
  685. 20008 FORMAT(1X,'ECBECP',3X,'CRICO1',1X,
  686. 1 1PE12.5,3X,'CRICO2',1X,1PE12.5,/)
  687. ENDIF
  688. C
  689. RETURN
  690. END
  691.  
  692.  

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