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