Télécharger couple.eso

Retour à la liste

Numérotation des lignes :

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

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