Télécharger la plaquette Cast3M


fr en

Télécharger couple.eso

Retour à la liste

Numérotation des lignes : 

couple

  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