1 : C DISTRT SOURCE CHAT 05/01/12 22:51:42 5004 2 : SUBROUTINE DISTRT(MMTRA,NNT,DT, DPI, TE,ID,ERR, RES,IOK,INEW) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C = CALCUL DU MAXIMUM DE DISTRIBUTION DANS LE CAS = 7 : C = NON STATIONNAIRE (ET STATIONAIRE) = 8 : C = = 9 : C = ENTREE XLTIME(1,NNT)=XL0,XL1,XL2 MOMENT STATIQUES AU COURS DU = 10 : C = TEMPS = 11 : C = ID=1 NEWMARK/GUMBEL 1 + SUBSTITUTION = 12 : C = ID=2 NEWMARK/GUMBEL 1 + DICHOTOMIE = 13 : C = = 14 : C = ERREUR = 15 : C = IOK=1 NUMERO INEXISTANT = 16 : C = ID=1 IOK=2 NON CONVERGENCE = 17 : C = ID=2 IOK=2 PAS D'ENCADREMENT INFERIEUR = 18 : C = IOK=3 PAS D'ENCADREMENT SUPERIEUR = 19 : C = IOK=100 NON CONVERGENCE INFERIEUR = 20 : C = IOK=101 NON CONVERGENCE SUPERIEURE = 21 : C======================================================================= 22 : REAL*8 L1,L2,N1,N2 23 : LOGICAL LMOD2 24 : C======+++++++++++ bon fontionnement erreur PSRS/PRNS +++++++++++ ====== 25 : -INC CCOPTIO 26 : SEGMENT,MMTRA 27 : IMPLIED XLTIME(NNT,3) 28 : ENDSEGMENT 29 : C======+++++++++++ bon fontionnement erreur PSRS/PRNS +++++++++++ ====== 30 : C 31 : INEW=0 32 : C 33 : IF(ID.LE.0.OR.ID.GT.2)THEN 34 : IOK=1 34 : CALL ERREUR(571) 35 : RETURN 36 : ENDIF 37 : C 38 : GOTO (10,20),ID 39 : C 40 : C 1)METHODE DE NEWMARK/GUMBEL 1 (METHODE DE SUBSTITUTION) 41 : C 42 : 10 CONTINUE 43 : C 44 : C 1.1) FACTEUR DE GUMBEL 1 45 : C 46 : A=LOG(-LOG(0.05D0)) 47 : B=A-LOG(-LOG(0.95D0)) 48 : C 49 : C 1.2) CALCUL DE LAM0 MOYEN ET DE LAM0 MAX 50 : C 51 : XL0MA=XLTIME(1,1) 52 : IF(NNT.NE.1)THEN 53 : DO 100 IE1=2,NNT-1 54 : IF(XLTIME(IE1,1).GT.XL0MA)XL0MA=XLTIME(IE1,1) 55 : 100 CONTINUE 56 : IF(XLTIME(NNT,1).GT.XL0MA)XL0MA=XLTIME(NNT,1) 57 : ENDIF 58 : C 59 : C 1.3) INITIALISATION DE L1 ET L2 60 : C 61 : L2=SQRT(XL0MA)*3 62 : L1=L2/4 63 : C 64 : C 1.4) BOUCLE DE DETERMINATION DE L1 ET L2 65 : C 66 : DO 101 IE1=1,20 67 : C 68 : C 1.4.1) CALCUL DES DISTRIBUTION DE NEWMARK 69 : C 69 : CALL NEWMAR(L1,DT,XLTIME(1,1),XLTIME(1,2),XLTIME(1,3), 70 : > DPI,NNT,N1) 70 : CALL NEWMAR(L2,DT,XLTIME(1,1),XLTIME(1,2),XLTIME(1,3), 71 : > DPI,NNT,N2) 72 : C WRITE(6,'(I2,3X,2H1:,1PD13.6,1X,1PD13.6,3X, 73 : C > 2H2:,1PD13.6,1X,1PD13.6,1X)')IE1,L1,N1,L2,N2 74 : INEW=INEW+2 75 : C 76 : C 1.4.2) CALCUL DES PARAMETRE DE GUMBEL 77 : C 78 : AGUMB=LOG(LOG(N1)/LOG(N2))/(L2-L1) 79 : UGUMB=L1+LOG(-LOG(N1))/AGUMB 80 : C 81 : C 1.4.3) TEST DE CONVERGENCE 82 : C 83 : IF((ABS(N1-.05D0)+ABS(N2-.95D0)).LT.ERR) GOTO 102 84 : C 85 : C 1.4.4) CALCUL DES NOUVEAUX L 86 : C 87 : L1 = UGUMB - A / AGUMB 88 : L2 = L1 + B / AGUMB 89 : C 90 : 101 CONTINUE 91 : C 92 : C 1.5) NON CONVERGENCE 93 : C 94 : IOK=2 94 : CALL ERREUR(572) 95 : RETURN 96 : C 97 : C 1.6) CONVERGENCE 98 : C 99 : 102 IOK=0 100 : RES=UGUMB + 0.57722/AGUMB 101 : RETURN 102 : C 103 : C 3) METHODE DE NEWMARK/GUMBEL 1 (METHODE DE DICHOTOMIE) 104 : C 105 : 20 CONTINUE 106 : IOK=0 107 : C 108 : C 2.1) CALCUL DE LAM0 MOYEN ET DE LAM0 MAX 109 : C 110 : XL0MA=XLTIME(1,1) 111 : IF(NNT.NE.1)THEN 112 : DO 200 IE1=2,NNT-1 113 : IF(XLTIME(IE1,1).GT.XL0MA)XL0MA=XLTIME(IE1,1) 114 : 200 CONTINUE 115 : IF(XLTIME(NNT,1).GT.XL0MA)XL0MA=XLTIME(NNT,1) 116 : ENDIF 117 : C 118 : C 2.2) INITIALISATION DE L1 ET L2 119 : C 120 : L2=SQRT(XL0MA)*3 121 : L1=L2/4 122 : C 123 : C 2.3) VERIFICATION DES INITIALISATIONS 124 : C 125 : C 2.3.1) INITIALISATION 126 : C 126 : CALL NEWMAR(L1,DT,XLTIME(1,1),XLTIME(1,2),XLTIME(1,3), 127 : > DPI,NNT,N1) 128 : BL2=L1 129 : BN2=N1 130 : C 130 : CALL NEWMAR(L2,DT,XLTIME(1,1),XLTIME(1,2),XLTIME(1,3), 131 : > DPI,NNT,N2) 132 : BL1=L2 133 : BN1=N2 134 : C 135 : INEW=INEW+2 136 : C 137 : C 2.3.2) L1 (AVEC RAFINEMENT EVENTUEL DES BORNES) ... 138 : C 139 : DO 201 IE1=1,10 140 : C WRITE(6,'(1X,A5,2(1X,1PD14.7))')'L1,N1',L1,N1 141 : IF(N1.LT.0.05D0)GOTO 202 142 : BL1=L1 143 : BN1=N1 144 : L1=L1/2 144 : CALL NEWMAR(L1,DT,XLTIME(1,1),XLTIME(1,2),XLTIME(1,3), 145 : > DPI,NNT,N1) 146 : INEW=INEW+1 147 : 201 CONTINUE 148 : C 149 : C 2.3.3) ... ET ERREUR L1 150 : C 151 : IOK=2 152 : MOTERR='inferieur' 152 : CALL ERREUR(573) 153 : RETURN 154 : C 155 : C 2.3.4) L2 (AVEC RAFINEMENT EVENTUEL DES BORNES) ... 156 : C 157 : 202 DO 203 IE1=1,10 158 : C WRITE(6,'(1X,A5,2(1X,1PD14.7))')'L2,N2',L2,N2 159 : IF(N2.GT.0.95D0)GOTO 204 160 : BL2=L2 161 : BN2=N2 162 : L2=L2*2 162 : CALL NEWMAR(L2,DT,XLTIME(1,1),XLTIME(1,2),XLTIME(1,3), 163 : > DPI,NNT,N2) 164 : INEW=INEW+1 165 : 203 CONTINUE 166 : C 167 : C 2.3.5) ... ET ERREUR L2 168 : C 169 : IOK=3 170 : MOTERR='superieur' 170 : CALL ERREUR(573) 171 : RETURN 172 : C 173 : C 2.4) DETERMINATION DE L1 174 : C 175 : C 2.4.1) UNE DES BORNES EST-ELLE CORRECTE ??? 176 : C 177 : 204 IF(ABS(N1-0.05D0).LT.ERR)GOTO 210 178 : IF(ABS(BN1-0.05D0).LT.ERR)THEN 179 : L1=BL1 180 : N1=BN1 181 : GOTO 210 182 : ENDIF 183 : C 184 : C 2.4.2) PEUT-ON AMELIORER LES ESTIMATIONS POUR L2 ? 185 : C 186 : IF(BN1.GE.0.95D0)THEN 187 : L2=BL1 188 : N2=BN1 189 : LMOD2=.TRUE. 190 : ELSE 191 : LMOD2=.FALSE. 192 : ENDIF 193 : C 194 : C 2.4.3) BOUCLE DE DICHOTOMIE 195 : C 196 : DO 205 IE1=1,25 197 : C 198 : C 2.4.3.1) SOLUTION AU MILIEU DE l'INNTERVALLE 199 : C 200 : TL1=(L1+BL1)/2 200 : CALL NEWMAR(TL1,DT,XLTIME(1,1),XLTIME(1,2),XLTIME(1,3), 201 : > DPI,NNT,TN1) 202 : INEW=INEW+1 203 : C 204 : C 2.4.3.2) AMELIORATION ESTIMATION L2 (SI POSSIBLE) 205 : C 206 : IF (LMOD2)THEN 207 : IF(TN1.GE.0.95D0)THEN 208 : L2=TL1 209 : N2=TN1 210 : ELSE 211 : LMOD2=.FALSE. 212 : BL2=TL1 213 : BN2=TN1 214 : ENDIF 215 : ENDIF 216 : C 217 : C 2.4.3.3) TEST DE CONVERGENCE 218 : C 219 : IF(ABS(TN1-0.05D0).LT.ERR)THEN 220 : L1=TL1 221 : N1=TN1 222 : GOTO 210 223 : ENDIF 224 : C 225 : C 2.4.3.4) RESTRICTION DE L'INTERVALLE DE RECHERCHE 226 : C 227 : IF(TN1.LT.0.05D0)THEN 228 : L1=TL1 229 : N1=TN1 230 : ELSE 231 : BL1=TL1 232 : BN1=TN1 233 : ENDIF 234 : C 235 : 205 CONTINUE 236 : C 237 : C 2.4.4) NON CONVERGENCE 238 : C 239 : IOK=100 240 : MOTERR='inferieure' 240 : CALL ERREUR(574) 241 : C RETURN (L'ERREUR 100 N'EST PAS ELIMINATOIRE) 242 : C 243 : C 2.5) DETERMINATION DE L2 244 : C 245 : C 2.5.1) UNE DES BORNES EST-ELLE CORRECTE ??? 246 : C 247 : 210 IF(ABS(N2-0.95D0).LT.ERR)GOTO 220 248 : IF(ABS(BN2-0.95D0).LT.ERR)THEN 249 : L2=BL2 250 : N2=BN2 251 : GOTO 220 252 : ENDIF 253 : C 254 : C 2.5.2) BOUCLE DE DICHOTOMIE 255 : C 256 : DO 215 IE1=1,25 257 : C 258 : C 2.5.2.1) SOLUTION AU MILIEU DE l'INTERVALLE 259 : C 260 : TL2=(L2+BL2)/2 260 : CALL NEWMAR(TL2,DT,XLTIME(1,1),XLTIME(1,2),XLTIME(1,3), 261 : > DPI,NNT,TN2) 262 : INEW=INEW+1 263 : C 264 : C 2.5.2.2) TEST DE CONVERGENCE 265 : C 266 : IF(ABS(TN2-0.95D0).LT.ERR)THEN 267 : L2=TL2 268 : N2=TN2 269 : GOTO 220 270 : ENDIF 271 : C 272 : C 2.5.2.3) RESTRICTION DE L'INTERVALLE DE RECHERCHE 273 : C 274 : IF(TN2.GT.0.95D0)THEN 275 : L2=TL2 276 : N2=TN2 277 : ELSE 278 : BL2=TL2 279 : BN2=TN2 280 : ENDIF 281 : C 282 : 215 CONTINUE 283 : C 284 : C 2.5.3) NON CONVERGENCE 285 : C 286 : IOK=101 + IOK 287 : MOTERR='superieure' 287 : CALL ERREUR(574) 288 : C RETURN (L'ERREUR 101 N'EST PAS ELIMINATOIRE) 289 : C (ET SE COMBINE AVEC 100 ) 290 : C 291 : C 2.6) CALCUL DES PARAMETRE DE GUMBEL 292 : C 293 : 220 AGUMB=LOG(LOG(N1)/LOG(N2))/(L2-L1) 294 : UGUMB=L1+LOG(-LOG(N1))/AGUMB 295 : C 296 : C 2.6) CONVERGENCE 297 : C 298 : RES=UGUMB + 0.57722/AGUMB 299 : C 300 : C WRITE(6,'(1X,A5,2(1X,1PD14.7))')'L1,N1',L1,N1 301 : C WRITE(6,'(1X,A5,2(1X,1PD14.7))')'L2,N2',L2,N2 302 : C 303 : RETURN 304 : C 305 : END 306 :
© Cast3M 2003 - All rights reserved.
Disclaimer