Télécharger la plaquette Cast3M


fr en

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