Télécharger couple.eso

Retour à la liste

Numérotation des lignes :

  1. C COUPLE SOURCE CB215821 17/11/30 21:15:45 9639
  2. SUBROUTINE COUPLE(ICAS,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  3. .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,YUNG,XNU,SIGEL,DSIGP,DLAMBD,
  4. .XLAMBD,ICOUP,ICRIT1,ICRIT2,SIGMA,DSIGMA,SIGMAT,XX,IDED,LMIC5,
  5. .ICRIME,ICRIMT,XLAMAX,PREC,RFSG,RFEP,RFPR,KERRE)
  6. C
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9.  
  10. -INC PPARAM
  11. -INC CCOPTIO
  12. C
  13. DIMENSION SIGEL(*),DSIGP(*),DLAMBD(*),XLAMBD(*)
  14. DIMENSION DF1(6),DF2(6),SIG(6),DSIG(6)
  15. DIMENSION SIGMA(6),DSIGMA(6),SIGMAT(6)
  16. C
  17. C IC1 INDICE DU CRITERE 1
  18. C IC2 INDICE DU CRITERE 2
  19. C DLAMBD(IC1) INCREMENT DLMBDA POUR LE CRITERE 1
  20. C DLAMBD(IC2) INCREMENT DLMBDA POUR LE CRITERE 2
  21. C DDLAM1 CORRECTION A DLAMBD(IC1) AU COURS DES ITERATIONS INTERNES
  22. C DDLAM2 CORRECTION A DLAMBD(IC2) AU COURS DES ITERATIONS INTERNES
  23. C SIG ETAT DE CONTRAINTES FINAL PROJETTE
  24. C SIGEL ETAT DE CONTRAINTES INITIAL
  25. C DSIGP INCREMENT DE CONTRAINTES A ECOULER
  26. C MAXITE NOMBRE MAXIMAL D'ITERATIONS INTERNES
  27. C PREC PRECISION POUR LA CONVERGENCE DES ITERATIONS INTERNES
  28. C
  29. MAXITE=15
  30. KOUPE=0
  31. IC1=0
  32. R1=0.D0
  33. R2=0.D0
  34. R3=0.D0
  35. C
  36. 20 DO 1 I=1,6
  37. SIGMAT(I)=SIGEL(I)+DSIGP(I)
  38. SIG(I)=SIGEL(I)
  39. SIGMA(I)=SIGEL(I)
  40. 1 CONTINUE
  41. C
  42. IF(LMIC5.EQ.1.AND.ICAS.GE.5.AND.ICAS.NE.8) GO TO 316
  43. C
  44. IF(IIMPI.EQ.9) WRITE(IOIMP,3001) (SIGEL(I),I=1,6)
  45. IF(IIMPI.EQ.9) WRITE(IOIMP,3002) (DSIGP(I),I=1,6)
  46. CALL BRILAM(ICAS,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  47. .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,YUNG,XNU,SIGEL,DSIGP,SIGMAT,
  48. .IC1,IC2,DGLAP1,DGLAP2,DGLAM1,DGLAM2,DGLA1,DGLA2,DL1,DL2,DI1,DI2,
  49. .KERRE)
  50. IF(IIMPI.EQ.9) WRITE(IOIMP,8000)ICAS,IC1,IC2
  51. C
  52. C INITIALISATIONS
  53. C
  54. ZEROP=0.D0
  55. ITER=0
  56. ICOUP=0
  57. ICRIME=0
  58. IBOU=6
  59. XXX=0.D0
  60. ICONCA=0
  61. VMELA0=VMELAS
  62. DPEL20=DPELA2
  63. POREL0=PORELA
  64. C
  65. C
  66. DLAM01=DLAMBD(IC1)
  67. DLAM02=DLAMBD(IC2)
  68. DLAMBD(IC1)=DGLA1
  69. DLAMBD(IC2)=DGLA2
  70. DDLAM1=DGLAP1
  71. DDLAM2=DGLAP2
  72. C
  73. C
  74. C CAS DE DECHARGE |||||||||||||||
  75. C
  76. C
  77. IF(ABS(DLAMBD(IC1)).LE.RFEP) DLAMBD(IC1)=0.D0
  78. IF(ABS(DLAMBD(IC2)).LE.RFEP) DLAMBD(IC2)=0.D0
  79. C
  80. IF(DLAMBD(IC1).GT.0.D0.AND.DLAMBD(IC2).GT.0.D0) GO TO 19
  81. IF(DLAMBD(IC1).GT.0.D0.OR.DLAMBD(IC2).GT.0.D0) GO TO 312
  82. IF(DLAMBD(IC1).EQ.0.D0.AND.DLAMBD(IC2).EQ.0.D0) GO TO 313
  83. WRITE(IOIMP,901) IC1,DLAMBD(IC1),IC2,DLAMBD(IC2)
  84. GO TO 314
  85. C
  86. 19 IF(IIMPI.EQ.9) WRITE(IOIMP,5000)ITER,DDLAM1,DDLAM2
  87. C
  88. C ON RENTRE DANS LE SCHEMA D'ITERATIONS INTERNES
  89. C ON VA CALCULER LA PREMIERE ESTIMATION DU DELTA LAMDA
  90. C
  91. ITER=1
  92. DLAMBD(IC1)=0.D0
  93. DLAMBD(IC2)=0.D0
  94. CALL DDFDS(IC1,ALFADV,ALFAD1,ALFAD2,YUNG,XNU,SIGMAT,SIGEL,DF1,
  95. .KERRE)
  96. CALL DDFDS(IC2,ALFADV,ALFAD1,ALFAD2,YUNG,XNU,SIGMAT,SIGEL,DF2,
  97. .KERRE)
  98. DO 2 I=1,6
  99. SIG(I)=SIG(I)-DF1(I)*DL1-DF2(I)*DL2
  100. 2 DSIG(I)=DSIGP(I)-DF1(I)*DGLAP1-DF2(I)*DGLAP2
  101. IF(IIMPI.EQ.9) WRITE(IOIMP,3002) (DSIGP(I),I=1,6)
  102. IF(IIMPI.EQ.9) WRITE(IOIMP,3003) (SIG(I),I=1,6)
  103. IF(IIMPI.EQ.9) WRITE(IOIMP,3004) (DSIG(I),I=1,6)
  104. C
  105. C ON TRIE ||||||||||||||||
  106. C
  107. IF(ICAS.GT.3) GO TO 555
  108. IF(ICRIMT.NE.0) GO TO 555
  109. C
  110. C SI ON EST DANS LE CAS ICAS =4 5 6 7 8 ,ON S'EN VA.
  111. C
  112. C
  113. C ITERATIONS INTERNES
  114. C
  115. C POUR ICAS= 1 , 2 , OU 3
  116. C C'EST LE CAS OU IL PEUT Y AVOIR UNE POSSIBILITE DE TRIPLAGE
  117. C
  118. C
  119. IC3=4-ICAS
  120. GO TO(1001,1002,1003),IC3
  121. WRITE(IOIMP,12) IC3
  122. KERRE=640
  123. RETURN
  124. C
  125. 1001 DXX=GAMPO(SIG,DSIG,PORELA)
  126. GO TO 1004
  127. 1002 DXX=GAMDP(SIG,DSIG,ALFADV,DPELAS,ICONCA,PREC,RFSG,RFEP,RFPR)
  128. GO TO 1004
  129. 1003 DXX=GAMVM(SIG,DSIG,VMELAS,PREC,RFSG,RFEP,RFPR)
  130. C
  131. 1004 CONTINUE
  132. C
  133. C SI LE CRITERE IC3 EST ATTEINT ET SI DXX < 0 , ON MET DXX = 0
  134. C
  135. DO 24 I=1,6
  136. SIGMAT(I)=SIG(I)+DSIG(I)
  137. 24 CONTINUE
  138. C
  139. CALL KRITER(IC3,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  140. .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZEROP,SIGMAT,FSIG,FC,KERRE)
  141. IF(IIMPI.EQ.9) WRITE(IOIMP,2004)
  142. .IC3,VMELAS,DPELAS,DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,FC
  143. C
  144. IF(DXX.LT.0.D0.AND.FC.GT.0.D0) DXX=0.D0
  145. IF(DXX.LT.0.D0.OR.DXX.GE.1.D0) DXX=1.D0
  146. C
  147. DO 3 I=1,6
  148. SIG(I)=SIG(I)+DSIG(I)*DXX
  149. 3 CONTINUE
  150. C
  151. C XXX REPRESENTE LES DXX CUMULES
  152. C
  153. XXX=DXX
  154. IF(IIMPI.EQ.9) WRITE(IOIMP,2000)XXX,DXX
  155. DDLAM1=DGLAP1*DXX+DL1
  156. DDLAM2=DGLAM2*DXX+DL2
  157. DLAMBD(IC1)=DDLAM1
  158. DLAMBD(IC2)=DDLAM2
  159. C
  160. C ON REPASSE DANS KRITER POUR REMETTRE A JOUR LES RAYONS DES CRITERES
  161. C
  162. 444 ITER=ITER+1
  163. CALL KRITER(IC1,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  164. . DPELA2,PORELA,PENTE1,PENTE2,PENTE3,DDLAM1,SIG,FSG,CR1,KERRE)
  165. CALL KRITER(IC2,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  166. . DPELA2,PORELA,PENTE1,PENTE2,PENTE3,DDLAM2,SIG,FSG,CR2,KERRE)
  167. C
  168. C ON ENTRE DANS BRILAM DONT LES SORTIES SONT:
  169. C DGLAP DGLAM DGLA DL DI||||||||
  170. C
  171. CALL BRILAM(ICAS,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  172. .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,YUNG,XNU,SIG,DSIGP,SIGMAT,
  173. .IC1,IC2,DGLAP1,DGLAP2,DGLAM1,DGLAM2,DGLA1,DGLA2,DL1,DL2,DI1,DI2,
  174. .KERRE)
  175. CALL DDFDS(IC1,ALFADV,ALFAD1,ALFAD2,YUNG,XNU,SIG,SIGMAT,DF1,
  176. .KERRE)
  177. CALL DDFDS(IC2,ALFADV,ALFAD1,ALFAD2,YUNG,XNU,SIG,SIGMAT,DF2,
  178. .KERRE)
  179. DO 4 I=1,IBOU
  180. DSIG(I)=DSIGP(I)-DF1(I)*DGLA1-DF2(I)*DGLA2
  181. SIG(I)=SIG(I)-DF1(I)*DI1-DF2(I)*DI2
  182. 4 SIGMAT(I)=SIG(I)+DSIG(I)
  183. CONTINUE
  184. IF(IIMPI.EQ.9) WRITE(IOIMP,3004) (DSIG(I),I=1,6)
  185. IF(IIMPI.EQ.9) WRITE(IOIMP,3003) (SIG(I),I=1,6)
  186. IF(IIMPI.EQ.9) WRITE(IOIMP,3005) (SIGMAT(I),I=1,6)
  187. C
  188. C ON CALCULE LA VALEUR DE DXX AVEC LA METHODE DE LINEARISATION
  189. C
  190. CALL KRITER(IC3,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  191. .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZEROP,SIGMAT,FSIG,FC,KERRE)
  192. IF(IIMPI.EQ.9) WRITE(IOIMP,2004)
  193. .IC3,VMELAS,DPELAS,DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,FC
  194. C
  195. DXX=1.D0
  196. IF(FC.GT.0.D0)
  197. .CALL GAMMAN(IC3,SIG,DSIG,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1
  198. .,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,DXX,
  199. .PREC,RFSG,RFEP,RFPR,KERRE)
  200. IF(DXX.LT.0.D0) DXX=0.D0
  201. XXX=XXX+DXX
  202. IF(XXX.LE.1.D0) GO TO 5
  203. DXX=DXX+1.D0-XXX
  204. XXX=1.D0
  205. 5 IF(IIMPI.EQ.9) WRITE(IOIMP,2000)XXX,DXX
  206. DO 6 I=1,6
  207. DSIG(I)=DSIG(I)*DXX
  208. 6 SIG(I)=SIG(I)+DSIG(I)
  209. DDLAM1=DGLA1*DXX+DI1
  210. DDLAM2=DGLA2*DXX+DI2
  211. IF(IIMPI.EQ.9) WRITE(IOIMP,2003)DDLAM1,DDLAM2
  212. DLAMBD(IC1)=DLAMBD(IC1)+DDLAM1
  213. DLAMBD(IC2)=DLAMBD(IC2)+DDLAM2
  214. C
  215. IF(ABS(DLAMBD(IC1)).LE.RFEP) DLAMBD(IC1)=0.D0
  216. IF(ABS(DLAMBD(IC2)).LE.RFEP) DLAMBD(IC2)=0.D0
  217. C
  218. IF(DLAMBD(IC1).GT.0.D0.AND.DLAMBD(IC2).GT.0.D0) GO TO 410
  219. IF(DLAMBD(IC1).GT.0.D0.OR.DLAMBD(IC2).GT.0.D0) GO TO 317
  220. IF(DLAMBD(IC1).EQ.0.D0.AND.DLAMBD(IC2).EQ.0.D0) GO TO 318
  221. WRITE(IOIMP,901) IC1,DLAMBD(IC1),IC2,DLAMBD(IC2)
  222. GO TO 314
  223. C
  224. C TESTS
  225. C
  226. 410 DETR1=DLAMBD(IC1)
  227. DETR2=DLAMBD(IC2)
  228. DETR1= MAX(DETR1,RFEP)
  229. DETR2= MAX(DETR2,RFEP)
  230. TEST1=ABS(DDLAM1)/DETR1
  231. TEST2=ABS(DDLAM2)/DETR2
  232. IF(TEST1.LT.PREC.AND.TEST2.LT.PREC) GO TO 411
  233. IF(ITER.LE.MAXITE) GO TO 444
  234. WRITE(IOIMP,900) IC1,TEST1,IC2,TEST2
  235. KERRE=640
  236. RETURN
  237. C
  238. C
  239. 411 IF(XXX.GT.1.D0) XXX=1.D0
  240. DELXXX=1.D0-XXX
  241. DO 442 I=1,6
  242. 442 DSIGP(I)=DSIGP(I)*DELXXX
  243. IF(DELXXX.LE.0.) GO TO 311
  244. C
  245. C IL Y A TRIPLAGE
  246. C
  247. ICOUP=3
  248. C
  249. CALL KRITER(IC1,ALFADV,ALFAD1,ALFAD2,VMELA0,DPELAS,DPELA1,
  250. .DPEL20,POREL0,PENTE1,PENTE2,PENTE3,DLAMBD(IC1),SIG,FSG,CR1,KERRE)
  251. CALL KRITER(IC2,ALFADV,ALFAD1,ALFAD2,VMELA0,DPELAS,DPELA1,
  252. .DPEL20,POREL0,PENTE1,PENTE2,PENTE3,DLAMBD(IC2),SIG,FSG,CR2,KERRE)
  253. C
  254. VMELAS=VMELA0
  255. DPELA2=DPEL20
  256. PORELA=POREL0
  257. C
  258. DLAMBD(IC1)=DLAMBD(IC1)+DLAM01
  259. DLAMBD(IC2)=DLAMBD(IC2)+DLAM02
  260. DO 9 I=1,5
  261. XLAMBD(I)=XLAMBD(I)+DLAMBD(I)
  262. DLAMBD(I)=0.D0
  263. 9 CONTINUE
  264. DO 412 I=1,IBOU
  265. SIGEL(I)=SIG(I)
  266. DSIGMA(I)=SIGEL(I)-SIGMA(I)
  267. SIGMAT(I)=SIGEL(I)
  268. 412 CONTINUE
  269. RETURN
  270. C
  271. C POUR ICAS= 4 , 5 , 6 , 7 OU 8
  272. C C'EST LE CAS ORDINAIRE|||| CE QUI SIGNIFIE QUE L'ON A UN
  273. C COUPLAGE SIMPLE SANS CALCUL DE DXX SAUF
  274. C
  275. C DANS LES CAS OU IL Y A LE CRITERE (5)
  276. C
  277. C ITERATIONS INTERNES.
  278. C
  279. C
  280. 555 DXX=0.D0
  281. IF(ICAS.NE.5.OR.ICAS.NE.6.OR.ICAS.NE.7) GO TO 551
  282. IF(ABS(DDLAM2).LE.0.D0.AND.ITER.EQ.1) GO TO 33
  283. IF(ABS(DDLAM2).LE.0.D0) GO TO 34
  284. DDLMAX=XLAMAX-XLAMBD(5)-DLAMBD(5)-DLAM02
  285. C
  286. C ON ETUDIE LE CAS DU CRITERE (5) DONT ON VEUT LIMITER
  287. C L'ECROUISSAGE NEGATIF.ON DETERMINE UNE VALEUR DE LAMDA
  288. C MAXIMUM.
  289. C
  290. TSTDDL=DDLMAX-DDLAM2
  291. IF(TSTDDL.GE.0.D0.AND.ITER.EQ.1) GO TO 551
  292. IF(TSTDDL.GT.0.D0) DXX=1.D0-XXX
  293. IF(TSTDDL.LT.0.D0) DXX=(DDLMAX-DL2)/DDLAM2
  294. C
  295. 34 XXX=XXX+DXX
  296. IF(XXX.LE.1.D0) GO TO 7
  297. DXX=DXX+1.D0-XXX
  298. XXX=1.D0
  299. GO TO 7
  300. C
  301. 551 XXX=1.D0
  302. IF(ITER.EQ.1) DXX=1.D0
  303. C
  304. 7 DDLAM1=DDLAM1*DXX+DL1
  305. DDLAM2=DDLAM2*DXX+DL2
  306. DLAMBD(IC1)=DDLAM1+DLAMBD(IC1)
  307. DLAMBD(IC2)=DDLAM2+DLAMBD(IC2)
  308. DO 17 I=1,6
  309. 17 SIG(I)=SIG(I)+DSIG(I)*DXX
  310. C
  311. C ON PASSE DANS KRITER POUR METTRE LES RAYONS A JOUR
  312. C
  313. CALL KRITER(IC1,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  314. .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,DDLAM1,SIG,FSG,CR1,KERRE)
  315. CALL KRITER(IC2,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  316. .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,DDLAM2,SIG,FSG,CR2,KERRE)
  317. IF(ITER.EQ.1) GO TO 37
  318. C
  319. IF(ABS(DLAMBD(IC1)).LE.RFEP) DLAMBD(IC1)=0.D0
  320. IF(ABS(DLAMBD(IC2)).LE.RFEP) DLAMBD(IC2)=0.D0
  321. C
  322. IF(DLAMBD(IC1).GT.0.D0.AND.DLAMBD(IC2).GT.0.D0) GO TO 510
  323. IF(DLAMBD(IC1).GT.0.D0.OR.DLAMBD(IC2).GT.0.D0) GO TO 312
  324. IF(DLAMBD(IC1).EQ.0.D0.AND.DLAMBD(IC2).EQ.0.D0) GO TO 313
  325. WRITE(IOIMP,901) IC1,DLAMBD(IC1),IC2,DLAMBD(IC2)
  326. GO TO 314
  327. C
  328. C TESTS
  329. C
  330. 510 DETR1=DLAMBD(IC1)
  331. DETR2=DLAMBD(IC2)
  332. DETR1= MAX(DETR1,RFEP)
  333. DETR2= MAX(DETR2,RFEP)
  334. TEST1=ABS(DDLAM1)/DETR1
  335. TEST2=ABS(DDLAM2)/DETR2
  336. IF(TEST1.LT.PREC.AND.TEST2.LT.PREC) GO TO 511
  337. IF(ITER.LE.MAXITE) GO TO 37
  338. WRITE(IOIMP,900) IC1,TEST1,IC2,TEST2
  339. KERRE=640
  340. RETURN
  341. C
  342. C ITERATIONS INTERNES
  343. C
  344. 37 ITER=ITER+1
  345. CALL BRILAM(ICAS,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  346. .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,YUNG,XNU,SIG,DSIGP,
  347. .SIGMAT,IC1,IC2,DGLAP1,DGLAP2,DGLAM1,DGLAM2,DGLA1,DGLA2,
  348. .DL1,DL2,DI1,DI2,KERRE)
  349. CALL DDFDS(IC1,ALFADV,ALFAD1,ALFAD2,YUNG,XNU,SIG,SIGMAT,DF1,
  350. .KERRE)
  351. CALL DDFDS(IC2,ALFADV,ALFAD1,ALFAD2,YUNG,XNU,SIG,SIGMAT,DF2,
  352. .KERRE)
  353. DO 32 I=1,6
  354. DSIG(I)=DSIGP(I)-DF1(I)*DGLA1-DF2(I)*DGLA2
  355. SIG(I)=SIG(I)-DF1(I)*DI1-DF2(I)*DI2
  356. 32 SIGMAT(I)=SIG(I)+DSIG(I)
  357. C
  358. DL1=DI1
  359. DL2=DI2
  360. DDLAM1=DGLA1
  361. DDLAM2=DGLA2
  362. GO TO 555
  363. C
  364. 511 IF(XXX.GT.1.D0) XXX=1.D0
  365. DELXXX=1.D0-XXX
  366. DO 35 I=1,6
  367. 35 DSIGP(I)=DSIGP(I)*DELXXX
  368. IF(DELXXX.LE.0.D0) GO TO 311
  369. ICOUP=2
  370. ICRIT1=IC1
  371. ICRIT2=IC2
  372. ICRIME=5
  373. XX=0.D0
  374. GO TO 39
  375. C
  376. C IL Y A COUPLAGE MAIS IL RESTE ENCORE DE L INCREMENT DE CONTRAINTES
  377. C
  378. 311 ICOUP=2
  379. ICRIT1=IC1
  380. ICRIT2=IC2
  381. ICRIME=0
  382. DO 36 I=1,6
  383. DSIGP(I)=0.D0
  384. 36 CONTINUE
  385. C
  386. 39 CALL KRITER(IC1,ALFADV,ALFAD1,ALFAD2,VMELA0,DPELAS,DPELA1,
  387. .DPEL20,POREL0,PENTE1,PENTE2,PENTE3,DLAMBD(IC1),SIG,FSG,CR1,KERRE)
  388. CALL KRITER(IC2,ALFADV,ALFAD1,ALFAD2,VMELA0,DPELAS,DPELA1,
  389. .DPEL20,POREL0,PENTE1,PENTE2,PENTE3,DLAMBD(IC2),SIG,FSG,CR2,KERRE)
  390. C
  391. VMELAS=VMELA0
  392. DPELA2=DPEL20
  393. PORELA=POREL0
  394. C
  395. DLAMBD(IC1)=DLAMBD(IC1)+DLAM01
  396. DLAMBD(IC2)=DLAMBD(IC2)+DLAM02
  397. DO 8 I=1,5
  398. XLAMBD(I)=XLAMBD(I)+DLAMBD(I)
  399. DLAMBD(I)=0.D0
  400. 8 CONTINUE
  401. DO 18 I=1,IBOU
  402. SIGEL(I)=SIG(I)
  403. SIGMAT(I)=SIGEL(I)
  404. DSIGMA(I)=SIGEL(I)-SIGMA(I)
  405. 18 CONTINUE
  406. RETURN
  407. C
  408. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  409. C
  410. C IL N Y A PAS DE COUPLAGE
  411. C
  412. C CAS DE DECHARGE
  413. C
  414. 33 DLAMBD(IC1)=DDLAM1
  415. DLAMBD(IC2)=DDLAM2
  416. C
  417. 312 ICOUP=1
  418. ICRIT1=IC1
  419. ICRIME=IC2
  420. IF(DLAMBD(IC1).LE.0.D0) ICRIT1=IC2
  421. IF(ICRIT1.EQ.IC2) ICRIME=IC1
  422. XX=0.D0
  423. DLAMBD(IC1)=DLAM01
  424. DLAMBD(IC2)=DLAM02
  425. VMELAS=VMELA0
  426. DPELA2=DPEL20
  427. PORELA=POREL0
  428. IF(ICAS.EQ.3.AND.KOUPE.EQ.1) ICRIMT=4
  429. IF(ICAS.EQ.7.AND.KOUPE.EQ.1) ICRIMT=2
  430. IF(ICAS.NE.4) RETURN
  431. C
  432. C CAS DE COUPLAGE ENTRE LE DRUCKER DUCTILE ET LE DRUKER FRAGILE FIXE
  433. C
  434. IF(ICRIT1.EQ.2) GO TO 21
  435. IF(ICRIT1.EQ.4) GO TO 22
  436. WRITE(IOIMP,13) ICAS,ICRIT1,ICRIME
  437. KERRE=640
  438. RETURN
  439. C
  440. 21 IF(IDED.EQ.1.OR.IDED.EQ.3) RETURN
  441. ICAS=3
  442. KOUPE=1
  443. GO TO 20
  444. C
  445. 22 IF(IDED.EQ.2.OR.IDED.EQ.3) RETURN
  446. ICAS=7
  447. KOUPE=1
  448. GO TO 20
  449. C
  450. C IL N Y A PAS D ENDOMMAGEMENT SELON COUPLE
  451. C MAIS PEUT ETRE IL Y EN A SELON TRIPLE
  452. C
  453. 317 IF(ABS(XXX).GT.RFPR) GO TO 312
  454. IF(ICRIME.EQ.1.OR.ICRIME.EQ.2.OR.ICRIME.EQ.3) GO TO 312
  455. IF(ICRIMT.EQ.1.OR.ICRIMT.EQ.2.OR.ICRIMT.EQ.3) GO TO 312
  456. GO TO 319
  457. C
  458. 318 IF(ABS(XXX).GT.RFPR) GO TO 313
  459. IF(ICRIME.EQ.1.OR.ICRIME.EQ.2.OR.ICRIME.EQ.3) GO TO 313
  460. IF(ICRIMT.EQ.1.OR.ICRIMT.EQ.2.OR.ICRIMT.EQ.3) GO TO 313
  461. C
  462. 319 ICOUP=3
  463. XX=0.D0
  464. DLAMBD(IC1)=DLAM01
  465. DLAMBD(IC2)=DLAM02
  466. VMELAS=VMELA0
  467. DPELA2=DPEL20
  468. PORELA=POREL0
  469. RETURN
  470. C
  471. C IL N Y A PAS D ENDOMMAGEMENT SELON COUPLE
  472. C
  473. 313 ICOUP=0
  474. XX=0.D0
  475. DLAMBD(IC1)=DLAM01
  476. DLAMBD(IC2)=DLAM02
  477. VMELAS=VMELA0
  478. DPELA2=DPEL20
  479. PORELA=POREL0
  480. RETURN
  481. C
  482. C DLAMBD1 ET DLAMBD2 SONT NEGATIFS
  483. C
  484. 314 ICOUP=1
  485. ICRIME=IC1
  486. ICRIMT=IC2
  487. IF(ICRIT1.EQ.0) GO TO 315
  488. XX=0.D0
  489. DLAMBD(IC1)=DLAM01
  490. DLAMBD(IC2)=DLAM02
  491. VMELAS=VMELA0
  492. DPELA2=DPEL20
  493. PORELA=POREL0
  494. RETURN
  495. C
  496. C CAS DE DECHARGE DANS COUPLE
  497. C
  498. 315 DO 38 I=1,6
  499. DSIGMA(I)=DSIGP(I)
  500. SIGMAT(I)=SIGMA(I)+DSIGMA(I)
  501. DSIGP(I)=0.D0
  502. 38 CONTINUE
  503. XX=0.D0
  504. DLAMBD(IC1)=DLAM01
  505. DLAMBD(IC2)=DLAM02
  506. VMELAS=VMELA0
  507. DPELA2=DPEL20
  508. PORELA=POREL0
  509. RETURN
  510. C
  511. C CAS DE LMIC5=1LE CRITERE DE DRUCKER FRAGILE ECROUISSABLE EST
  512. C COMPLETEMENT ENDOMMAGE . IL N Y A PAS DE COUPLAGE
  513. C
  514. 316 ICOUP=1
  515. ICRIT1=IC1
  516. ICRIME=5
  517. XX=0.D0
  518. C
  519. 12 FORMAT(1X,'ERREUR DANS COUPLE DANS LA VALEUR DE IC3 =',I4)
  520. 13 FORMAT(1X,'ERREUR DANS COUPLE ',/,
  521. . 1X,'ICAS =',I4,1X,'ICRIT1=',I4,1X,'ICRIME=',I4)
  522. C
  523. 900 FORMAT(1X,'ERREUR DANS COUPLE - NON CONVERGENCE',/,
  524. . 1X,'ICRIT1=',I2,1X,'TEST1 =',1PD12.5,
  525. . 1X,'ICRIT2=',I2,1X,'TEST2 =',1PD12.5)
  526. 901 FORMAT(1X,'ERREUR DANS COUPLE',/,
  527. . 1X,'DLAMBD(',I1,')=',1PD12.5,
  528. . 1X,'DLAMBD(',I1,')=',1PD12.5)
  529. 8000 FORMAT(1X,'DANS COUPLE ICAS=',I2,1X,'IC1=',I2,1X,'IC2=',I2)
  530. 5000 FORMAT(1X,'ITER =',I2,1X,'DDLAM1=',1PD12.5,1X,'DDLAM2=',1PD12.5)
  531. 2000 FORMAT(1X,'XXX =',1PD12.5,1X,'DXX =',1PD12.5)
  532. 2004 FORMAT(1X,'IC3=',I2,1X,'VMELAS=',1PD12.5,1X,'DPELAS=',1PD12.5,/,
  533. . 1X,'DPELA1=',1PD12.5,1X,'DPELA2=',1PD12.5,
  534. . 1X,'PORELA=',1PD12.5,/,
  535. . 1X,'R1 =',1PD12.5,1X,'R2 =',1PD12.5,
  536. . 1X,'R3 =',1PD12.5,/,
  537. . 1X,'FSIG =',1PD12.5,1X,'FC =',1PD12.5)
  538. 2003 FORMAT(1X,'DDLAM1=',1PD12.5,1X,'DDLAM2=',1PD12.5)
  539. 3001 FORMAT(1X,'SIGEL =',6(1X,1PD12.5))
  540. 3002 FORMAT(1X,'DSIGP =',6(1X,1PD12.5))
  541. 3003 FORMAT(1X,'SIG =',6(1X,1PD12.5))
  542. 3004 FORMAT(1X,'DSIG =',6(1X,1PD12.5))
  543. 3005 FORMAT(1X,'SIGMAT=',6(1X,1PD12.5))
  544. C
  545. RETURN
  546. END
  547.  
  548.  
  549.  
  550.  
  551.  

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