Télécharger laplin.eso

Retour à la liste

Numérotation des lignes :

  1. C LAPLIN SOURCE CHAT 05/01/13 01:12:59 5004
  2. SUBROUTINE LAPLIN
  3. C
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Y)
  6. IMPLICIT COMPLEX*16 (Z)
  7. C
  8. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  9. C
  10. C OPERATEUR LAPL
  11. C
  12. C CALCUL LA TRANSFORMEE DE LAPLACE INVERSE
  13. C
  14. C
  15. C SORTIES :
  16. C
  17. C
  18. C AUTEUR : SAINT-DIZIER ET DE LANGRE
  19. C DATE : 05 DECEMBRE 1989
  20. C
  21. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  22. C
  23. LOGICAL INV
  24.  
  25. -INC CCREEL
  26. -INC SMLREEL
  27. -INC SMEVOLL
  28. -INC CCOPTIO
  29. C
  30. SEGMENT MTRAV
  31. COMPLEX*16 ZW(NEXP)
  32. COMPLEX*16 ZXX(NPT)
  33. COMPLEX*16 ZYY(NPT)
  34. ENDSEGMENT
  35. C
  36. CALL LIROBJ('LISTREEL',MLREE1,1,IRETOU)
  37. IF (IERR.NE.0) RETURN
  38. CALL LIROBJ('LISTREEL',MLREE2,1,IRETOU)
  39. IF (IERR.NE.0) RETURN
  40. CALL LIROBJ('LISTREEL',MLREE3,1,IRETOU)
  41. IF (IERR.NE.0) RETURN
  42. CALL LIRREE(AA,1,IRETOU)
  43. IF (IERR.NE.0) RETURN
  44. CALL LIRENT(LL,1,IRETOU)
  45. IF (IERR.NE.0) RETURN
  46. C
  47. SEGACT MLREE1
  48. SEGACT MLREE2
  49. SEGACT MLREE3
  50. C
  51. NSUM = MLREE1.PROG(/1)
  52. NN = NSUM / LL
  53. JG = NN
  54. POINTEUR MLREE4.MLREEL
  55. POINTEUR MLREE5.MLREEL
  56. SEGINI MLREE4
  57. SEGINI MLREE5
  58. C
  59. NEXP = NN/2
  60. NPT = NN
  61. SEGINI MTRAV
  62. C
  63. N = 1
  64. SEGINI MEVOL1
  65. SEGINI KEVOL1
  66. C
  67. C -- DETERMINATION DES CARACTERISTIQUES DU CALCUL
  68. C
  69. ZI = (0.D0,1.D0)
  70. T = 2.D0 * XPI / (MLREE1.PROG (2))
  71. DELTAT = T / NN
  72. C
  73. C -- ALGORITHME DE DURBIN AVEC FFT
  74. C
  75. DO 20 K = 0 , NN - 1
  76. XA = 0D0
  77. XB = 0D0
  78. DO 21 KL= 0 , LL -1
  79. IKL =K + KL * NN
  80. XA = XA + MLREE2.PROG(IKL+1)
  81. XB = XB + MLREE3.PROG(IKL+1)
  82. 21 CONTINUE
  83. ZXX(K + 1) = XA + ZI* XB
  84. 20 CONTINUE
  85. C
  86. INV = .TRUE.
  87. CALL WEXP(INV,NPT,ZW)
  88. CALL FFTL(ZXX,ZYY,ZW,NPT)
  89. C
  90. C
  91. DO 30 J = 0 , NN-1
  92. TJ = J*DELTAT
  93. MLREE4.PROG(J+1)= TJ
  94. CJ = EXP(AA*TJ)
  95. FF =CXTORE(ZXX(J+1))
  96. MLREE5.PROG(J+1) = (2.D0*CJ/T)*(-.5D0*MLREE2.PROG(1)+FF)
  97. C MLREE5.PROG(J+1) = (2.D0*CJ/T)*( FF)
  98. C MLREE5.PROG(J+1) = FF
  99. 30 CONTINUE
  100. C
  101. MEVOL1.ITYEVO = 'REEL'
  102. MEVOL1.IEVTEX = 'TRANSFORMEE DE LAPLACE'
  103. MEVOL1.IEVOLL(1) = KEVOL1
  104. C
  105. KEVOL1.IPROGX = MLREE4
  106. KEVOL1.IPROGY = MLREE5
  107. KEVOL1.NUMEVX = 0
  108. KEVOL1.TYPX = 'LISTREEL'
  109. KEVOL1.TYPY = 'LISTREEL'
  110. KEVOL1.NOMEVX = 'TEMPS'
  111. KEVOL1.NOMEVY = 'F(T)'
  112. KEVOL1.KEVTEX = 'LAPLACE INVERSE'
  113. C
  114. CALL ECROBJ('EVOLUTION',MEVOL1)
  115. C
  116. SEGDES MLREE1
  117. SEGDES MLREE2
  118. SEGDES MLREE3
  119. SEGDES MLREE4
  120. SEGDES MLREE5
  121. SEGDES MEVOL1
  122. SEGDES KEVOL1
  123. END
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  

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