Télécharger prns.eso

Retour à la liste

Numérotation des lignes :

  1. C PRNS SOURCE BP208322 16/11/18 21:20:13 9177
  2. C PRNS SOURCE ISPRA 90/05/03
  3. SUBROUTINE PRNS
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. C=======================================================================
  7. C = CALCUL DU "RESPONSE SPECTRUM" A PARTIR DU "POWER SPECTRUM" =
  8. C = DANS LE CAS NON STATIONNAIRE =
  9. C = =
  10. C = SYNTAXE : =
  11. C = =
  12. C = RSNS*EVOL = PRNS PSNS*EVOL =
  13. C = M *EVOL FREQ*LISTREEL =
  14. C = (TT*LISTREEL AMOR*FLOTTANT =
  15. C = MCL1*MOT MCL2*MOT MCL3*MOT =
  16. C = COUL*MOT =
  17. C = MCL4*MOT NUM*ENTIER =
  18. C = MCL5*MOT DTBASE*FLOTTANT ) =
  19. C = =
  20. C = =
  21. C = RSNS : OBJET DE TYPE EVOLUTIO CONTENANT LES =
  22. C = "RESPONSE SPECTRA" (1 COURBE) =
  23. C = =
  24. C = PSPE : OBJET DE TYPE EVOLUTIO CONTENANT LE "POWER SPECTRUM"=
  25. C = ( UNE COURBE SEULEMENT ) =
  26. C = =
  27. C = M : OBJET DE TYPE EVOLUTIO CONTENANT N COURBES =
  28. C = D'EVOLUTIONS TEMPORELLE (LES TEMPS FINALS DOIVENT =
  29. C = ETRE IDENTIQUES) =
  30. C = =
  31. C = FREQ : OBJET DE TYPE LISTREEL CONTENANT N+1 FREQUENCES =
  32. C = (FREQ"(I)" ET FREQ"(I+1)" DEFINISSENT LA BANDE DE =
  33. C = VALIDITE DE M"(I)") =
  34. C = =
  35. C = TT : OBJET DE TYPE LISTREEL CONTENANT LES PERIODES =
  36. C = AMOR : OBJET DE TYPE FLOTTANT CONTENANT L'AMORTISSEMENT =
  37. C = MCL1 : GRANDEUR DE REPONSE: 'DEPL(ACEMENT)', 'VITE(SSE)' =
  38. C = OU 'ACCE(LERATION)' (DEFAUT) =
  39. C = MCL2 : CHOIX DE L'ABSISSE DU "RESPONSE SPECTRUM" =
  40. C = 'FREQ(UENCE)' OU 'PERI(ODE)' (DEFAUT) =
  41. C = DANS LES 2 CAS LES VALEURS SONT RANGEES PAR VALEURS =
  42. C = CROISSANTES DES ABSCISSES (UTILATION DE IPOL!) =
  43. C = MCL3 : CHOIX DE LA DISTRIBUTION: 'NEG1' =
  44. C = OU 'NEG2' (DEFAUT) =
  45. C = COUL : COULEUR ATTRIBUEE A L'OBJET CREE (FACULTATIF) =
  46. C = ( DEFAUT = COULEUR DE PSNL) =
  47. C = MCL4 : INTEGRATION NEWMARK: =
  48. C = 'NBPR(OCESSUS)' + NUM = NB PROCESSUS STATIONAIRES =
  49. C = 'NBIN(TEGRATION)'+ NUM = NB PTS D'INTEGRATION EN T =
  50. C = 'PREC(ISION)'+ ERR = ERREUR PROC. ITERATIFS =
  51. C = 'TPLU(S)' + TPL = TEMPS EN PLUS =
  52. C = 'NBDE(FAUT)' = VALEURS PAR DEFAUT =
  53. C = MCL5 : CALCUL PAR ONDELETTE =
  54. C = 'ONDE' AVEC FCT DE MODULATION CLASSIQUE =
  55. C = OU AVEC COEFF EN ONDELETTE =
  56. C = =
  57. C = CREATION : creation 3/5/90 =
  58. C = MODIF ONDEL : 24/9/90 =
  59. C = DPI NON EGAL A 8*TAN(1.) !!!!: 24/1/91 =
  60. C = AJOUT DE 20 S A LA DUREE : 29/1/91 =
  61. C = MESSAGE D'ERREUR : 15/9/91 =
  62. C = PROGRAMMEUR : P.P. =
  63. C=======================================================================
  64. C
  65. CHARACTER *72 TI
  66. CHARACTER*12 MOTX,MOTY
  67. C
  68. PARAMETER (NMOCLE=13)
  69. CHARACTER*4 MOTCLE(NMOCLE)
  70. LOGICAL LPERIO,LUSER
  71. LOGICAL LONDEL
  72. C
  73. -INC CCGEOME
  74. -INC CCOPTIO
  75. -INC SMEVOLL
  76. -INC SMLREEL
  77. POINTEUR MLREK2.MLREEL
  78. C
  79. DIMENSION XLTI(3)
  80. SEGMENT MTRAV
  81. INTEGER IFREQ(2,NBFREQ)
  82. REAL*8 F(NSPTOM),S(NSPTOM), T(NT), RES(NT)
  83. REAL*8 XLSTAT(3,NBFREQ)
  84. REAL*8 XMTK2(NBFREQ,IPROC)
  85. C REAL*8 XLTIME(NTIME,3)
  86. ENDSEGMENT
  87. C======+++++++++++ bon fontionnement erreur PSRS/PRNS +++++++++++ ======
  88. SEGMENT,MMTRA
  89. REAL*8 XLTIME(NNT,3)
  90. ENDSEGMENT
  91. C======+++++++++++ bon fontionnement erreur PSRS/PRNS +++++++++++ ======
  92. SEGMENT MONDE
  93. REAL*8 XPAS(NBFREQ)
  94. c* POINTEUR IMTK2(NBFREQ).MLREEL
  95. INTEGER IMTK2(NBFREQ)
  96. ENDSEGMENT
  97. C
  98. C 1) LECTURE DES DONNEES GIBIANE
  99. C
  100. C 1.1) LISTE DES MOTS CLEF
  101. C
  102. DATA MOTCLE/'PERI','FREQ','ACCE','VITE','DEPL',
  103. > 'NBDE','NBPR','NBIN','PREC','NEG1','NEG2',
  104. > 'ONDE','TPLU'/
  105. C
  106. C 1.2) DEFAUTS
  107. C (MCLE: "'PERI'->LPERIO, 'ACCE'->IGRAND, 'NEWG'->IDISTR)
  108. C
  109. LPERIO=.TRUE.
  110. IGRAND=1
  111. IDISTR=2
  112. C
  113. IPROC=0
  114. IINT=0
  115. AMOR=0.05D0
  116. XRREUR=1.D-3
  117. TPL=20.D0
  118. C
  119. LONDEL=.FALSE.
  120. C
  121. C 1.3) LECTURE DE L'OBJET EVOLUTIO CONTENANT LE "POWER SPECTRUM"
  122. C
  123. CALL LIROBJ('EVOLUTIO',IPPS,1,IRET)
  124. IF(IRET.EQ.0) GOTO 666
  125. C
  126. C 1.4) LECTURE DE L'OBJET EVOLUTIO CONTENANT LES FONCTIONS DE MODULATIONS
  127. C
  128. CALL LIROBJ('EVOLUTIO',IPMOD,1,IRET)
  129. IF(IRET.EQ.0) GOTO 666
  130. C
  131. C 1.5) LECTURE DE L'OBJET LISTREEL CONTENANT LES FREQUENCES
  132. C
  133. CALL LIROBJ('LISTREEL',IPFRE,1,IRET)
  134. IF(IRET.EQ.0) GOTO 666
  135. C
  136. C 1.6) LECTURE DE L'OBJET LISTREEL DONNANT LE TABLEAU DES PERIODES
  137. C DEFINI PAR L'UTILISATEUR (OPTIONEL)
  138. C
  139. CALL LIROBJ('LISTREEL',IPREET,0,IRET)
  140. IF(IRET.EQ.0)THEN
  141. LUSER=.FALSE.
  142. ELSE
  143. LUSER=.TRUE.
  144. ENDIF
  145. C
  146. C 1.7) LECTURE DU REEL DONNANT L'AMORTISSEMENT (OPTIONEL)
  147. C
  148. CALL LIRREE(AMOR1,0,IRET)
  149. IF(IRET.NE.0)THEN
  150. ENDIF
  151. C
  152. C 1.8) LECTURE DES MOTS MCL1, MCL2, MCL3, MCL4 ...ET DE LA COULEUR
  153. C (OPTIONEL)
  154. C
  155. * 1 CALL LIRMO2(MOTCLE,NMOCLE,IVAL,
  156. * > NCOUL ,NBCOUL,ICOUL,0)
  157. C
  158. 1 CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0)
  159. CALL LIRMOT(NCOUL,NBCOUL,ICOUL,0)
  160. if (icoul.eq.0) icoul=idcoul+1
  161. icoul=icoul-1
  162. C
  163. IF(IVAL.EQ.0)GOTO 9
  164. GOTO(2,3,4,4,4,1,5,6,7,8,8,881,882),IVAL
  165. C ---> "MCL2"
  166. 2 LPERIO=.TRUE.
  167. GOTO 1
  168. 3 LPERIO=.FALSE.
  169. GOTO 1
  170. C ---> "MCL1" 1->ACCE, 2->VITE, 3->DEPL
  171. 4 IGRAND=IVAL-2
  172. GOTO 1
  173. C ---> "MCL4" 1->NBDE, 2->NBPR, 3->NBIN
  174. 5 CALL LIRENT(IPROC,1,IRET)
  175. IF(IRET.EQ.0) GOTO 666
  176. GOTO 1
  177. 6 CALL LIRENT(IINT,1,IRET)
  178. IF(IRET.EQ.0) GOTO 666
  179. GOTO 1
  180. 7 CALL LIRREE(XRREUR,1,IRET)
  181. IF(IRET.EQ.0) GOTO 666
  182. GOTO 1
  183. C ---> "MCL3" 1->NEG1, 2->NEG2
  184. 8 IDISTR=IVAL-9
  185. GOTO 1
  186. C ---> "MCL5" ONDELETTE...
  187. 881 LONDEL=.TRUE.
  188. CALL LIRREE(DTBASE,1,IRET)
  189. IF(IRET.EQ.0) GOTO 666
  190. GOTO 1
  191. C ---> "MCL4" 4->TPL
  192. 882 CALL LIRREE(TPL,1,IRET)
  193. IF(IRET.EQ.0) GOTO 666
  194. GOTO 1
  195. C
  196. C 1.9) "LECTURE" DE LA COULEUR
  197. C
  198. 9 IF(ICOUL.NE.0)GOTO 1
  199. C
  200. IF(IERR.NE.0) GOTO 666
  201. C WRITE(IOIMP,*)'FIN LECTURE'
  202. C
  203. C 2) VERIFICATION DE LA COHERENCE DES DONNEES M, FREQ ET PSNS
  204. C
  205. C 2.1) NB DE COURBE/NB D'INTERVALLE DE FREQUENCE
  206. C
  207. MEVOL2=IPMOD
  208. SEGACT MEVOL2
  209. NBFREQ=MEVOL2.IEVOLL(/1)
  210.  
  211. MLREE3=IPFRE
  212. SEGACT MLREE3
  213. NBFRE1=MLREE3.PROG(/1) -1
  214.  
  215. IF(NBFREQ.NE.NBFRE1)THEN
  216. CALL ERREUR(578)
  217. GOTO 665
  218. ENDIF
  219. C
  220. C 2.2) DEBUT ET FIN DES FONCTIONS DE MODULATION
  221. C
  222. KEVOLL=MEVOL2.IEVOLL(1)
  223. SEGACT KEVOLL
  224. MLREEL=IPROGX
  225. SEGACT MLREEL
  226. TINI=PROG(1)
  227. TFIN=PROG(PROG(/1))
  228. SEGDES MLREEL
  229. SEGDES KEVOLL
  230.  
  231. IF (NBFREQ.GT.1)THEN
  232. DO 10 IE1=2,NBFREQ
  233. KEVOLL=MEVOL2.IEVOLL(IE1)
  234. SEGACT KEVOLL
  235. MLREEL=IPROGX
  236. SEGACT MLREEL
  237. TINI1=PROG(1)
  238. TFIN1=PROG(PROG(/1))
  239. SEGDES MLREEL
  240. SEGDES KEVOLL
  241. IF((ABS(TINI-TINI1)+ABS(TFIN-TFIN1)).GT.1.D-5)THEN
  242. CALL ERREUR(579)
  243. GOTO 665
  244. ENDIF
  245. 10 CONTINUE
  246. ENDIF
  247. TE=TFIN-TINI
  248. C
  249. C 2.3) INTERVALLE DE FREQUENCE DU SPECTRE DE PUISSANCE
  250. C
  251. FRMI=MLREE3.PROG(1)
  252. FRMA=MLREE3.PROG(NBFREQ+1)
  253.  
  254. MEVOL1=IPPS
  255. SEGACT MEVOL1
  256. KEVOL1=MEVOL1.IEVOLL(1)
  257. SEGACT KEVOL1
  258. C
  259. IF(ICOUL.EQ.0) ICOUL=KEVOL1.NUMEVX
  260. C
  261. MLREE1=KEVOL1.IPROGX
  262. MLREE2=KEVOL1.IPROGY
  263. SEGACT MLREE1
  264. FRMI1=MLREE1.PROG(1)
  265. NBSPEC=MLREE1.PROG(/1)
  266. FRMA1=MLREE1.PROG(NBSPEC)
  267. IF(.NOT.LONDEL)THEN
  268. IF ((ABS(FRMI-FRMI1)+ABS(FRMA-FRMA1)).GT.1.D-5)THEN
  269. CALL ERREUR(580)
  270. GOTO 664
  271. ENDIF
  272. ENDIF
  273. C
  274. C 2.4) VERIFICATION SPECIFIQUE DU CALCUL EN ONDELETTE
  275. C -NB DE BANDE DE FREQUENCE
  276. C -REPARTITION DES BANDES PAR OCTAVE
  277. C -DETERMINATION DU PAS DE TEMPS D'IDENTIFICATION
  278. C
  279. IF(LONDEL)THEN
  280. C
  281. IF(NBSPEC.NE.NBFREQ)THEN
  282. CALL ERREUR(581)
  283. GOTO 664
  284. ENDIF
  285. C
  286. FREQBA=MLREE3.PROG(2)
  287. FREQB=FREQBA
  288. DO 800 IE1=2,NBFREQ
  289. FFREQ=MLREE3.PROG(IE1+1)-MLREE3.PROG(IE1)
  290. IF (ABS(FFREQ-FREQB)/FREQB.GT.1.D-5)THEN
  291. CALL ERREUR(582)
  292. GOTO 664
  293. ENDIF
  294. FREQC=3*FREQB/2
  295. IF(ABS(MLREE1.PROG(IE1)-FREQC)/FREQC.GT.1.D-5)THEN
  296. CALL ERREUR(583)
  297. GOTO 664
  298. ENDIF
  299. FREQB=FREQB*2
  300. 800 CONTINUE
  301. C
  302. SEGINI, MONDE
  303. DDXMXP=0.D0
  304. DO 805 IE1=1,NBFREQ
  305. KEVOLL=MEVOL2.IEVOLL(IE1)
  306. SEGACT KEVOLL
  307. MLREEL=IPROGX
  308. SEGACT MLREEL
  309. DDXMAX=0.D0
  310. DO 801 IE2=2,PROG(/1)
  311. DDMMA=PROG(IE2)-PROG(IE2-1)
  312. IF(DDMMA.GT.DDXMAX)DDXMAX=DDMMA
  313. 801 CONTINUE
  314. ITE=INT(TE/DDXMAX+1.D-5)
  315. TTEST=TE-ITE*DDXMAX
  316. ITE=INT(DDXMXP/DDXMAX+1.D-5)
  317. TTEST=TTEST+DDXMXP-ITE*DDXMAX
  318. IF((ABS(TTEST).GT.2.D-5).OR.(ITE.GT.2))THEN
  319. INTERR(1)=IE1
  320. CALL ERREUR(584)
  321. DDXMAX=0.D0
  322. DO 802 IE2=2,PROG(/1)
  323. DDXMAX=DDXMAX+(PROG(IE2)-PROG(IE2-1))
  324. ITE=INT(TE/DDXMAX+1.D-5)
  325. TTEST=TE-ITE*DDXMAX
  326. ITE=INT(DDXMXP/DDXMAX+1.D-5)
  327. TTEST=TTEST+DDXMXP-ITE*DDXMAX
  328. IF((ABS(TTEST).LE.2.D-5).AND.(ITE.LE.2))GOTO 803
  329. 802 CONTINUE
  330. CALL ERREUR(485)
  331. GOTO 663
  332. 803 CONTINUE
  333. ENDIF
  334. XPAS(IE1)=DDXMAX
  335. DDXMXP=DDXMAX
  336. SEGDES MLREEL
  337. SEGDES KEVOLL
  338. 805 CONTINUE
  339. C
  340. ENDIF
  341. C WRITE(IOIMP,*)'FIN VERIFICATION DES DONNEES'
  342. C
  343. C 3) CALCUL DES BORNES DE LA ZONE DE TRAVAIL
  344. C
  345. C SPECTRE DE PUISSANCE + BORNE DE FREQUENCE
  346. C NOMBRE D'OSCILLATEUR POUR LA REPONSE
  347. C NOMBRE DE POINT D'EVALUATION EN TEMPS
  348. C
  349. NSPT=MLREE1.PROG(/1)
  350. NSPTOM=NSPT+NBFREQ-1
  351. C
  352. IF(LONDEL)NSPTOM=NSPTOM+1
  353. C
  354. IF (LUSER)THEN
  355. MLREEL=IPREET
  356. SEGACT MLREEL
  357. NT=PROG(/1)
  358. SEGDES MLREEL
  359. ELSE
  360. NT=75
  361. ENDIF
  362. C
  363. IF (IPROC.EQ.0)THEN
  364. IPROC=INT((TE-1.D-5)/2)+1
  365. ENDIF
  366. IF (IINT.EQ.0)THEN
  367. IINT=10
  368. ENDIF
  369. NTIME=IPROC*IINT+1
  370. IF(LONDEL)THEN
  371. NNTIME=INT(TE/XPAS(NBFREQ)+1.D-5)+1
  372. IF(NNTIME.LT.NTIME)THEN
  373. MMULT=INT(LOG(DBLE((NTIME-1)/(NNTIME-1)))/LOG(2.D0)+1.D-5)
  374. MMULT=2**MMULT
  375. NTIME=MMULT*(NNTIME-1)+1
  376. IPROC=1
  377. ELSE
  378. NTIME=NNTIME
  379. ENDIF
  380. ENDIF
  381. DTIME=TE/(NTIME-1)
  382. C
  383. NTIMEP=INT(TPL/DTIME +1.D-5)
  384. NTIME=NTIME+NTIMEP
  385. C WRITE(IOIMP,*)'FIN CALCUL DES BORNES DE LA ZONE DE TRAVAIL'
  386. C
  387. C 4) REMPLISSAGE DES TABLEAUX DE TRAVAIL
  388. C
  389. NNT=NTIME
  390. SEGINI,MTRAV,MMTRA
  391. C
  392. C 4.1) INDICE MIN/MAX DES BANDES DE FREQUENCE (ON PREVOIT D'INTERCALER
  393. C DES POINTS)
  394. C CALCUL DU NOMBRE DE POINT POUR F ET S
  395. C CHARGEMENT DES POINTS POUR F ET S
  396. C
  397. SEGACT MLREE2
  398. C
  399. IF(LONDEL)THEN
  400. C
  401. DO 810 IE1=1,NBFREQ
  402. IFREQ(1,IE1)=2*IE1-1
  403. IFREQ(2,IE1)=2*IE1
  404. F(2*IE1-1) =MLREE3.PROG(IE1)
  405. F(2*IE1 ) =MLREE3.PROG(IE1+1)
  406. S(2*IE1-1) =MLREE2.PROG(IE1)
  407. S(2*IE1 ) =MLREE2.PROG(IE1)
  408. 810 CONTINUE
  409. C
  410. ELSE
  411. C
  412. IFREQ(1,1)=1
  413. IF(NBFREQ.EQ.1)THEN
  414. IFREQ(2,1)=NSPT
  415. NSPTOT=NSPT
  416. DO 101 IE1=1,NSPTOT
  417. F(IE1)=MLREE1.PROG(IE1)
  418. S(IE1)=MLREE2.PROG(IE1)
  419. 101 CONTINUE
  420. ELSE
  421. IESP=2
  422. IPTSUP=0
  423. F(1)=MLREE1.PROG(1)
  424. S(1)=MLREE2.PROG(1)
  425. DO 13 IE1=2,NBFREQ
  426. FRM =MLREE3.PROG(IE1)
  427. DO 11 IE3=1,NSPT
  428. FRPS=MLREE1.PROG(IESP)
  429. IF(FRPS.GT.(FRM-1.D-5)) GOTO 12
  430. F(IESP+IPTSUP)=FRPS
  431. S(IESP+IPTSUP)=MLREE2.PROG(IESP)
  432. IESP=IESP+1
  433. 11 CONTINUE
  434. 12 IF(FRPS.GT.(FRM+1.D-5))THEN
  435. F(IESP+IPTSUP)=FRM
  436. S(IESP+IPTSUP)=MLREE2.PROG(IESP)
  437. > - (FRPS-FRM)/(FRPS-MLREE1.PROG(IESP-1))
  438. > *(MLREE2.PROG(IESP)-MLREE2.PROG(IESP-1))
  439. IFREQ(2,IE1-1)=IESP+IPTSUP
  440. IFREQ(1,IE1 )=IESP+IPTSUP
  441. IPTSUP=IPTSUP+1
  442. ELSE
  443. F(IESP+IPTSUP)=FRPS
  444. S(IESP+IPTSUP)=MLREE2.PROG(IESP)
  445. IFREQ(2,IE1-1)=IESP+IPTSUP
  446. IFREQ(1,IE1 )=IESP+IPTSUP
  447. IESP=IESP+1
  448. ENDIF
  449. 13 CONTINUE
  450. NSPTOT=NSPT+IPTSUP
  451. IFREQ(2,NBFREQ)=NSPTOT
  452. DO 14 IE1=IESP,NSPT
  453. F(IE1+IPTSUP)=MLREE1.PROG(IE1)
  454. S(IE1+IPTSUP)=MLREE2.PROG(IE1)
  455. 14 CONTINUE
  456. ENDIF
  457. C
  458. ENDIF
  459. C
  460. SEGDES MLREE1
  461. SEGDES MLREE2
  462. SEGDES MEVOL1
  463. SEGDES MLREE3
  464. C
  465. C 4.1-BIS) INDICE MIN, LARGEUR DE BANDE DANS IFREQ
  466. C
  467. DO 15 IE1=1,NBFREQ
  468. IFREQ(2,IE1)=IFREQ(2,IE1)-IFREQ(1,IE1) + 1
  469. 15 CONTINUE
  470. C
  471. C 4.2) ON REMPLIT LE TABLEAU DES PERIODES
  472. C
  473. IF (LUSER)THEN
  474. MLREEL=IPREET
  475. SEGACT MLREEL
  476. DO 20 I=1,NT
  477. T(I)=PROG(I)
  478. 20 CONTINUE
  479. SEGDES MLREEL
  480. ELSE
  481. TINF=.04D0
  482. UNPXI=EXP((LOG(TE)-LOG(TINF))/(NT-1))
  483. T(1)=TINF
  484. DO 21 I=2,NT
  485. 21 T(I)=T(I-1)*UNPXI
  486. T(NT)=TE
  487. ENDIF
  488. C
  489. C 4.3) ON REMPLIT XLTIME (INTERPOLATION DES MK A TR)
  490. C
  491. IF(LONDEL)THEN
  492. C
  493. DDT=DTBASE
  494. DO 817 IE1=1,NBFREQ
  495. KEVOLL=MEVOL2.IEVOLL(IE1)
  496. SEGACT, KEVOLL
  497. MLREE1=IPROGX
  498. MLREE2=IPROGY
  499. SEGACT, MLREE1,MLREE2
  500. DDXMAX=XPAS(IE1)
  501. NNNI=INT(DDXMAX/DDT+1.D-5)
  502. JG=INT(TE/DDXMAX+1.D-5)
  503. C** SEGINI, IMTK2(IE1)
  504. SEGINI,MLREK2
  505. IMTK2(IE1) = MLREK2
  506. TR=TINI
  507. INDICE=2
  508. XTIN=MLREE1.PROG(INDICE-1)
  509. XTOU=MLREE1.PROG(INDICE)
  510. XMIN=MLREE2.PROG(INDICE-1)
  511. RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN)
  512. DO 816 IE2=1,JG
  513. VMTK2=0.D0
  514. DO 815 IE3=1,NNNI
  515. TR=TR+DDT
  516. IF (TR.GT.(XTOU+1.E-5))THEN
  517. INDICE=INDICE+1
  518. XTOU=MLREE1.PROG(INDICE)
  519. XTIN=MLREE1.PROG(INDICE-1)
  520. XMIN=MLREE2.PROG(INDICE-1)
  521. RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN)
  522. ENDIF
  523. VMTK2=VMTK2+(XMIN + RATE *(TR-XTIN))**2
  524. 815 CONTINUE
  525. C** IMTK2(IE1).PROG(IE2)=VMTK2/NNNI
  526. MLREK2.PROG(IE2)=VMTK2/NNNI
  527. 816 CONTINUE
  528. IF(IE1.GT.1)DDT=DDT/2
  529. SEGDES MLREE1
  530. SEGDES MLREE2
  531. SEGDES KEVOLL
  532. 817 CONTINUE
  533. C
  534. ELSE
  535. C
  536. DPROC=TE/IPROC
  537. DO 26 IE1=1,NBFREQ
  538. KEVOLL=MEVOL2.IEVOLL(IE1)
  539. SEGACT KEVOLL
  540. MLREE1=IPROGX
  541. MLREE2=IPROGY
  542. SEGACT MLREE1
  543. SEGACT MLREE2
  544. INDICE=2
  545. XTIN=MLREE1.PROG(INDICE-1)
  546. XTOU=MLREE1.PROG(INDICE)
  547. XMIN=MLREE2.PROG(INDICE-1)
  548. RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN)
  549. DO 25 IE2=1,IPROC
  550. TR=TINI+(IE2-0.5D0)*DPROC
  551. IF (TR.GT.(XTOU+1.E-5))THEN
  552. DO 251 IE3=INDICE,MLREE1.PROG(/1)
  553. INDICE=INDICE+1
  554. XTOU=MLREE1.PROG(INDICE)
  555. IF (TR.LE.(XTOU+1.E-5))GOTO 252
  556. 251 CONTINUE
  557. 252 XTIN=MLREE1.PROG(INDICE-1)
  558. XMIN=MLREE2.PROG(INDICE-1)
  559. RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN)
  560. ENDIF
  561. XMTK2(IE1,IE2)=(XMIN + RATE *(TR-XTIN))**2
  562. 25 CONTINUE
  563. SEGDES MLREE1
  564. SEGDES MLREE2
  565. SEGDES KEVOLL
  566. 26 CONTINUE
  567. C
  568. ENDIF
  569. C
  570. SEGDES MEVOL2
  571. C
  572. C 5) CALCUL
  573. C
  574. C 5.1) BOUCLE SUR LES PERIODES
  575. C
  576. INEWT=0
  577. C
  578. DPI=8.D0*ATAN(1.D0)
  579. DO 50 IE1=1,NT
  580. FRQ=1/T(IE1)
  581. WN=FRQ*DPI
  582. C WRITE(IOIMP,*)'BOUCLE PERIODE IT ',IE1
  583. C
  584. C 5.2) CALCUL DES MOMENTS STATIQUES
  585. C
  586. DO 30 IE2=1,NBFREQ
  587. CALL MOMENT(FRQ,AMOR,TE,
  588. > IFREQ(2,IE2),F(IFREQ(1,IE2)),S(IFREQ(1,IE2)) ,IGRAND,
  589. > XLSTAT(1,IE2),XLSTAT(2,IE2),XLSTAT(3,IE2) )
  590. 30 CONTINUE
  591. C WRITE(IOIMP,*)'BOUCLE PERIODE CALCUL DES MOMENTS STATIQUES'
  592. C
  593. C 5.3) CALCUL DES MOMENT AU COURS DU TEMPS
  594. C PAR CONTRIBUTION DES PROCESSUS ELEMENTAIRES
  595. C
  596. C 5.3.1) MISE A ZERO
  597. C
  598. DO 35 IE2=1,3
  599. DO 35 IE3=1,NTIME
  600. XLTIME(IE3,IE2)=0.D0
  601. 35 CONTINUE
  602. C
  603. IF(.NOT.LONDEL)THEN
  604. C
  605. C 5.3.2) BOUCLE SUR LES PROCESSUS
  606. C
  607. ROTMA=1-EXP(-2*WN*AMOR*DPROC)
  608. DO 40 IE2=1,IPROC
  609. TPROCD=TINI + (IE2-1)*DPROC
  610. TPROCF=TPROCD+DPROC
  611. C
  612. C 5.3.3) SOMME M(TK)*S*H
  613. DO 36 IE3=1,3
  614. XLTI(IE3)=0.D0
  615. DO 36 IE4=1,NBFREQ
  616. XLTI(IE3)=XLTI(IE3) + XMTK2(IE4,IE2)*XLSTAT(IE3,IE4)
  617. 36 CONTINUE
  618. C
  619. C 5.3.4) FONCTION DE PONDERATION DE H...
  620. C
  621. INDOC=(IE2-1)*IINT + 1
  622. INDOCM=INDOC+IINT
  623. DO 38 IE3=INDOC,NTIME
  624. TTDT=(IE3-1)*DTIME
  625. INDT=IE3
  626. IF (INDT.LE.INDOCM)THEN
  627. ROT=1-EXP(-2*WN*AMOR*(TTDT-TPROCD))
  628. ELSE
  629. ROT=EXP(-2*WN*AMOR*(TTDT-TPROCF))
  630. > -EXP(-2*WN*AMOR*(TTDT-TPROCD))
  631. C
  632. IF((ROT/ROTMA).LT.1.D-3)GOTO 40
  633. C
  634. ENDIF
  635. C 5.3.5) ... ET CONTRIBUTION LAMBDA(T)
  636. C
  637. DO 38 IE4=1,3
  638. XLTIME(INDT,IE4)=XLTIME(INDT,IE4)+
  639. > ROT*XLTI(IE4)
  640. 38 CONTINUE
  641. 40 CONTINUE
  642. C
  643. ELSE
  644. C
  645. C
  646. C 5.3.2.o) BOUCLE SUR LES FREQUENCE
  647. C
  648. DO 823 IE2=1,NBFREQ
  649. C* IPROC=IMTK2(IE2).PROG(/1)
  650. MLREK2 = IMTK2(IE2)
  651. IPROC = MLREK2.PROG(/1)
  652. DPROC=XPAS(IE2)
  653. IINT=INT(DPROC/DTIME+1.D-5)
  654. ROTMA=1-EXP(-2*WN*AMOR*DPROC)
  655. C
  656. C 5.3.2.o) BOUCLE SUR LES PROCESSUS
  657. C
  658. DO 822 IE3=1,IPROC
  659. TPROCD=TINI + (IE3-1)*DPROC
  660. TPROCF=TPROCD+DPROC
  661. C
  662. C 5.3.3.o) PRODUIT M(TK)*S*H
  663. C
  664. SI2I3 = MLREK2.PROG(IE3)
  665. DO 820 IE4=1,3
  666. C** XLTI(IE4)=IMTK2(IE2).PROG(IE3)*XLSTAT(IE4,IE2)
  667. XLTI(IE4) = SI2I3 * XLSTAT(IE4,IE2)
  668. 820 CONTINUE
  669. C
  670. C 5.3.4.o) FONCTION DE PONDERATION DE H...
  671. C
  672. INDOC=(IE3-1)*IINT + 1
  673. INDOCM=INDOC+IINT
  674. DO 821 IE4=INDOC,NTIME
  675. TTDT=(IE4-1)*DTIME
  676. INDT=IE4
  677. IF (INDT.LE.INDOCM)THEN
  678. ROT=1-EXP(-2*WN*AMOR*(TTDT-TPROCD))
  679. ELSE
  680. ROT=EXP(-2*WN*AMOR*(TTDT-TPROCF))
  681. > -EXP(-2*WN*AMOR*(TTDT-TPROCD))
  682. C
  683. IF((ROT/ROTMA).LT.1.D-3)GOTO 822
  684. C
  685. ENDIF
  686. C 5.3.5.o) ... ET CONTRIBUTION LAMBDA(T)
  687. C
  688. DO 821 IE5=1,3
  689. XLTIME(INDT,IE5)=XLTIME(INDT,IE5)+
  690. > ROT*XLTI(IE5)
  691. 821 CONTINUE
  692. 822 CONTINUE
  693. 823 CONTINUE
  694. C
  695. ENDIF
  696. C WRITE(IOIMP,*)'BOUCLE PERIODE CALCUL DES MOMENTS EN TEMPS'
  697. C
  698. C 5.4) CALCUL DU RESPONSE SPECTRA
  699. C
  700. CALL DISTRT(MMTRA, NTIME, DTIME, DPI,
  701. > TE, IDISTR,XRREUR, VALMAX ,IOK ,INEW)
  702. RES(IE1)=VALMAX
  703. IF(IOK.NE.0)THEN
  704. IF(IOK.LT.100)THEN
  705. SEGSUP MTRAV,MMTRA
  706. GOTO 666
  707. ENDIF
  708. ENDIF
  709. C
  710. INEWT=INEWT+INEW
  711. 50 CONTINUE
  712. C WRITE(IOIMP,*)'FIN CALCUL DES RESULTATS'
  713. C
  714. IF(IIMPI.EQ.1)WRITE(IOIMP,*)'NB DE CALCUL DE LA DISTRIBUTION='
  715. > ,INEWT
  716. C
  717. C 6) STOCKAGE DES RESULTAT
  718. C
  719. C 6.1) ABSISSE EN PERIODE OU EN FREQUENCE
  720. C
  721. IF(LPERIO.AND.LUSER)THEN
  722. MLREE1=IPREET
  723. MOTX='PERIODE'
  724. ELSE
  725. JG=NT
  726. SEGINI MLREE1
  727. IF(LPERIO)THEN
  728. DO 60 I=1,NT
  729. MLREE1.PROG(I)=T(I)
  730. 60 CONTINUE
  731. MOTX='PERIODE'
  732. ELSE
  733. DO 61 I=1,NT
  734. MLREE1.PROG(NT-I+1)=1/T(I)
  735. 61 CONTINUE
  736. MOTX='FREQUENCE'
  737. ENDIF
  738. SEGDES MLREE1
  739. ENDIF
  740. C
  741. C 6.2) LEGENDE (PARTIELLE) DES ORDONNEES
  742. C
  743. MOTY(1:10)='RSPE-'//MOTCLE(2+IGRAND)//' '
  744. C
  745. C 6.3) CREATION DE L'OBJET EVOLUTIO RSNS
  746. C
  747. N=1
  748. SEGINI MEVOLL
  749. IPVO=MEVOLL
  750. TI(1:72)=TITREE
  751. IEVTEX=TI
  752. WRITE(TI(64:72),'(A5,I4)')INEWT
  753. ITYEVO='REEL'
  754. C
  755. SEGINI KEVOLL
  756. C
  757. WRITE(TI,100)AMOR
  758. 100 FORMAT(1X,'AMORTISSEMENT DE ',1PD12.5)
  759. KEVTEX=TI
  760. C
  761. IEVOLL(1)=KEVOLL
  762. TYPX='LISTREEL'
  763. TYPY='LISTREEL'
  764. C
  765. IPROGX=MLREE1
  766. NOMEVX=MOTX(1:12)
  767. C
  768. JG=NT
  769. SEGINI MLREE2
  770. IF(LPERIO)THEN
  771. DO 62 I=1,NT
  772. MLREE2.PROG(I)=RES(I)
  773. 62 CONTINUE
  774. ELSE
  775. DO 63 I=1,NT
  776. MLREE2.PROG(NT-I+1)=RES(I)
  777. 63 CONTINUE
  778. ENDIF
  779. SEGDES MLREE2
  780. IPROGY=MLREE2
  781. MOTY(11:12)=' 1'
  782. NOMEVY=MOTY(1:12)
  783. C
  784. NUMEVX=ICOUL
  785. NUMEVY='REEL'
  786. C
  787. SEGDES KEVOLL
  788. SEGDES MEVOLL
  789. C
  790. C 7) DESTRUCTION DE LA ZONE DE TRAVAIL ET RETOUR A GIBIANE
  791. C
  792. SEGSUP MTRAV,MMTRA
  793. IF(LONDEL)THEN
  794. DO 890 IE1=1,NBFREQ
  795. C** SEGSUP, IMTK2(IE1)
  796. MLREK2 = IMTK2(IE1)
  797. SEGSUP,MLREK2
  798. 890 CONTINUE
  799. SEGSUP, MONDE
  800. ENDIF
  801. C
  802. CALL ECROBJ('EVOLUTIO',IPVO)
  803. C
  804. RETURN
  805. C
  806. 663 SEGSUP MONDE
  807. SEGDES MLREEL
  808. SEGDES KEVOLL
  809. 664 SEGDES MLREE1
  810. SEGDES KEVOL1
  811. SEGDES MEVOL1
  812. 665 SEGDES MEVOL2
  813. SEGDES MLREE3
  814. 666 CONTINUE
  815. RETURN
  816. END
  817.  
  818.  
  819.  
  820.  
  821.  
  822.  
  823.  
  824.  
  825.  
  826.  
  827.  
  828.  

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