Télécharger la plaquette Cast3M


fr en

Télécharger laplin.eso

Retour à la liste

Numérotation des lignes : 

laplin

  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 PPARAM
  29. -INC CCOPTIO
  30. C
  31.       SEGMENT MTRAV
  32.       COMPLEX*16 ZW(NEXP)
  33.       COMPLEX*16 ZXX(NPT)
  34.       COMPLEX*16 ZYY(NPT)
  35.       ENDSEGMENT
  36. C
  37.       CALL LIROBJ('LISTREEL',MLREE1,1,IRETOU)
  38.       IF (IERR.NE.0) RETURN
  39.       CALL LIROBJ('LISTREEL',MLREE2,1,IRETOU)
  40.       IF (IERR.NE.0) RETURN
  41.       CALL LIROBJ('LISTREEL',MLREE3,1,IRETOU)
  42.       IF (IERR.NE.0) RETURN
  43.       CALL LIRREE(AA,1,IRETOU)
  44.       IF (IERR.NE.0) RETURN
  45.       CALL LIRENT(LL,1,IRETOU)
  46.       IF (IERR.NE.0) RETURN
  47. C
  48.       SEGACT MLREE1
  49.       SEGACT MLREE2
  50.       SEGACT MLREE3
  51. C
  52.       NSUM = MLREE1.PROG(/1)
  53.       NN = NSUM / LL
  54.       JG = NN
  55.       POINTEUR MLREE4.MLREEL
  56.       POINTEUR MLREE5.MLREEL
  57.       SEGINI MLREE4
  58.       SEGINI MLREE5
  59. C
  60.       NEXP = NN/2
  61.       NPT  = NN
  62.       SEGINI MTRAV
  63. C
  64.       N  = 1
  65.       SEGINI MEVOL1
  66.       SEGINI KEVOL1
  67. C
  68. C -- DETERMINATION DES CARACTERISTIQUES DU CALCUL
  69. C
  70.       ZI = (0.D0,1.D0)
  71.       T = 2.D0 * XPI / (MLREE1.PROG (2))
  72.       DELTAT = T / NN
  73. C
  74. C -- ALGORITHME DE DURBIN AVEC FFT
  75. C
  76.       DO 20 K = 0 , NN - 1
  77.          XA = 0D0
  78.          XB = 0D0
  79.          DO 21 KL= 0 , LL -1
  80.             IKL =K + KL * NN
  81.             XA = XA + MLREE2.PROG(IKL+1)
  82.             XB = XB + MLREE3.PROG(IKL+1)
  83.  21      CONTINUE
  84.          ZXX(K + 1) = XA + ZI* XB
  85.  20   CONTINUE
  86. C
  87.       INV = .TRUE.
  88.       CALL WEXP(INV,NPT,ZW)
  89.       CALL FFTL(ZXX,ZYY,ZW,NPT)
  90. C
  91. C
  92.       DO 30 J = 0 , NN-1
  93.          TJ = J*DELTAT
  94.          MLREE4.PROG(J+1)= TJ
  95.          CJ = EXP(AA*TJ)
  96.          FF =CXTORE(ZXX(J+1))
  97.          MLREE5.PROG(J+1) = (2.D0*CJ/T)*(-.5D0*MLREE2.PROG(1)+FF)
  98. C           MLREE5.PROG(J+1) = (2.D0*CJ/T)*(                   FF)
  99. C           MLREE5.PROG(J+1) =                               FF
  100.  30   CONTINUE
  101. C
  102.       MEVOL1.ITYEVO = 'REEL'
  103.       MEVOL1.IEVTEX = 'TRANSFORMEE DE LAPLACE'
  104.       MEVOL1.IEVOLL(1) = KEVOL1
  105. C
  106.       KEVOL1.IPROGX = MLREE4
  107.       KEVOL1.IPROGY = MLREE5
  108.       KEVOL1.NUMEVX = 0
  109.       KEVOL1.TYPX   = 'LISTREEL'
  110.       KEVOL1.TYPY   = 'LISTREEL'
  111.       KEVOL1.NOMEVX = 'TEMPS'
  112.       KEVOL1.NOMEVY = 'F(T)'
  113.       KEVOL1.KEVTEX = 'LAPLACE INVERSE'
  114. C
  115.       CALL ECROBJ('EVOLUTION',MEVOL1)
  116. C
  117.       SEGDES MLREE1
  118.       SEGDES MLREE2
  119.       SEGDES MLREE3
  120.       SEGDES MLREE4
  121.       SEGDES MLREE5
  122.       SEGDES MEVOL1
  123.       SEGDES KEVOL1
  124.       END
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  

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