Télécharger distrt.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales