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