Télécharger la plaquette Cast3M


fr en

Télécharger r1f4kb.eso

Retour à la liste

Numérotation des lignes : 

r1f4kb

  1. C R1F4KB    SOURCE    BP208322  18/10/08    21:15:11     9952           
  2. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  3. C
  4. C   FFTPACK 5.1 
  5. C
  6. C   Authors:  Paul N. Swarztrauber and Richard A. Valent
  7. C
  8. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  9.  
  10.       SUBROUTINE R1F4KB (IDO,L1,CC,IN1,CH,IN2,WA1,WA2,WA3)
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8(A-H,O-Z)
  13.       REAL*8     CC(IN1,IDO,4,L1)  ,CH(IN2,IDO,L1,4)    ,
  14.      1           WA1(IDO)  ,        WA2(IDO)  ,       WA3(IDO)
  15. C
  16.       SQRT2=SQRT(2.D0)
  17.       DO 101 K=1,L1
  18.          CH(1,1,K,3) = (CC(1,1,1,K)+CC(1,IDO,4,K))
  19.      1   -(CC(1,IDO,2,K)+CC(1,IDO,2,K))
  20.          CH(1,1,K,1) = (CC(1,1,1,K)+CC(1,IDO,4,K))
  21.      1   +(CC(1,IDO,2,K)+CC(1,IDO,2,K))
  22.          CH(1,1,K,4) = (CC(1,1,1,K)-CC(1,IDO,4,K))
  23.      1   +(CC(1,1,3,K)+CC(1,1,3,K))
  24.          CH(1,1,K,2) = (CC(1,1,1,K)-CC(1,IDO,4,K))
  25.      1   -(CC(1,1,3,K)+CC(1,1,3,K))
  26.   101 CONTINUE
  27.       IF (IDO-2) 107,105,102
  28.   102 IDP2 = IDO+2
  29.       DO 104 K=1,L1
  30.          DO 103 I=3,IDO,2
  31.             IC = IDP2-I
  32.         CH(1,I-1,K,1) = (CC(1,I-1,1,K)+CC(1,IC-1,4,K))
  33.      1  +(CC(1,I-1,3,K)+CC(1,IC-1,2,K))
  34.         CH(1,I,K,1) = (CC(1,I,1,K)-CC(1,IC,4,K))
  35.      1  +(CC(1,I,3,K)-CC(1,IC,2,K))
  36.         CH(1,I-1,K,2)=WA1(I-2)*((CC(1,I-1,1,K)-CC(1,IC-1,4,K))
  37.      1  -(CC(1,I,3,K)+CC(1,IC,2,K)))-WA1(I-1)
  38.      1  *((CC(1,I,1,K)+CC(1,IC,4,K))+(CC(1,I-1,3,K)-CC(1,IC-1,2,K)))
  39.         CH(1,I,K,2)=WA1(I-2)*((CC(1,I,1,K)+CC(1,IC,4,K))
  40.      1  +(CC(1,I-1,3,K)-CC(1,IC-1,2,K)))+WA1(I-1)
  41.      1  *((CC(1,I-1,1,K)-CC(1,IC-1,4,K))-(CC(1,I,3,K)+CC(1,IC,2,K)))
  42.         CH(1,I-1,K,3)=WA2(I-2)*((CC(1,I-1,1,K)+CC(1,IC-1,4,K))
  43.      1  -(CC(1,I-1,3,K)+CC(1,IC-1,2,K)))-WA2(I-1)
  44.      1  *((CC(1,I,1,K)-CC(1,IC,4,K))-(CC(1,I,3,K)-CC(1,IC,2,K)))
  45.         CH(1,I,K,3)=WA2(I-2)*((CC(1,I,1,K)-CC(1,IC,4,K))
  46.      1  -(CC(1,I,3,K)-CC(1,IC,2,K)))+WA2(I-1)
  47.      1  *((CC(1,I-1,1,K)+CC(1,IC-1,4,K))-(CC(1,I-1,3,K)
  48.      1  +CC(1,IC-1,2,K)))
  49.         CH(1,I-1,K,4)=WA3(I-2)*((CC(1,I-1,1,K)-CC(1,IC-1,4,K))
  50.      1  +(CC(1,I,3,K)+CC(1,IC,2,K)))-WA3(I-1)
  51.      1 *((CC(1,I,1,K)+CC(1,IC,4,K))-(CC(1,I-1,3,K)-CC(1,IC-1,2,K)))
  52.         CH(1,I,K,4)=WA3(I-2)*((CC(1,I,1,K)+CC(1,IC,4,K))
  53.      1  -(CC(1,I-1,3,K)-CC(1,IC-1,2,K)))+WA3(I-1)
  54.      1  *((CC(1,I-1,1,K)-CC(1,IC-1,4,K))+(CC(1,I,3,K)+CC(1,IC,2,K)))
  55.   103    CONTINUE
  56.   104 CONTINUE
  57.       IF (MOD(IDO,2) .EQ. 1) RETURN
  58.   105 CONTINUE
  59.       DO 106 K=1,L1
  60.          CH(1,IDO,K,1) = (CC(1,IDO,1,K)+CC(1,IDO,3,K))
  61.      1   +(CC(1,IDO,1,K)+CC(1,IDO,3,K))
  62.          CH(1,IDO,K,2) = SQRT2*((CC(1,IDO,1,K)-CC(1,IDO,3,K))
  63.      1   -(CC(1,1,2,K)+CC(1,1,4,K)))
  64.          CH(1,IDO,K,3) = (CC(1,1,4,K)-CC(1,1,2,K))
  65.      1   +(CC(1,1,4,K)-CC(1,1,2,K))
  66.          CH(1,IDO,K,4) = -SQRT2*((CC(1,IDO,1,K)-CC(1,IDO,3,K))
  67.      1   +(CC(1,1,2,K)+CC(1,1,4,K)))
  68.   106 CONTINUE
  69.   107 RETURN
  70.       END
  71.  
  72.  
  73.  

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