1 : C DAMAGE SOURCE CHAT 05/01/12 22:36:13 5004 2 : SUBROUTINE DAMAGE(ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,DPELA2 3 : .,PORELA,R1,R2,R3,PENTE1,PENTE2,PENTE3,XLAMBD,SIGMA,DSIGMA,STOT, 4 : .SIGEL,TETAQ,YUNG,XNU,XLAMER,XLAMAX,DP2MIN, 5 : .PREC,RFSG,RFEP,RFPR,ITRAC,IDED,IDAM,KERRE) 6 : C 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8(A-H,O-Z) 9 : -INC CCOPTIO 10 : C 11 : DIMENSION SIGMA(*),DSIGMA(*),STOT(*),SIGEL(*),XLAMBD(*) 12 : DIMENSION SIGMAT(6),DSIGP(6) 13 : DIMENSION DELSIG(6),DDSIGP(6),DSIGEL(6),DSIGPR(6),DDF(6),DEPSP(6) 14 : DIMENSION SIS(6),SIGCRI(6),SIDEMI(6) 15 : DIMENSION DLAMBD(5),XLAMBO(5),CRI(5) 16 : C 17 : C CETTE ROUTINE GERE LES ITERATIONS INTERNES 18 : C ENTREE SIGMA AU DEBUT DU PAS 19 : C DSIGMA INCREMENT CALCULE ELASTIQUEMENT 20 : C STOT = SIGMA + DSIGMA 21 : C SIGMAT=STOT 22 : C LES CARACTERISTIQUES DU MODELE (ALFADV ... PENTE3) 23 : C LES ENDOMMAGEMENTS XLAMBD (5) 24 : C IDED = 0 AU DEPART 25 : C 1 POUR CISAILLEMENT DUCTILE 26 : C 2 POUR CISAILLEMENT FRAGILE 27 : C 3 POUR LES DEUX PRECEDENTS 28 : C IIMPI INDICE POUR LES IMPRESSIONS = 0 (PAS D IMPRESSIONS) 29 : C = 9 (ON IMPRIME) 30 : C SIGEL CONTRAINTES SUR CRITERE 31 : C EN SORTIE C EST LA SOLUTION PROJETTEE 32 : C DSIGP PARTIE PLASTIQUE DE L INCREMENT 33 : C XLAMER LAMBDA DE BUTEE POUR LE CISAILLEMENT FRAGILE ECROUISS. 34 : C SUR LA TRACTION 35 : C XLAMAX LAMBDA DE BUTEE POUR LE CISAILLEMENT FRAGILE ECROUISS. 36 : C SUR LE CISAILLEMENT FRAGILE NON ECROUISS. 37 : C IDAM INDICE D ENDOMMAGEMENT 38 : C = 1 LE PAS EST ELASTIQUE 39 : C > 1 NOMBRE DE FOIS -1 OU L ON ENDOMMAGE DANS 40 : C L ITERATION INTERNE 41 : C ICRIT1 INDICE DU 1-ER CRITERE ENDOMMAGE 42 : C ICRIT2 INDICE DU 2-EME CRITERE SI ICOUP = 2 (CAS DE COUPLAGE) 43 : C ITRI INDICE DU TRIAGE 44 : C ITRI=0 (CALCUL POUR TROUVER LA PREMIERE SURFACE ENDOMMAGEE) 45 : C ITRI=1 (CALCUL POUR TROUVER LA PREMIERE ESTIMATION DE L ECOULEMENT) 46 : C ITRI=2 (CALCUL POUR TROUVER LA CORRECTION DE DELTA LAMBDA) 47 : C 48 : IF(IIMPI.EQ.9) 49 : .WRITE(IOIMP,9999) ALFADV,ALFAD1,ALFAD2,VMELAS, 50 : .DPELAS,DPELA1,DPELA2,PORELA,R1,R2,R3,PENTE1,PENTE2,PENTE3, 51 : .(XLAMBD(I),I=1,5),(SIGMA(J),J=1,6),(DSIGMA(K),K=1,6), 52 : .(STOT(L),L=1,6),(SIGEL(M),M=1,6), 53 : .TETAQ,XLAMER,XLAMAX,PREC,RFSG,RFEP,RFPR,IDED 54 : C 55 : C INITIALISATIONS 56 : C 57 : VMELA0=VMELAS 58 : DPEL20=DPELA2 59 : POREL0=PORELA 60 : R01=R1 61 : R02=R2 62 : R03=R3 63 : IDAM=1 64 : ICOUP=1 65 : IBAB=0 66 : ICRIT1=0 67 : ICRIT2=0 68 : JCRIT2=0 69 : ICRIME=0 70 : ICRIMT=0 71 : ITRI=0 72 : IC5=0 73 : ITERA=0 74 : ITS=0 75 : ICTD=0 76 : KASTR=1 77 : XLMDF=(XLAMER-XLAMBD(5))*2.D0/(XLAMER+XLAMBD(5)) 78 : IF(XLMDF.LE.PREC) KASTR=2 79 : XX=0.D0 80 : DPLAM=0.D0 81 : DGLAMP=0.D0 82 : DO 10 III=1,6 83 : SIS(III)=0.D0 84 : DELSIG(III)=0.D0 85 : 10 CONTINUE 86 : DO 20 III=1,5 87 : XLAMBO(III)=XLAMBD(III) 88 : DLAMBD(III)=0.D0 89 : 20 CONTINUE 90 : LMIC5=0 91 : XLMDF=(XLAMAX-XLAMBD(5))*2.D0/(XLAMAX+XLAMBD(5)) 92 : IF(XLMDF.LE.PREC)LMIC5=1 93 : C 94 : C METTRE A JOUR LES VALEURS DES LIMITES ELASTIQUES DES CRITERES 95 : C 96 : VMELAS=VMELAS+PENTE1*XLAMBD(3) 97 : DPELA2=DPELA2+PENTE2*XLAMBD(5) 98 : PORELA=PORELA+PENTE3*XLAMBD(1) 99 : C 100 : DO 30 III=1,6 101 : 30 SIGMAT(III)=STOT(III) 102 : C 102 : 160 CALL TRIAGE(ITRI,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, 103 : .DPELA2,PORELA,R1,R2,R3,SIGMA,DSIGMA,SIGMAT,SIGEL,DSIGP,TETAQ,IDED, 104 : .ICAS,IDAM,ITRAC,KOUPLE,IMIN,JMIN,GAMIN,ICRIT1,KASTR,DP2MIN,DPLAM, 105 : .DPLAM,PENTE1,PENTE2,CC,SS,CS,ICRIME,ICRIMT,ITETA,IRZ,LMIC5, 106 : .PREC,RFSG,RFEP,RFPR,KERRE) 107 : C 108 : IF(IDAM.NE.1) GO TO 31 109 : DO 32 III=1,6 110 : SIGCRI(III)=SIGEL(III) 111 : 32 CONTINUE 112 : C 113 : 31 IF(IMIN.EQ.0) GO TO 40 114 : IF(IMIN.EQ.6) GO TO 50 115 : IF(KOUPLE.EQ.2) GO TO 60 116 : IF(KOUPLE.EQ.3) GO TO 152 117 : ICRIT1=IMIN 118 : C 119 : C LA PREMIERE ESTIMATION DE DELTA LAMBD ITRI=1 120 : C 121 : 170 ITERA=1 122 : IF(IIMPI.EQ.9) WRITE(IOIMP,5007) ITERA 123 : ITRI=1 123 : CALL KRITER(ICRIT1,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, 124 : .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,DPLAM,SIGEL,FSIG,FCRIT,KERRE) 125 : IF(IIMPI.EQ.9) 126 : .WRITE(IOIMP,5001) ICRIT1,ICRIME,ICRIMT,VMELAS, 127 : .DPELAS,DPELA1,DPELA2,PORELA,DPLAM,FSIG,FCRIT, 128 : .(SIGEL(I),I=1,6),(DSIGP(J),J=1,6) 129 : C 130 : C ON CALCUL LA VALEUR DE SIDEMI =(SIGEL + 0.5 DE DSIGP)CAR ON FAIT 131 : C LA LINEARISATION DU SYSTEME AU VOISINAGE DE CETTE VALEUR 132 : C SOLUTIN RETENUE PARCE QU'ELLE EST VALABLE QUELQUE SOIT LA 133 : C VALEUR DE X ( L'ESTIMATION DE LA QUANTITE DE DSIGP A ECOULER ) 134 : C PETITE= ON EST PROCHE DE LA SURFACE DE CHARGE DU 2EME CRITERE 135 : C GRANDE= ON EST LOIN DE LA SURFACE DE CHARGE DU 2EME CRITERE 136 : C 137 : DO 34 II=1,6 138 : SIDEMI(II)=SIGEL(II)+0.5D0*DSIGP(II) 139 : 34 CONTINUE 140 : C 140 : CALL CRILAM(ICRIT1,SIDEMI,SIGEL,DSIGP,ALFADV,ALFAD1,ALFAD2,VMELAS, 141 : .DPELAS,DPELA1,DPELA2,PORELA,PENTE1,PENTE2,PENTE3,YUNG,XNU, 142 : .DGLAMP,DGLAMM,DGLAM,DL,DI,ISOMET,KERRE) 143 : IF(IIMPI.EQ.9) 144 : .WRITE(IOIMP,5002) ICRIT1,DGLAMP,DGLAMM,DGLAM,DL,ITERA 145 : C 146 : C TEST POUR LES DECHARGES 147 : C 148 : IF(ISOMET.EQ.1) GO TO 13 149 : IF(DGLAM.GE.0.D0) GO TO 11 150 : GO TO 12 151 : 13 IF(ICRIT1.EQ.4.OR.ICRIT1.EQ.5)GO TO 14 152 : WRITE(IOIMP,1006) ICRIT1 153 : KERRE=640 154 : RETURN 155 : C 156 : 14 ALFAN1=-0.5D0/ALFAD1 157 : ALFAN2=-0.5D0/ALFAD2 158 : DPELN1=DPELA1*ALFAN1/ALFAD1 159 : DPELN2=DPELA2*ALFAN2/ALFAD2 160 : UPNUSE=(1.D0+XNU)/YUNG 161 : UMDNSE=(1.D0-2.D0*XNU)/YUNG 162 : SISDF1=DPELA1/(3.D0*ALFAD1) 163 : CONST1=UMDNSE*DPELA2/(3.D0*ALFAD2) 164 : CONST2=UMDNSE*PENTE2/(3.D0*ALFAD2) 165 : CONDP4=3.D0*(ALFAD1*ALFAD1+0.5D0) 166 : CONDP5=3.D0*(ALFAD2*ALFAD2+0.5D0) 167 : C 167 : CALL KRITER(ICRIT1,ALFADV,ALFAN1,ALFAN2,VMELAS,DPELAS,DPELN1, 168 : .DPELN2,PORELA,PENTE1,PENTE2,PENTE3,DPLAM,SIGMAT,FSIG,FCRIT,KERRE) 169 : IF(FCRIT.GT.0.D0) GO TO 11 170 : C 171 : C CAS OU ON SORT PAR LE SOMMET DU CONE ET SIGMA TOTAL EST A L INTERIEUR 172 : C DU CONE DES NORMALES :DANS CE CAS LA SOLUTION C EST DE PROGETER SUR LE 173 : C SOMMET ET PUIS DE CALCULER LA VALEUR DE DELTA LAMBDA 174 : C 175 : DO 15 I=1,6 176 : SIGMAT(I)= SIGEL(I)+DSIGP(I) 177 : SIGMA(I)=SIGEL(I) 178 : SIGEL(I)=0.D0 179 : 15 CONTINUE 180 : IF(LMIC5.EQ.1) GO TO 16 181 : IF(ICRIT1.EQ.4) GO TO 16 182 : C 183 : C CAS DU CRITERE DE DRUCKER ECROUSSABLE (5) 184 : C 185 : C LE PROBLEME C EST DE TROUVER SIGMA SOLUTION (SIGEL) QUI DEPEND DE 186 : C DELTA LAMBDA INCONNUE AU DEPART CE QUI REVIENT A RESOUDRE UN EQUATION 187 : C DE DEUXIEME DEGRET DE DELTA LAMBDA DONT LES CONSTANTS SONT: 188 : C AA,BB,CC ( AA L2 + BB L + CC = 0 ) 189 : C 190 : CC1=(SIGMAT(1)-XNU*(SIGMAT(2)+SIGMAT(3)))/YUNG-CONST1 191 : CC2=(SIGMAT(2)-XNU*(SIGMAT(3)+SIGMAT(1)))/YUNG-CONST1 192 : CC3=(SIGMAT(3)-XNU*(SIGMAT(1)+SIGMAT(2)))/YUNG-CONST1 193 : CC4=UPNUSE*SIGMAT(4) 194 : CC5=UPNUSE*SIGMAT(5) 195 : CC6=UPNUSE*SIGMAT(6) 196 : CC=CC1*CC1+CC2*CC2+CC3*CC3+(CC4*CC4+CC5*CC5+CC6*CC6)*2.D0 197 : BB=(CC1+CC2+CC3)*CONST2*2.D0 198 : AA=3.D0*CONST2*CONST2-CONDP5 199 : C 200 : C RESOLUTION DE L EQUATION 201 : C 202 : DELTA=BB*BB-4.D0*AA*CC 203 : VRF=MAX(ABS(BB),RFPR) 204 : RFRF=VRF*VRF*PREC*PREC 205 : IF(ABS(DELTA).LE.RFRF.AND.DELTA.LE.0.D0) DELTA=0.D0 206 : IF(DELTA.LT.0.D0) GO TO 12 207 : RADEL=SQRT(DELTA) 208 : DLAM1=(-BB+RADEL)/(2.D0*CC) 209 : DLAM2=(-BB-RADEL)/(2.D0*CC) 210 : DLAM5=MAX(DLAM1,DLAM2) 211 : IF(ABS(DLAM5).LE.RFEP*PREC)DLAM5=0.D0 212 : IF(DLAM5.LT.0.D0) GO TO 12 213 : DLAMX=XLAMAX-XLAMBD(5)-DLAMBD(5) 214 : IF(DLAM5.LE.DLAMX) GO TO 17 215 : LMIC5=1 216 : KASTR=2 217 : DLAM5=DLAMX 218 : 17 SISDF2=(DPELA2+PENTE2*DLAM5)/(3.D0*ALFAD2) 219 : SIGEL(1)=SISDF2 220 : SIGEL(2)=SISDF2 221 : SIGEL(3)=SISDF2 222 : CONST3=SISDF2*UMDNSE 223 : DLAMBD(5)=DLAMBD(5)+DLAM5 224 : IF(LMIC5.EQ.0) GO TO 130 225 : C 226 : C CAS OU DELTA LAMBDA CALCULE EST PLUS GRAND QUE DLAMX DANS CE CAS LA ON 227 : C AURA UNE QUANTITE DE DELTA SIGMA A ECOULER SUR LE CRITERE DE DRUCKER 228 : C FIXE (4),POUR CELA CONNESSANT LA VALEUR DE DELTA LAMBDA QUI EST EGALE 229 : C A LA VALEUR DE DLAMX ON CALCUL LA PROPORTION DE DELTA SIGMA TOTAL DEJA 230 : C UTILISEE POUR L ECOULEMENT CORRESPONDANT A LA VALEUR DE DLAMX SUR LE 231 : C CRITERE DE DRUCKER ECROUISSABLE (5) CE QUI NOUS RAMENE A RESOUDRE UNE 232 : C EQUATION DE SECONDE DEGRE 233 : C 234 : CC1=(SIGMA(1)-XNU*(SIGMA(2)+SIGMA(3)))/YUNG-CONST3 235 : CC2=(SIGMA(2)-XNU*(SIGMA(3)+SIGMA(1)))/YUNG-CONST3 236 : CC3=(SIGMA(3)-XNU*(SIGMA(1)+SIGMA(2)))/YUNG-CONST3 237 : CC4=UPNUSE*SIGMA(4) 238 : CC5=UPNUSE*SIGMA(5) 239 : CC6=UPNUSE*SIGMA(6) 240 : CC=CC1*CC1+CC2*CC2+CC3*CC3+(CC4*CC4+CC5*CC5+CC6*CC6)*2.D0 241 : CC=CC-DLAMX*DLAMX*CONDP5 242 : BB1=(DSIGP(1)-XNU*(DSIGP(2)+DSIGP(3)))/YUNG 243 : BB2=(DSIGP(2)-XNU*(DSIGP(3)+DSIGP(1)))/YUNG 244 : BB3=(DSIGP(3)-XNU*(DSIGP(1)+DSIGP(2)))/YUNG 245 : BB4=UPNUSE*DSIGP(4) 246 : BB5=UPNUSE*DSIGP(5) 247 : BB6=UPNUSE*DSIGP(6) 248 : BB=2.D0*(CC1*BB1+CC2*BB2+CC3*BB3+(CC4*BB4+CC5*BB5+CC6*BB6)*2.D0) 249 : AA=BB1*BB1+BB2*BB2+BB3*BB3+(BB4*BB4+BB5*BB5+BB6*BB6)*2.D0 250 : C 251 : C RESOLUTION DE L EQUATION 252 : C 253 : DELTA=BB*BB-4.D0*AA*CC 254 : VRF=MAX(ABS(BB),RFSG) 255 : RFRF=VRF*VRF*PREC*PREC 256 : IF(ABS(DELTA).LE.RFRF.AND.DELTA.LE.0.D0) DELTA=0.D0 257 : IF(DELTA.LT.0.D0) GO TO 130 258 : RADEL=SQRT(DELTA) 259 : DELX1=(-BB+RADEL)/(2.D0*CC) 260 : IF(ABS(DELX1).LE.RFEP*PREC)DELX1=0.D0 261 : IF(DELX1.LT.0.D0.OR.DELX1.GT.1.D0)DELX1=-1.D0 262 : DELX2=(-BB-RADEL)/(2.D0*CC) 263 : IF(ABS(DELX2).LE.RFEP*PREC)DELX2=0.D0 264 : IF(DELX2.LT.0.D0.OR.DELX2.GT.1.D0)DELX2=-2.D0 265 : DELX=MAX(DELX1,DELX2) 266 : IF(DELX.LT.0.D0.OR.DELX.EQ.1.D0) GO TO 130 267 : UMDELX=1.D0-DELX 268 : DO 18 I=1,6 269 : DSIGP(I)=DSIGP(I)*UMDELX 270 : SIGMAT(I)=SIGEL(I)+DSIGP(I) 271 : 18 CONTINUE 272 : C 273 : C CAS DU CRITERE DE DRUCKER FIXE (4) 274 : C 275 : 16 SIGEL(1)=SISDF1 276 : SIGEL(2)=SISDF1 277 : SIGEL(3)=SISDF1 278 : DO 19 I=1,6 279 : DSIGPR(I)=SIGMAT(I)-SIGEL(I) 280 : DEPSP(I)=UPNUSE*DSIGPR(I) 281 : 19 CONTINUE 282 : DPS=XNU*(DSIGPR(1)+DSIGPR(2)+DSIGPR(3))/YUNG 283 : DEPSP(1)=DEPSP(1)-DPS 284 : DEPSP(2)=DEPSP(2)-DPS 285 : DEPSP(3)=DEPSP(3)-DPS 286 : AA4=DEPSP(1)*DEPSP(1)+DEPSP(2)*DEPSP(2)+DEPSP(3)*DEPSP(3) 287 : BB4=2.D0*(DEPSP(4)*DEPSP(4)+DEPSP(5)*DEPSP(5)+DEPSP(6)*DEPSP(6)) 288 : CC4=(AA4+BB4)/CONDP4 289 : IF(ABS(CC4).LE.RFEP*RFEP*PREC*PREC) CC4=0.D0 290 : IF(CC4.LT.0) GO TO 12 291 : DLAM4=SQRT(CC4) 292 : DLAMBD(4)=DLAMBD(4)+DLAM4 293 : GO TO 130 294 : C 295 : 12 IF(IIMPI.EQ.9) WRITE(IOIMP,5020) 296 : GO TO 40 297 : C 297 : 11 CALL DDFDS(ICRIT1,ALFADV,ALFAD1,ALFAD2,YUNG,XNU,SIDEMI,SIGEL, 298 : .DDF,KERRE) 299 : DO 70 III=1,6 300 : DSIGPR(III)=DSIGP(III)-DDF(III)*DGLAMP 301 : SIGMA(III)=SIGEL(III)-DDF(III)*DL 302 : DSIGMA(III)=DSIGPR(III) 303 : SIGMAT(III)=SIGMA(III)+DSIGMA(III) 304 : 70 CONTINUE 305 : IF(IIMPI.EQ.9) 306 : .WRITE(IOIMP,7000) (SIGMA(I),I=1,6),(DSIGMA(J),J=1,6), 307 : . (SIGMAT(K),K=1,6),(DDF(L),L=1,6),(DSIGP(M),M=1,6) 308 : GO TO (71,72,73,74,75),ICRIT1 309 : WRITE(IOIMP,1000) 310 : KERRE=640 311 : RETURN 312 : C 313 : C L ECOULEMENT SELON LE CRITERE CORRESPONDANT 314 : C 315 : 71 IF(IIMPI.EQ.9) WRITE(IOIMP,6001) 316 : GO TO 80 317 : 72 IF(IIMPI.EQ.9) WRITE(IOIMP,6002) 318 : GO TO 80 319 : 73 IF(IIMPI.EQ.9) WRITE(IOIMP,6003) 320 : IF(IDED.EQ.0.OR.IDED.EQ.2) IDED=IDED+1 321 : GO TO 80 322 : 74 IF(IIMPI.EQ.9) WRITE(IOIMP,6004) 323 : GO TO 80 324 : 75 IF(IIMPI.EQ.9) WRITE(IOIMP,6005) 325 : IF(IDED.EQ.0.OR.IDED.EQ.1) IDED=IDED+2 326 : 80 IDAM=IDAM+1 327 : C 328 : C ITERATIONS INTERNES 329 : C 330 : 81 IF(IDAM.LT.10) GO TO 85 331 : WRITE(IOIMP,7001) 332 : KERRE=640 333 : RETURN 333 : 85 CALL TRIAGE(ITRI,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, 334 : .DPELA2,PORELA,R1,R2,R3,SIGMA,DSIGMA,SIGMAT,SIGEL,DSIGP,TETAQ,IDED, 335 : .ICAS,IDAM,ITRAC,KOUPLE,IMIN,JMIN,GAMIN,ICRIT1,KASTR,DP2MIN,DGLAMP, 336 : .DL,PENTE1,PENTE2,CC,SS,CS,ICRIME,ICRIMT,ITETA,IRZ,LMIC5, 337 : .PREC,RFSG,RFEP,RFPR,KERRE) 338 : ICRIT2=IMIN 339 : IF(IIMPI.EQ.9) WRITE(IOIMP,9006) KOUPLE,ICRIT1,IMIN,JMIN,GAMIN 340 : IF(GAMIN.LT.0.D0) GAMIN=0.D0 341 : IF(KOUPLE.NE.2) GO TO 86 342 : ICRIT2=IMIN 343 : JCRIT2=JMIN 344 : 86 XX=XX+GAMIN 345 : IF(XX.LE.1.D0) GO TO 33 346 : GAMIN=GAMIN+1.D0-XX 347 : XX=1.D0 348 : 33 IF(IIMPI.EQ.9) WRITE(IOIMP,5006)XX,GAMIN 349 : DPLAM=DGLAMP*GAMIN+DL 350 : IF(ABS(DPLAM).LT.RFPR*PREC.AND.DPLAM.LT.0.D0) DPLAM=0.D0 351 : IF(ICRIT1.NE.5) GO TO 91 352 : IF(DGLAMP.EQ.0.D0) GO TO 91 353 : DPLMAX=XLAMAX-XLAMBD(5)-DLAMBD(5) 354 : TSTDPL=DPLMAX-DPLAM 355 : IF(TSTDPL.GE.0.D0) GO TO 91 356 : GAMINI=(DPLMAX-DL)/DGLAMP 357 : IF(GAMINI.LT.0.D0) GAMINI=0.D0 358 : DGAM=GAMINI-GAMIN 359 : XX=XX+DGAM 360 : IF(IIMPI.EQ.9) WRITE(IOIMP,8002) DGAM,GAMINI,DPLMAX,XX,DPLAM 361 : DPLAM=DPLMAX 362 : GAMIN=GAMINI 363 : C IC5=1 364 : C 365 : 91 DLAMBD(ICRIT1)=DLAMBD(ICRIT1)+DPLAM 366 : DO 92 III=1,6 367 : DELSIG(III)=DSIGPR(III)*GAMIN-DDF(III)*DL 368 : SIGEL(III)=SIGEL(III)+DELSIG(III) 369 : 92 CONTINUE 370 : IF(XX.LT.1.D0) GO TO 82 371 : DO 83 III=1,6 372 : DSIGP(III)=0.D0 373 : 83 CONTINUE 374 : 82 IF(IIMPI.EQ.9) WRITE(IOIMP,5000) ICRIT1,(DLAMBD(I),I=1,5), 375 : . ITERA,DPLAM 375 : CALL KRITER(ICRIT1,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, 376 : .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,DPLAM,SIGEL,FSIG,FCRIT,KERRE) 377 : IF(IIMPI.EQ.9) 378 : .WRITE(IOIMP,5001) ICRIT1,ICRIME,ICRIMT,VMELAS,DPELAS, 379 : . DPELA1,DPELA2,PORELA,DPLAM,FSIG,FCRIT, 380 : . (SIGEL(I),I=1,6),(DSIGP(J),J=1,6) 381 : ITRI=2 382 : IF(ITERA.EQ.1) GO TO 110 383 : C 384 : IF(ABS(DLAMBD(ICRIT1)).LT.RFPR*PREC.AND.DLAMBD(ICRIT1).LT.0.D0) 385 : .DLAMBD(ICRIT1)=0.D0 386 : IF(ABS(DLAMBD(ICRIT1)).LE.RFEP) 387 : .DLAMBD(ICRIT1)=0.D0 388 : IF(DLAMBD(ICRIT1).GE.0.D0) GO TO 109 389 : WRITE(IOIMP,1010) ICRIT1,DLAMBD(ICRIT1) 390 : KERRE=640 391 : RETURN 392 : C 393 : C TEST DE CONVERGENCE 394 : C 395 : 109 IF(DLAMBD(ICRIT1).EQ.0.D0) GO TO 120 396 : DENOR=MAX(DLAMBD(ICRIT1),RFEP) 397 : TEST=ABS(DPLAM)/DENOR 398 : IF(IIMPI.EQ.9) WRITE(IOIMP,5107) DPLAM,DLAMBD(ICRIT1),TEST 399 : C 400 : C CAS DU CRITERE DE DRUCKER FRAGILE ECROUISSABLE QUAND DPLAM CALCULE 401 : C EST PLUS GRAND QUE DPLMAX. DANS CE CAS ON TEST SUR FCRIT ET PAS 402 : C SUR DPLAM 403 : C 404 : C IF(ICRIT1.NE.5.OR.IC5.NE.1) GO TO 119 405 : TEST1=ABS(FCRIT)*PREC/RFSG 406 : IF(TEST.LT.TEST1) TEST=TEST1 407 : C IC5=0 408 : IF(IIMPI.EQ.9) WRITE(IOIMP,5108) FCRIT,TEST1,TEST 409 : C 410 : 119 IF(TEST.LT.PREC) GO TO 120 411 : IF(ITERA.LE.20) GO TO 110 412 : WRITE(IOIMP,1011) ICRIT1,ITERA,DPLAM,DLAMBD(ICRIT1),TEST 413 : KERRE=640 414 : RETURN 415 : C 416 : 110 ITERA=ITERA+1 417 : IF(IIMPI.EQ.9) WRITE(IOIMP,5007) ITERA 417 : CALL CRILAM(ICRIT1,SIGMAT,SIGEL,DSIGP,ALFADV,ALFAD1,ALFAD2,VMELAS, 418 : .DPELAS,DPELA1,DPELA2,PORELA,PENTE1,PENTE2,PENTE3,YUNG,XNU, 419 : .DGLAM,DGLAMM,DGLAMP,DI,DL,ISOMET,KERRE) 420 : IF(IIMPI.EQ.9) 421 : .WRITE(IOIMP,5002) ICRIT1,DGLAMP,DGLAMM,DGLAM,DL,ITERA 421 : CALL DDFDS(ICRIT1,ALFADV,ALFAD1,ALFAD2,YUNG,XNU,SIGEL,SIGMAT, 422 : .DDF,KERRE) 423 : DO 100 III=1,6 424 : DSIGPR(III)=DSIGP(III)-DDF(III)*DGLAMP 425 : IF(IIMPI.EQ.9) WRITE(IOIMP,5005) SIGEL(III),DSIGPR(III) 426 : SIGMA(III)=SIGEL(III)-DDF(III)*DL 427 : DSIGMA(III)=DSIGPR(III) 428 : SIGMAT(III)=SIGMA(III)+DSIGMA(III) 429 : 100 CONTINUE 430 : IF(IIMPI.EQ.9) WRITE(IOIMP,7000) (SIGMA(I),I=1,6), 431 : . (DSIGMA(J),J=1,6), 432 : . (SIGMAT(K),K=1,6),(DDF(L),L=1,6),(DSIGP(M),M=1,6) 433 : GO TO 81 434 : C 435 : 120 IF(XX.GT.1.) XX=1.D0 436 : DELIX=1.D0-XX 437 : DO 121 III=1,6 438 : DSIGP(III)=DSIGP(III)*DELIX 439 : 121 CONTINUE 440 : XLMDF=(XLAMAX-XLAMBD(5)-DLAMBD(5))*2.D0/ 441 : . (XLAMAX+XLAMBD(5)+DLAMBD(5)) 442 : DIFLAM=XLAMBD(5)+DLAMBD(5)-XLAMER 443 : IF(DIFLAM.LT.0.D0) GO TO 123 444 : KASTR=2 445 : TRALIM=DPELA2/(3.D0*ALFAD2) 446 : IF(XLMDF.LE.PREC) TRALIM=0.D0 447 : IF(TRALIM.EQ.0.D0) LMIC5=1 448 : R1=R01 449 : R2=R02 450 : R3=R03 451 : IF(R1.GT.0.D0) R1=TRALIM 452 : IF(R2.GT.0.D0) R2=TRALIM 453 : IF(R3.GT.0.D0) R3=TRALIM 454 : 123 IF(IIMPI.EQ.9) WRITE(IOIMP,8000) DELIX,ICRIT1,ICRIT2 455 : IF(DELIX.LE.RFEP) GO TO 130 456 : IF(ICRIT1.EQ.5.AND.LMIC5.EQ.1) GO TO 180 457 : IF(ICRIT2.EQ.6.OR.JCRIT2.EQ.6) GO TO 140 458 : IF(ICRIT2.EQ.7.OR.JCRIT2.EQ.7) GO TO 140 459 : IF(KOUPLE.EQ.2) GO TO 150 460 : C 461 : C L ECOULEMENT SELON COUPLE 462 : C 463 : IF(IIMPI.EQ.9) WRITE(IOIMP,6008) 464 : 157 ICAS=ICRIT1+ICRIT2-2 465 : 153 IF(ICAS.NE.5) GO TO 60 466 : IF(ICRIT1.EQ.3.OR.ICRIT2.EQ.3) ICAS=8 467 : 60 IF(IIMPI.EQ.9) WRITE(IOIMP,8001) ICAS 468 : IF(IIMPI.EQ.9) WRITE(IOIMP,5003) (SIGEL(I),I=1,6) 469 : IF(IIMPI.EQ.9) WRITE(IOIMP,5004) (DSIGP(I),I=1,6) 470 : C 470 : CALL COUPLE(ICAS,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, 471 : .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,YUNG,XNU,SIGEL,DSIGP,DLAMBD, 472 : .XLAMBD,ICOUP,ICRIT1,ICRIT2,SIGMA,DSIGMA,SIGMAT,XX,IDED,LMIC5, 473 : .ICRIME,ICRIMT,XLAMAX,PREC,RFSG,RFEP,RFPR,KERRE) 474 : IF(ICOUP.EQ.0) GO TO 130 475 : GO TO (161,162,152),ICOUP 476 : WRITE(IOIMP,1003) 477 : KERRE=640 478 : RETURN 479 : C 480 : C IL RESTE ENCORE UN INCREMENT DE CONTRAINTE A ECOULER SUIVANT 481 : C LE CRITERE DE DRUCKER PRAGER FRAGILE FIXE 482 : C 483 : 180 IF(IIMPI.EQ.9) WRITE(IOIMP,6012) 484 : DO 181 I=1,6 485 : SIGMA(I)=SIGEL(I) 486 : DSIGMA(I)=DSIGP(I) 487 : SIGMAT(I)=SIGEL(I)+DSIGP(I) 488 : 181 CONTINUE 489 : ICRIT1=4 490 : ICRIME=5 491 : KASTR=2 492 : DPLAM=0.D0 493 : IDAM=IDAM+1 494 : GO TO 170 495 : C 496 : C IL N Y A PAS DE COUPLAGE 497 : C 498 : 161 IF(IIMPI.EQ.9) WRITE(IOIMP,5008) 499 : GO TO 1234 500 : 166 IF(IIMPI.EQ.9) WRITE(IOIMP,8004) 501 : 1234 DPLAM=0.D0 502 : IF(ICRIT1.NE.0) GO TO 170 503 : ITERA=0 504 : ITRI=0 505 : GO TO 160 506 : C 507 : C IL Y A COUPLAGE 508 : C 509 : 162 IF(IIMPI.EQ.9) WRITE(IOIMP,5009) 510 : DIFLAM=XLAMBD(5)-XLAMER 511 : XLMDF=(XLAMAX-XLAMBD(5))*2.D0/(XLAMAX+XLAMBD(5)) 512 : IF(DIFLAM.LT.0.D0) GO TO 122 513 : KASTR=2 514 : TRALIM=DPELA2/(3.D0*ALFAD2) 515 : IF(XLMDF.LE.PREC) TRALIM=0.D0 516 : IF(TRALIM.EQ.0.D0) LMIC5=1 517 : R1=R01 518 : R2=R02 519 : R3=R03 520 : IF(R1.GT.0.D0) R1=TRALIM 521 : IF(R2.GT.0.D0) R2=TRALIM 522 : IF(R3.GT.0.D0) R3=TRALIM 523 : 122 IDAM=IDAM+1 524 : GO TO(333,163,163,333,164,165,164,163),ICAS 525 : WRITE(IOIMP,1004) 526 : KERRE=640 527 : RETURN 528 : 163 IF(IDED.EQ.0.OR.IDED.EQ.2) IDED=IDED+1 529 : GO TO 333 530 : 164 IF(IDED.EQ.0.OR.IDED.EQ.1) IDED=IDED+2 531 : IF(ICRIME.EQ.5) GO TO 166 532 : GO TO 333 533 : 165 IDED=3 534 : IF(ICRIME.EQ.5) GO TO 166 535 : GO TO 333 536 : C 537 : C COUPLAGE AVEC LA TRACTION 538 : C 539 : 140 DO 141 III=1,6 540 : SIGMAT(III)=SIGEL(III)+DSIGP(III) 541 : 141 CONTINUE 542 : ITRI=0 543 : ITERA=0 544 : XX=0.D0 545 : DPLAM=0.D0 546 : ITS=1 547 : DO 142 III=1,5 548 : XLAMBD(III)=XLAMBD(III)+DLAMBD(III) 549 : 142 CONTINUE 550 : DO 143 III=1,5 551 : DLAMBD(III)=0.D0 552 : 143 CONTINUE 553 : C 554 : C L ECOULEMENT SELON LE CRITERE DE LA TRACTION 555 : C 556 : 50 IF(IIMPI.EQ.9) WRITE(IOIMP,6006) 556 : CALL CRACK(SIGMAT,SIGEL,DSIGP,R1,R2,R3,TETAQ,ITRAC,ITENS, 557 : .ITENRZ,ITENTE,ITETA,IRZ,SIGMA,DSIGMA,YUNG,XNU, 558 : .ALFAD2,DPELA2,PENTE2,IBAB,ICTD,KASTR,PREC,RFSG,RFEP,RFPR,KERRE) 559 : IDAM=IDAM+1 560 : IF(ICTD.EQ.0) GO TO 333 561 : ICRIT1=0 562 : ITRI=0 563 : KASTR=2 564 : R01=R1 565 : R02=R2 566 : R03=R3 567 : GO TO 160 568 : C 569 : 150 IF(ICRIT1.EQ.ICRIT2.OR.ICRIT1.EQ.JCRIT2) GO TO 151 570 : KAT=ICRIT1+ICRIT2+JCRIT2 571 : IF(ICRIT1.EQ.4.OR.ICRIT2.EQ.4.OR.JCRIT2.EQ.4) GO TO 159 572 : IF(KAT.EQ.6) GO TO 152 573 : 159 IF(ICRIT1.LE.3) GO TO 157 574 : IF(ICRIT1.GT.5) GO TO 158 575 : ICRIT2=JCRIT2 576 : GO TO 157 577 : 158 WRITE(IOIMP,1005) ICRIT1,ICRIT2,JCRIT2 578 : KERRE=640 579 : RETURN 580 : C 581 : C UN CAS DE COUPLAGE 582 : C 583 : 151 ICAS=ICRIT2+JCRIT2-2 584 : GO TO 153 585 : C 586 : C L ECOULEMENT SELON TRIPLE 587 : C 588 : 152 IF(IIMPI.EQ.9) WRITE(IOIMP,6009) 588 : CALL TRIPLE(ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,DPELA2, 589 : .PORELA,PENTE1,PENTE2,PENTE3,YUNG,XNU,SIGEL,DSIGP,DLAMBD,XLAMBD, 590 : .ICOUP,ICAS,ICRIT1,ICRIT2,ICRIME,ICRIMT,SIGMA,DSIGMA,XX, 591 : .PREC,RFSG,RFEP,RFPR,KERRE) 592 : IF(ICOUP.EQ.0) GO TO 130 593 : GO TO(154,155,156),ICOUP 594 : WRITE(IOIMP,1007) 595 : KERRE=640 596 : RETURN 597 : C 598 : C IL N Y A PAS DE TRIPLAGE NI DE COUPLAGE 599 : C 600 : 154 IF(IIMPI.EQ.9) WRITE(IOIMP,5013) 601 : DPLAM=0.D0 602 : GO TO 170 603 : C 604 : C IL N Y A PAS DE TRIPLAGE MAIS IL Y A COUPLAGE 605 : C 606 : 155 IF(IIMPI.EQ.9) WRITE(IOIMP,6010) 607 : GO TO 60 608 : C 609 : C IL Y A TRIPLAGE 610 : C 611 : 156 IF(IIMPI.EQ.9) WRITE(IOIMP,6011) 612 : IF(IDED.EQ.0.OR.IDED.EQ.2) IDED=IDED+1 613 : GO TO 333 614 : C 615 : C LA SORTIE 616 : C 617 : 40 IF(IIMPI.EQ.9) WRITE(IOIMP,6000) 618 : IF(IDAM.LE.1) RETURN 619 : C 620 : DO 41 III=1,6 621 : SIGEL(III)=SIGMAT(III) 622 : 41 CONTINUE 623 : DO 42 I=1,5 624 : XLAMBD(I)=XLAMBD(I)+DLAMBD(I) 625 : 42 CONTINUE 626 : GO TO 333 627 : C 628 : 130 IF(IIMPI.EQ.9) WRITE(IOIMP,6007) 629 : DO 131 I=1,5 630 : 131 XLAMBD(I)=XLAMBD(I)+DLAMBD(I) 631 : ICOUP=1 632 : GO TO 333 633 : C 634 : C CALCUL DES CRITERES APRES LA CONVERGENCE 635 : C 636 : 333 IF(IIMPI.EQ.9) WRITE(IOIMP,5010) 637 : DO 4444 KLM=1,5 637 : CALL KRITER(KLM,ALFADV,ALFAD1,ALFAD2,VMELA0,DPELAS,DPELA1,DPEL20, 638 : .POREL0,PENTE1,PENTE2,PENTE3,XLAMBD(KLM),SIGEL,FSIG,FCRIT,KERRE) 639 : DLAMBD(KLM)=XLAMBD(KLM)-XLAMBO(KLM) 640 : SIS(KLM)=FSIG 641 : CRI(KLM)=FCRIT 642 : IF(IIMPI.EQ.9) WRITE(IOIMP,5011) KLM,FSIG,FCRIT,DLAMBD(KLM), 643 : . XLAMBD(KLM) 644 : 4444 CONTINUE 645 : C 646 : IF(IIMPI.EQ.9) WRITE(IOIMP,5012) IDAM, 647 : . (SIGEL(I),I=1,6),(DSIGP(J),J=1,6) 648 : C 649 : 1000 FORMAT(1X,'ERREUR DANS DAMAGE DANS LA VALEUR DE ICRIT1') 650 : 1003 FORMAT(1X,'ERREUR DANS DAMAGE DANS LA VALEUR DE ICOUP APRES ', 651 : . 'COUPLE') 652 : 1004 FORMAT(1X,'ERREUR DANS DAMAGE DANS LA VALEUR DE ICAS APRES ', 653 : . 'COUPLAGE') 654 : 1005 FORMAT(1X,'ERREUR DANS DAMAGE KOUPLE=2',/, 655 : . 1X,'ICRIT1=',I4,1X,'ICRIT2=',I4,1X,'JCRIT2=',I4) 656 : 1006 FORMAT(1X,'ERREUR DANS DAMAGE CAS DE DECHARGE ICRIT1=',I4) 657 : 1007 FORMAT(1X,'ERREUR DANS DAMAGE DANS LA VALEUR DE ICOUP APRES ', 658 : . 'TRIPLE') 659 : 1010 FORMAT(1X,'ERREUR DANS DAMAGE DLAMBD(',I1,') EST NEGATIF', 660 : . 1X,'DLAMBD=',1PD12.5) 661 : 1011 FORMAT(1X,'ERREUR DANS DAMAGE ON N ARRIVE PAS A CONVERGER',/, 662 : . 1X,'ICRIT1=',I4,1X,'ITERA =',I4,1X,'DPLAM =',1PD12.5,/, 663 : . 1X,'DLAMBD=',D12.5,1X,'TEST =',1PD12.5) 664 : 5000 FORMAT(1X,'ICRIT1=',I4,/,1X,'DLAMBD=',1PD12.5,/,4(8X,1PD12.5,/), 665 : . 1X,'ITERA =',I4,1X,'DPLAM =',1PD12.5) 665 :
Warning: preg_replace(): Unknown modifier '/' in C:\xampp\htdocs\cast3m_kit_local_fr_en_2014\sources.php on line 147
666 : . 1X,'ICRIT1=',I4,1X,'ICRIME=',I4,1X,'ICRIMT=',I4,/, 667 : . 1X,'VMELAS=',1PD12.5,1X,'DPELAS=',1PD12.5, 668 : . 1X,'DPELA1=',1PD12.5,1X,'DPELA2=',1PD12.5,/, 669 : . 1X,'PORELA=',1PD12.5,1X,'DPLAM =',1PD12.5, 670 : . 1X,'FSIG =',1PD12.5,1X,'FCRIT =',1PD12.5,/, 671 : . 1X,'SIGEL =',6(1PD12.5,1X),/, 672 : . 1X,'DSIGP =',6(1PD12.5,5X)) 672 :
Warning: preg_replace(): Unknown modifier ',' in C:\xampp\htdocs\cast3m_kit_local_fr_en_2014\sources.php on line 147
673 : . 1X,'ICRIT1=',I4,1X,'DGLAMP=',1PD12.5,1X,'DGLAMM=',1PD12.5, 674 : . 1X,'DGLAM =',1PD12.5,1X,'DL =',1PD12.5,1X,'ITERA =',I4) 675 : 5003 FORMAT(1X,'SIGEL =',6(1X,1PD12.5)) 676 : 5004 FORMAT(1X,'DSIGP =',6(1X,1PD12.5)) 677 : 5005 FORMAT(1X,'SIGEL =',1PD12.5,1X,'DSIGPR=',1PD12.5) 678 : 5006 FORMAT(1X,'XX =',1PD12.5,1X,'GAMIN =',1PD12.5) 679 : 5007 FORMAT(1X,'ITERA =',I4) 680 : 5008 FORMAT(1X,'IL N Y A PAS DE COUPLAGE') 681 : 5009 FORMAT(1X,'IL Y A COUPLAGE') 682 : 5010 FORMAT(1X,'ICRIT',6X,'FSIG',11X,'FCRIT',10X,'DLAMBD',9X,'XLAMBD') 683 : 5011 FORMAT(3X,I1,4(5X,1PD12.5)) 684 : 5012 FORMAT(1X,'IDAM =',I4,/, 685 : . 1X,'SIGEL =',6(1X,1PD12.5),/, 686 : . 1X,'DSIGP =',6(1X,1PD12.5)) 687 : 5013 FORMAT(1X,'IL N Y A PAS DE TRIPLAGE NI DE COUPLAGE') 688 : 5020 FORMAT(1X,'IL N Y A PAS D ENDOMMAGEMENT ON DECHARGE') 689 : 5107 FORMAT(1X,'DPLAM =',1PD12.5,1X,'DLAMBD=',1PD12.5, 690 : . 1X,'TEST =',1PD12.5) 691 : 5108 FORMAT(1X,'FCRIT =',1PD12.5,1X,'TEST1 =',1PD12.5, 692 : . 1X,'TEST =',1PD12.5) 693 : 6000 FORMAT(1X,'IL N Y A PAS D ENDOMMAGEMENT') 694 : 6001 FORMAT(1X,'L ECOULEMENT SELON LE CRITERE DE LA POROSITE (1)') 695 : 6002 FORMAT(1X,'L ECOULEMENT SELON LE CRITERE DE DRUCKER DUCTILE (2)') 696 : 6003 FORMAT(1X,'L ECOULEMENT SELON LE CRITERE DE VON MISES (3)') 697 : 6004 FORMAT(1X,'L ECOULEMENT SELON LE CRITERE DE DRUCKER FRAGILE (4)') 698 : 6005 FORMAT(1X,'L ECOULEMENT SELON LE CRITERE DE DRUCKER FRAGILE ', 699 : .'ECR. (5)') 700 : 6006 FORMAT(1X,'L ECOULEMENT SELON LE CRITERE DE LA TRACTION') 701 : 6007 FORMAT(1X,'L ECOULEMENT SELON UN SEUL CRITERE') 702 : 6008 FORMAT(1X,'L ECOULEMENT SELON COUPLE') 703 : 6009 FORMAT(1X,'L ECOULEMENT SELON TRIPLE') 704 : 6010 FORMAT(1X,'IL N Y A PAS DE TRIPLAGE MAIS IL Y A COUPLAGE') 705 : 6011 FORMAT(1X,'IL Y A TRIPLAGE') 706 : 6012 FORMAT(1X,'IL RESTE ENCORE UN INCREMENT DE CONTRAINTE ', 707 : .'A ECOULER SUIVANT',/,1X,'LE CRITERE DE DRUCKER FRAGILE FIXE') 708 : 7000 FORMAT(1X,'SIGMA =',6(1X,1PD12.5),/,1X,'DSIGMA=',6(1X,1PD12.5),/, 709 : . 1X,'SIGMAT=',6(1X,1PD12.5),/, 710 : . 1X,'DDF =',6(1X,1PD12.5),/,1X,'DSIGP =',6(1X,1PD12.5)) 711 : 7001 FORMAT(1X,'ERREUR DANS DAMAGE IDAM EST PLUS GRAND QUE 10 ') 712 : 8000 FORMAT(1X,'DELIX =',1PD12.5,1X,'ICRIT1=',I4,1X,'ICRIT2=',I4) 713 : 8001 FORMAT(1X,'ICAS =',I4) 714 : 8002 FORMAT(1X,'DGAM =',1PD12.5,1X,'GAMINI=',1PD12.5, 715 : . 1X,'DPLMAX=',1PD12.5,/, 716 : . 1X,'XX ',1PD12.5,1X,'DPLAM =',1PD12.5) 717 : 8004 FORMAT(1X,'IL Y A COUPLAGE MAIS IL RESTE ENCORE DE L INCREMENT DE 718 : .CONTRAINTES') 719 : 9006 FORMAT(1X,'ON EST DANS DAMAGE APRES LE 2-EME APPEL A TRIAGE '/ 720 : .1X,'KOUPLE=',I4,1X,'ICRIT1=',I4,1X,'IMIN =',I4,1X,'JMIN =',I4,/, 721 : .1X,'GAMIN =',1PD12.5) 722 : 9999 FORMAT(1X,'ON EST EN TETE DE DAMAGE ',/, 723 : . 2(7(1X,1PD12.5)/),5(1X,1PD12.5)/4(6(1X,1PD12.5)/), 724 : . 7(1X,1PD12.5),1X,I4,1X,I4) 725 : C 726 : RETURN 727 : END 728 :
© Cast3M 2003 - All rights reserved.
Disclaimer