Télécharger siar.eso

Retour à la liste

Numérotation des lignes :

siar
  1. C SIAR SOURCE CHAT 05/01/13 03:15:54 5004
  2. SUBROUTINE SIAR
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C OPERATEUR SIAR
  7. C
  8. C A*EVOLUTION ET/OU V*EVOLUTION ET/OU D*EVOLUTION
  9. C
  10. C = SIAR PSNS*EVOLUTION
  11. C
  12. C (M*EVOLUTION FREQ*LISTREEL (TFINAL*FLOTTANT))
  13. C OU (TFINAL*FLOTTANT)
  14. C
  15. C (OPTION*MOT (TT*FLOTTANT OU II*ENTIER))
  16. C=======================================================================
  17. C OPTION:
  18. C
  19. C OPTION='ACCE' OU 'VITE' OU 'DEPL' PERMET DE GENERER UNIQUEMENT
  20. C LE SIGNAL DU TYPE INDIQUE.
  21. C
  22. C OPTION='TINI' + TT PERMET D'INDIQUER UN AUTRE INSTANT INITIAL
  23. C QUE LE DEFAUT.
  24. C
  25. C OPTION='NPOI' + NN PERMET D'INDIQUER EXPLICITEMENT LE NOMBRE DE
  26. C POINTS EN TEMPS DU SIGNAL GENERE.
  27. C
  28. C OPTION='NSIN' + NN PERMET DE SPECIFIER LE NB DE SERIE GENEREES.
  29. C
  30. C OPTION='INIT' + NN PERMET D'INITIALISER LE GENERATEUR ALEATOIRE.
  31. C
  32. C OPTION='NCOU' + NN PERMET DE GENERER PLUSIEURS COURBES
  33. C=======================================================================
  34. C PROGRAMMEUR : P.P.
  35. C=======================================================================
  36. C
  37. CHARACTER *72 TI
  38. CHARACTER*12 MOTX,MOTY
  39. C
  40. PARAMETER (NMOCLE=9)
  41. CHARACTER*4 MOTCLE(NMOCLE)
  42. LOGICAL LACCE,LVITE,LDEPL,LMODU, LHARM
  43. C
  44.  
  45. -INC PPARAM
  46. -INC CCOPTIO
  47. -INC SMEVOLL
  48. -INC SMLREEL
  49. C
  50. POINTEUR IACCE.MLREEL,IVITE.MLREEL,IDEPL.MLREEL,ITEMP.MLREEL
  51. POINTEUR JACCE.MEVOLL,JVITE.MEVOLL,JDEPL.MEVOLL
  52. POINTEUR KACCE.KEVOLL,KVITE.KEVOLL,KDEPL.KEVOLL
  53. POINTEUR IPREQ.MLREEL,IPOWE.MLREEL
  54. SEGMENT MTRAV
  55. IMPLIED IFREQ(2,NBFREQ)
  56. IMPLIED F(NSINUS),SRAC(NSINUS),PHASE(NSINUS)
  57. ENDSEGMENT
  58. C
  59. C 1) LECTURE DES DONNEES GIBIANE
  60. C
  61. C 1.1) LISTE DES MOTS CLEF
  62. C
  63. DATA MOTCLE/'ACCE','VITE','DEPL','INIT','NCOU',
  64. > 'TINI','NPOI','NSIN','HARM'/
  65. C
  66. C 1.2) DEFAUTS
  67. C
  68. C
  69. LACCE=.FALSE.
  70. LVITE=.FALSE.
  71. LDEPL=.FALSE.
  72. C
  73. NCOURB=1
  74. INITRD=0
  75. NSINUS=0
  76. NPOINT=0
  77. TFINAL=0.D0
  78. TDEBUT=0.D0
  79. LHARM=.FALSE.
  80. C
  81. C 1.3) LECTURE DE L'OBJET EVOLUTIO CONTENANT LE "POWER SPECTRUM"
  82. C
  83. CALL LIROBJ('EVOLUTIO',IPPS,1,IRET)
  84. IF(IRET.EQ.0) GOTO 666
  85. C
  86. C 1.4) LECTURE CONDITIONNELLE DE L'OBJET EVOLUTIO CONTENANT
  87. C LES FONCTIONS DE MODULATIONS
  88. C
  89. CALL LIROBJ('EVOLUTIO',IPMOD,0,IRET)
  90. IF(IRET.EQ.0)THEN
  91. LMODU=.FALSE.
  92. ELSE
  93. LMODU=.TRUE.
  94. ENDIF
  95. C
  96. C 1.5) LECTURE DE L'OBJET LISTREEL CONTENANT LES FREQUENCES
  97. C CAS OU LMODU=.TRUE.
  98. C
  99. IF(LMODU)THEN
  100. CALL LIROBJ('LISTREEL',IPFRE,1,IRET)
  101. IF(IRET.EQ.0) GOTO 666
  102. C
  103. C 1.6) LECTURE DE L'OBJET FLOTTANT INDIQUANT TFINAL (OPTIONEL)
  104. C CAS OU LMODU=.TRUE.
  105. C
  106. CALL LIRREE(TFINA1,0,IRET)
  107. IF(IRET.NE.0)THEN
  108. TFINAL=TFINA1
  109. ENDIF
  110. C
  111. C 1.7) LECTURE DE L'OBJET FLOTTANT INDIQUANT TFINAL
  112. C CAS OU LMODU=.FALSE.
  113. C
  114. ELSE
  115. CALL LIRREE(TFINAL,1,IRET)
  116. IF(IRET.EQ.0) GOTO 666
  117. ENDIF
  118. C
  119. C 1.8) LECTURE DES MOTS-CLEF
  120. C (OPTIONEL)
  121. C
  122. 1 CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0)
  123. C
  124. IF(IVAL.EQ.0)GOTO 9
  125. GOTO(101,102,103,104,105,106,107,108,109),IVAL
  126. C ---> "ACCE"
  127. 101 LACCE=.TRUE.
  128. GOTO 1
  129. C ---> "VITE"
  130. 102 LVITE=.TRUE.
  131. GOTO 1
  132. C ---> "DEPL"
  133. 103 LDEPL=.TRUE.
  134. GOTO 1
  135. C ---> "INIT" + NN
  136. 104 CALL LIRENT(INITRD,1,IRET)
  137. IF(IRET.EQ.0) GOTO 666
  138. INITRD=-ABS(INITRD)
  139. GOTO 1
  140. C ---> "NCOU" + NN
  141. 105 CALL LIRENT(NCOURB,1,IRET)
  142. IF(IRET.EQ.0) GOTO 666
  143. GOTO 1
  144. C ---> "TINI" + XX
  145. 106 CALL LIRREE(TDEBUT,1,IRET)
  146. IF(IRET.EQ.0) GOTO 666
  147. GOTO 1
  148. C ---> "NPOI" + NN
  149. 107 CALL LIRENT(NPOINT,1,IRET)
  150. IF(IRET.EQ.0) GOTO 666
  151. GOTO 1
  152. C ---> "NSIN" + NN
  153. 108 CALL LIRENT(NSINUS,1,IRET)
  154. IF(IRET.EQ.0) GOTO 666
  155. GOTO 1
  156. C ---> "HARM"
  157. 109 LHARM=.TRUE.
  158. GOTO 1
  159. C
  160. 9 CONTINUE
  161. C
  162. C 2) VERIFICATION DE LA COHERENCE DES DONNEES M, FREQ ET PSNS
  163. C (SI LMODU=.TRUE.)
  164. C
  165. IF (LMODU)THEN
  166. C
  167. C 2.1) NB DE COURBE/NB D'INTERVALLE DE FREQUENCE
  168. C
  169. MEVOL2=IPMOD
  170. SEGACT MEVOL2
  171. NBFREQ=MEVOL2.IEVOLL(/1)
  172. C
  173. MLREE3=IPFRE
  174. SEGACT MLREE3
  175. NBFRE1=MLREE3.PROG(/1) -1
  176. C
  177. IF(NBFREQ.NE.NBFRE1)THEN
  178. SEGDES MEVOL2
  179. SEGDES MLREE3
  180. CALL ERREUR(578)
  181. GOTO 666
  182. ENDIF
  183. C
  184. C 2.2) DEBUT ET FIN DES FONCTIONS DE MODULATION
  185. C
  186. KEVOLL=MEVOL2.IEVOLL(1)
  187. SEGACT KEVOLL
  188. MLREEL=IPROGX
  189. SEGACT MLREEL
  190. TINI=PROG(1)
  191. TFIN=PROG(PROG(/1))
  192. SEGDES MLREEL
  193. SEGDES KEVOLL
  194. C
  195. IF (NBFREQ.GT.1)THEN
  196. DO 10 IE1=2,NBFREQ
  197. KEVOLL=MEVOL2.IEVOLL(IE1)
  198. SEGACT KEVOLL
  199. MLREEL=IPROGX
  200. SEGACT MLREEL
  201. TINI1=PROG(1)
  202. TFIN1=PROG(PROG(/1))
  203. SEGDES MLREEL
  204. SEGDES KEVOLL
  205. IF((ABS(TINI-TINI1)+ABS(TFIN-TFIN1)).GT.1.D-6)THEN
  206. SEGDES MEVOL2
  207. SEGDES MLREE3
  208. CALL ERREUR(579)
  209. GOTO 666
  210. ENDIF
  211. 10 CONTINUE
  212. ENDIF
  213. C
  214. FRMI1=MLREE3.PROG(1)
  215. FRMA1=MLREE3.PROG(NBFREQ+1)
  216. C
  217. ELSE
  218. NBFREQ=1
  219. TINI=0.D0
  220. TFIN=TFINAL
  221. ENDIF
  222. C
  223. TE=TFIN-TINI
  224. C
  225. C 2.3) INTERVALLE DE FREQUENCE DU SPECTRE DE PUISSANCE
  226. C
  227. MEVOL1=IPPS
  228. SEGACT MEVOL1
  229. KEVOL1=MEVOL1.IEVOLL(1)
  230. SEGACT KEVOL1
  231. C
  232. ICOUL=KEVOL1.NUMEVX
  233. C
  234. IPREQ=KEVOL1.IPROGX
  235. IPOWE=KEVOL1.IPROGY
  236. SEGACT IPREQ
  237. FRMI=IPREQ.PROG(1)
  238. NSPT=IPREQ.PROG(/1)
  239. FRMA=IPREQ.PROG(NSPT)
  240. C
  241. IF(LMODU)THEN
  242. C
  243. IF ((ABS(FRMI-FRMI1)+ABS(FRMA-FRMA1)).GT.1.D-6)THEN
  244. SEGDES IPREQ
  245. SEGDES KEVOL1
  246. SEGDES MEVOL1
  247. SEGDES MEVOL2
  248. SEGDES MLREE3
  249. CALL ERREUR(580)
  250. GOTO 666
  251. ENDIF
  252. ENDIF
  253. C
  254. C 2.4) INTERVALLE DE TEMPS
  255. C
  256. IF(TDEBUT.LT.(TINI-1.D-6))THEN
  257. CALL ERREUR(586)
  258. GOTO 666
  259. ELSEIF(TDEBUT.LT.TINI.OR.TDEBUT.EQ.0.D0)THEN
  260. TDEBUT=TINI
  261. ENDIF
  262. C
  263. IF(TFINAL.GT.(TFIN+1.D-6))THEN
  264. CALL ERREUR(587)
  265. GOTO 666
  266. ELSEIF(TFINAL.GT.TFIN.OR.TFINAL.EQ.0.D0)THEN
  267. TFINAL=TFIN
  268. ENDIF
  269. C
  270. TEF=TFINAL-TDEBUT
  271. C
  272. C 3) CALCUL DES BORNES ET DES DIFFERENTS DEFAUTS
  273. C
  274. C LACCE, LVITE ET LDEPL
  275. C SPECTRE DE PUISSANCE (NSINUS)
  276. C NOMBRE DE POINT D'EVALUATION EN TEMPS (NPOINT)
  277. C
  278. IF((.NOT.LACCE).AND.(.NOT.LVITE).AND.(.NOT.LDEPL))THEN
  279. LACCE=.TRUE.
  280. LVITE=.TRUE.
  281. LDEPL=.TRUE.
  282. ENDIF
  283. C
  284. C
  285. DT=1/(2*FRMA)
  286. NPOITT=INT((TE-1.D-6)/DT)+1
  287. NPOITB=((INT(100*(TEF-1.D-6)/TE)+1)*NPOITT)/100+1
  288. C
  289. IF(NPOINT.EQ.0)THEN
  290. NPOINT=NPOITB
  291. ELSE
  292. TEST=DBLE(NPOINT-NPOITB)/NPOITB
  293. IF(ABS(TEST).GT..1D0)THEN
  294. REAERR(1)=TEST
  295. CALL ERREUR(-280)
  296. ENDIF
  297. ENDIF
  298. DTEF=TEF/(NPOINT-1)
  299. C
  300. NN=INT(LOG(TE/DT)/LOG(2.D0)+1.D-6)
  301. TEFO=2**NN*DT
  302. NSINSB=INT(FRMA*TEFO-1.D-6)+1
  303. NSINSS=INT(NSINSB*FRMI/FRMA-1.D-6)+1
  304. FRMI1=NSINSS/DBLE(NSINSB)*FRMA
  305. NSINSB=NSINSB-NSINSS+1
  306. IF(NSINUS.EQ.0)THEN
  307. NSINUS=NSINSB
  308. FRMI=FRMI1
  309. DFR=(FRMA-FRMI)/(NSINUS-1)
  310. XDECA=1.D0
  311. ELSE
  312. TEST=DBLE(NSINUS-NSINSB)/NSINSB
  313. IF(ABS(TEST).GT..1D0)THEN
  314. REAERR(1)=TEST
  315. CALL ERREUR(-281)
  316. ENDIF
  317. DFR=(FRMA-FRMI)/NSINUS
  318. XDECA=0.5D0
  319. ENDIF
  320. C
  321. C 4) REMPLISSAGE DES TABLEAUX DE TRAVAIL "STATIQUES"
  322. C
  323. SEGINI MTRAV
  324. C
  325. C 4.1) INDICE MIN/MAX DES BANDES DE FREQUENCE
  326. C CHARGEMENT DES POINTS INTERPOLE POUR F ET S
  327. C
  328. SEGACT IPOWE
  329. DPI=8*ATAN(1.D0)
  330. PI=DPI/2
  331. C
  332. IFREQ(1,1)=1
  333. IF (LMODU)THEN
  334. IEFREQ=2
  335. FRM =MLREE3.PROG(IEFREQ)
  336. ELSE
  337. FRM=FRMA
  338. ENDIF
  339. IEF=2
  340. FR=IPREQ.PROG(IEF)
  341. DO 15 IE1=1,NSINUS
  342. F(IE1)=(IE1-XDECA)*DFR + FRMI
  343. DO 11 IE2=IEF,NSPT
  344. IF(F(IE1).GT.(FR+1.D-6))THEN
  345. FR=IPREQ.PROG(IE2+1)
  346. ELSE
  347. GOTO 12
  348. ENDIF
  349. 11 CONTINUE
  350. 12 IEF=IE2
  351. SS= IPOWE.PROG(IEF)-(FR-F(IE1))/(FR-IPREQ.PROG(IEF-1))
  352. > *(IPOWE.PROG(IEF)-IPOWE.PROG(IEF-1))
  353. SRAC(IE1)=SQRT(2*SS*DFR)
  354. DO 13 IE2=IEFREQ,NBFREQ+1
  355. IF(F(IE1).GT.(FRM+1.D-6))THEN
  356. FRM =MLREE3.PROG(IE2+1)
  357. IFREQ(2,IE2-1)=IE1-1
  358. IFREQ(1,IE2 )=IE1
  359. ELSE
  360. GOTO 14
  361. ENDIF
  362. 13 CONTINUE
  363. 14 IEFREQ=IE2
  364. 15 CONTINUE
  365. IFREQ(2,NBFREQ)=NSINUS
  366. SEGDES IPREQ
  367. SEGDES IPOWE
  368. SEGDES KEVOL1
  369. SEGDES MEVOL1
  370. IF(LMODU)SEGDES MLREE3
  371. C
  372. C 4.2) DETECTION DE BANDE VIDE
  373. C
  374. IF(NBFREQ.GT.1)THEN
  375. DO 16 IE1=2,NBFREQ
  376. IF(IFREQ(1,IE1).GT.IFREQ(2,IE1))THEN
  377. IFREQ(1,IE1)=0
  378. INTERR(1)=IE1
  379. ENDIF
  380. 16 CONTINUE
  381. ENDIF
  382. C
  383. C 4.3) ON REMPLIT LE TABLEAU DES TEMPS
  384. C
  385. JG=NPOINT
  386. SEGINI ITEMP
  387. TEF=TDEBUT
  388. DO 20 IE1=1,NPOINT
  389. ITEMP.PROG(IE1)=TEF
  390. TEF=TEF+DTEF
  391. 20 CONTINUE
  392. SEGDES ITEMP
  393. C
  394. C 4.4) INITIALISATION DES EVOLL RESULTATS
  395. C
  396. N=NCOURB
  397. IF(LACCE)THEN
  398. SEGINI JACCE
  399. TI='Signal en acceleration'
  400. JACCE.IEVTEX=TI
  401. ENDIF
  402. IF(LVITE)THEN
  403. SEGINI JVITE
  404. TI='Signal en vitesse'
  405. JVITE.IEVTEX=TI
  406. ENDIF
  407. IF(LDEPL)THEN
  408. SEGINI JDEPL
  409. TI='Signal en deplacement'
  410. JDEPL.IEVTEX=TI
  411. ENDIF
  412. C
  413. C 4.5) INITIALISATION DES PHASES (CAS HARMONIQUE)
  414. C
  415. IF(LHARM)THEN
  416. DO 25 IE1=1,NSINUS
  417. PHASE(IE1)=0.D0
  418. 25 CONTINUE
  419. ENDIF
  420. C
  421. C 5) LOOP SUR LES COURBES
  422. C
  423. MOTX='Temps(s)'
  424. DO 46 IE1=1,NCOURB
  425. C
  426. C 5.1) GENERATION DES PHASE (CAS ALEATOIRE)
  427. C
  428. IF(.NOT.LHARM)THEN
  429. DO 30 IE2=1,NSINUS
  430. PHASE(IE2)=TDRAN1(INITRD) * DPI
  431. 30 CONTINUE
  432. ENDIF
  433. C
  434. C 5.2) ETABLISSEMENT DES KEVOLL RESULTATS ET INITIALISATION DES REEL
  435. C
  436. JG=NPOINT
  437. IF(LACCE)THEN
  438. C
  439. SEGINI KACCE
  440. JACCE.IEVOLL(IE1)=KACCE
  441. C
  442. WRITE(TI,'(A22,1X,A6,1X,I2)')'Signal en acceleration',
  443. > 'numero',IE1
  444. WRITE(MOTY,'(9HAccelera.,1X,I2)')IE1
  445. SEGINI IACCE
  446. C
  447. KACCE.KEVTEX=TI
  448. KACCE.NUMEVX=ICOUL
  449. KACCE.NUMEVY='REEL'
  450. KACCE.TYPX='LISTREEL'
  451. KACCE.IPROGX=ITEMP
  452. KACCE.TYPY='LISTREEL'
  453. KACCE.IPROGY=IACCE
  454. KACCE.NOMEVY=MOTY(1:12)
  455. SEGDES KACCE
  456. C
  457. DO 31 IE2=1,NPOINT
  458. IACCE.PROG(IE2)=0.D0
  459. 31 CONTINUE
  460. ENDIF
  461. C
  462. IF(LVITE)THEN
  463. C
  464. SEGINI KVITE
  465. JVITE.IEVOLL(IE1)=KVITE
  466. C
  467. WRITE(TI,'(A17,1X,A6,1X,I2)')'Signal en vitesse',
  468. > 'numero',IE1
  469. WRITE(MOTY,'(9HVitesse ,1X,I2)')IE1
  470. SEGINI IVITE
  471. C
  472. KVITE.KEVTEX=TI
  473. KVITE.NUMEVX=ICOUL
  474. KVITE.NUMEVY='REEL'
  475. KVITE.TYPX='LISTREEL'
  476. KVITE.IPROGX=ITEMP
  477. KVITE.TYPY='LISTREEL'
  478. KVITE.IPROGY=IVITE
  479. KVITE.NOMEVY=MOTY(1:12)
  480. SEGDES KVITE
  481. C
  482. DO 32 IE2=1,NPOINT
  483. IVITE.PROG(IE2)=0.D0
  484. 32 CONTINUE
  485. ENDIF
  486. C
  487. IF(LDEPL)THEN
  488. C
  489. SEGINI KDEPL
  490. JDEPL.IEVOLL(IE1)=KDEPL
  491. C
  492. WRITE(TI,'(A21,1X,A6,1X,I2)')'Signal en deplacement',
  493. > 'numero',IE1
  494. WRITE(MOTY,'(9HDeplacem.,1X,I2)')IE1
  495. SEGINI IDEPL
  496. C
  497. KDEPL.KEVTEX=TI
  498. KDEPL.NUMEVX=ICOUL
  499. KDEPL.NUMEVY='REEL'
  500. KDEPL.TYPX='LISTREEL'
  501. KDEPL.IPROGX=ITEMP
  502. KDEPL.TYPY='LISTREEL'
  503. KDEPL.IPROGY=IDEPL
  504. KDEPL.NOMEVY=MOTY(1:12)
  505. SEGDES KDEPL
  506. C
  507. DO 33 IE2=1,NPOINT
  508. IDEPL.PROG(IE2)=0.D0
  509. 33 CONTINUE
  510. ENDIF
  511. C
  512. C 5.3) BOUCLE SUR LES BANDES DE FREQUENCE
  513. C
  514. DO 44 IE2=1,NBFREQ
  515. IF(IFREQ(1,IE2).EQ.0)GOTO 44
  516. IF(LMODU)THEN
  517. KEVOLL=MEVOL2.IEVOLL(IE2)
  518. SEGACT KEVOLL
  519. MLREE1=IPROGX
  520. MLREE2=IPROGY
  521. SEGACT MLREE1
  522. SEGACT MLREE2
  523. INDICE=2
  524. XTIN=MLREE1.PROG(INDICE-1)
  525. XTOU=MLREE1.PROG(INDICE)
  526. XMIN=MLREE2.PROG(INDICE-1)
  527. RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN)
  528. XMTK=XMIN
  529. ELSE
  530. XMTK=1.D0
  531. RATE=0.D0
  532. XTIN=TINI
  533. ENDIF
  534. C
  535. C 5.3bis) CONDITION INITIALE U=V=0 A T=TINI
  536. C
  537. IF(LVITE.OR.LDEPL)THEN
  538. XIVITE=0.D0
  539. IF (LDEPL) XIDEPL=0.D0
  540. DO 330 IE3=IFREQ(1,IE2),IFREQ(2,IE2)
  541. CCOS=COS(DPI*F(IE3)*TINI+PHASE(IE3))
  542. SSIN=SIN(DPI*F(IE3)*TINI+PHASE(IE3))
  543. XIVITE=XIVITE +XMTK*SRAC(IE3)/(DPI*F(IE3))*SSIN
  544. > +RATE*SRAC(IE3)/(DPI*F(IE3))**2*CCOS
  545. IF(LDEPL)THEN
  546. XIDEPL=XIDEPL -XMTK*SRAC(IE3)/(DPI*F(IE3))**2*CCOS
  547. > +2*RATE*SRAC(IE3)/(DPI*F(IE3))**3*SSIN
  548. ENDIF
  549. 330 CONTINUE
  550. ENDIF
  551.  
  552.  
  553. C
  554. C 5.4) BOUCLE SUR LE TEMPS ET INTERPOLATION DES M
  555. C
  556. TEF=TDEBUT
  557. DO 42 IE3=1,NPOINT
  558. IF(LMODU)THEN
  559. IF (TEF.GT.(XTOU+1.E-5))THEN
  560. DO 35 IE4=INDICE,MLREE1.PROG(/1)
  561. INDICE=INDICE+1
  562. IF(LDEPL)XTOTI=XTOU-XTIN
  563. XMIN=MLREE2.PROG(INDICE-1)
  564. XTOU=MLREE1.PROG(INDICE)
  565. XTIN=MLREE1.PROG(INDICE-1)
  566. RATEM=RATE
  567. RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN)
  568. RATEM=RATE-RATEM
  569. C
  570. C 5.4bis) DETERMINATION DES CONDITIONS DE RECOLAGES POUR L'INTEGRATION
  571. C NUMERIQUE
  572. C
  573. IF(LVITE.OR.LDEPL)THEN
  574. IF(LDEPL)XIDEPL=XIDEPL+XIVITE*XTOTI
  575. DO 331 IE5=IFREQ(1,IE2),IFREQ(2,IE2)
  576. CCOS=COS(DPI*F(IE5)*XTIN+PHASE(IE5))
  577. SSIN=SIN(DPI*F(IE5)*XTIN+PHASE(IE5))
  578. XIVITE=XIVITE
  579. > +RATEM*SRAC(IE5)/(DPI*F(IE5))**2*CCOS
  580. IF(LDEPL)THEN
  581. XIDEPL=XIDEPL
  582. > +2*RATEM*SRAC(IE5)/(DPI*F(IE5))**3*SSIN
  583. ENDIF
  584. 331 CONTINUE
  585. ENDIF
  586. C
  587. IF (TEF.LE.(XTOU+1.E-5))GOTO 36
  588. 35 CONTINUE
  589. 36 CONTINUE
  590. ENDIF
  591. XMTK=XMIN + RATE *(TEF-XTIN)
  592. ENDIF
  593. C
  594. C 5.4ter) MODIFICATIONS LIEES AUX CONDITIONS INITIALES ET DE
  595. C RECOLAGE
  596. C
  597. IF(LVITE)IVITE.PROG(IE3)=IVITE.PROG(IE3)-XIVITE
  598. IF(LDEPL)IDEPL.PROG(IE3)=IDEPL.PROG(IE3)-XIDEPL
  599. > -XIVITE*(TEF-XTIN)
  600. C
  601. C 5.5) BOUCLE SUR LES FREQUENCE DANS CHAQUE BANDE
  602. C ET CALCUL DU SIGNAL
  603. C
  604. DO 40 IE4=IFREQ(1,IE2),IFREQ(2,IE2)
  605. CCOS=COS(DPI*F(IE4)*TEF+PHASE(IE4))
  606. SSIN=SIN(DPI*F(IE4)*TEF+PHASE(IE4))
  607. IF(LACCE)THEN
  608. IACCE.PROG(IE3)=IACCE.PROG(IE3)
  609. > +XMTK*SRAC(IE4)*CCOS
  610. ENDIF
  611. IF(LVITE)THEN
  612. IVITE.PROG(IE3)=IVITE.PROG(IE3)
  613. > +XMTK*SRAC(IE4)/(DPI*F(IE4))*SSIN
  614. > +RATE*SRAC(IE4)/(DPI*F(IE4))**2*CCOS
  615. ENDIF
  616. IF(LDEPL)THEN
  617. IDEPL.PROG(IE3)=IDEPL.PROG(IE3)
  618. > -XMTK*SRAC(IE4)/(DPI*F(IE4))**2*CCOS
  619. > +2*RATE*SRAC(IE4)/(DPI*F(IE4))**3*SSIN
  620. ENDIF
  621. 40 CONTINUE
  622. C
  623. TEF=TEF+DTEF
  624. 42 CONTINUE
  625. C
  626. IF(LMODU)THEN
  627. SEGDES MLREE1
  628. SEGDES MLREE2
  629. SEGDES KEVOLL
  630. ENDIF
  631. C
  632. 44 CONTINUE
  633. C
  634. C 5.6) DESACTIVATION DES CALCULS
  635. C
  636. IF(LACCE)SEGDES IACCE
  637. IF(LVITE)SEGDES IVITE
  638. IF(LDEPL)SEGDES IDEPL
  639. 46 CONTINUE
  640. C
  641. IF(LACCE)SEGDES JACCE
  642. IF(LVITE)SEGDES JVITE
  643. IF(LDEPL)SEGDES JDEPL
  644. C
  645. IF(LMODU)SEGDES MEVOL2
  646. C
  647. C 6) DESTRUCTION DE LA ZONE DE TRAVAIL ET RETOUR A GIBIANE
  648. C
  649. SEGSUP MTRAV
  650. C
  651. IF(LDEPL)CALL ECROBJ('EVOLUTIO',JDEPL)
  652. IF(LVITE)CALL ECROBJ('EVOLUTIO',JVITE)
  653. IF(LACCE)CALL ECROBJ('EVOLUTIO',JACCE)
  654. C
  655. 666 CONTINUE
  656. RETURN
  657. END
  658.  
  659.  
  660.  
  661.  
  662.  

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