|
CP2K 2.4 (Revision 12889)
|
00001 !-----------------------------------------------------------------------------! 00002 ! Copyright by Stefan Goedecker, Lausanne, Switzerland, August 1, 1991 00003 ! modified by Stefan Goedecker, Cornell, Ithaca, USA, March 25, 1994 00004 ! modified by Stefan Goedecker, Stuttgart, Germany, October 6, 1995 00005 ! Commercial use is prohibited 00006 ! without the explicit permission of the author. 00007 !-----------------------------------------------------------------------------! 00008 00009 ! ***************************************************************************** 00010 SUBROUTINE ctrig ( n, trig, after, before, now, isign, ic ) 00011 USE fft_kinds, ONLY : dp 00012 INTEGER, INTENT ( IN ) :: n 00013 INTEGER, INTENT ( IN ) :: isign 00014 INTEGER, INTENT ( OUT ) :: ic 00015 INTEGER, DIMENSION ( 7 ), INTENT ( OUT ) :: after, before, now 00016 REAL ( dp ) , DIMENSION ( 2, 1024 ), INTENT ( OUT ) :: trig 00017 00018 INTEGER :: i, j, itt 00019 REAL ( dp ) :: twopi, angle 00020 INTEGER, PARAMETER :: nt = 82 00021 INTEGER, DIMENSION ( 7, nt ), PARAMETER :: idata = RESHAPE ((/ 00022 3, 3, 1, 1, 1, 1, 1, 4, 4, 1, 1, 1, 1, 1, 5, 5, 1, 1, 1, 1, 1, 6, 6, 1, 1, 1, 1, 1, 00023 8, 8, 1, 1, 1, 1, 1, 9, 3, 3, 1, 1, 1, 1, 12, 4, 3, 1, 1, 1, 1, 15, 5, 3, 1, 1, 1, 1, 00024 16, 4, 4, 1, 1, 1, 1, 18, 6, 3, 1, 1, 1, 1, 20, 5, 4, 1, 1, 1, 1, 24, 8, 3, 1, 1, 1, 1, 00025 25, 5, 5, 1, 1, 1, 1, 27, 3, 3, 3, 1, 1, 1, 30, 6, 5, 1, 1, 1, 1, 32, 8, 4, 1, 1, 1, 1, 00026 36, 4, 3, 3, 1, 1, 1, 40, 8, 5, 1, 1, 1, 1, 45, 5, 3, 3, 1, 1, 1, 48, 4, 4, 3, 1, 1, 1, 00027 54, 6, 3, 3, 1, 1, 1, 60, 5, 4, 3, 1, 1, 1, 64, 4, 4, 4, 1, 1, 1, 72, 8, 3, 3, 1, 1, 1, 00028 75, 5, 5, 3, 1, 1, 1, 80, 5, 4, 4, 1, 1, 1, 81, 3, 3, 3, 3, 1, 1, 90, 6, 5, 3, 1, 1, 1, 00029 96, 8, 4, 3, 1, 1, 1, 100, 5, 5, 4, 1, 1, 1, 108, 4, 3, 3, 3, 1, 1, 120, 8, 5, 3, 1, 1, 1, 00030 125, 5, 5, 5, 1, 1, 1, 128, 8, 4, 4, 1, 1, 1, 135, 5, 3, 3, 3, 1, 1, 144, 4, 4, 3, 3, 1, 1, 00031 150, 6, 5, 5, 1, 1, 1, 160, 8, 5, 4, 1, 1, 1, 162, 6, 3, 3, 3, 1, 1, 180, 5, 4, 3, 3, 1, 1, 00032 192, 4, 4, 4, 3, 1, 1, 200, 8, 5, 5, 1, 1, 1, 216, 8, 3, 3, 3, 1, 1, 225, 5, 5, 3, 3, 1, 1, 00033 240, 5, 4, 4, 3, 1, 1, 243, 3, 3, 3, 3, 3, 1, 256, 4, 4, 4, 4, 1, 1, 270, 6, 5, 3, 3, 1, 1, 00034 288, 8, 4, 3, 3, 1, 1, 300, 5, 5, 4, 3, 1, 1, 320, 5, 4, 4, 4, 1, 1, 324, 4, 3, 3, 3, 3, 1, 00035 360, 8, 5, 3, 3, 1, 1, 375, 5, 5, 5, 3, 1, 1, 384, 8, 4, 4, 3, 1, 1, 400, 5, 5, 4, 4, 1, 1, 00036 405, 5, 3, 3, 3, 3, 1, 432, 4, 4, 3, 3, 3, 1, 450, 6, 5, 5, 3, 1, 1, 480, 8, 5, 4, 3, 1, 1, 00037 486, 6, 3, 3, 3, 3, 1, 500, 5, 5, 5, 4, 1, 1, 512, 8, 4, 4, 4, 1, 1, 540, 5, 4, 3, 3, 3, 1, 00038 576, 4, 4, 4, 3, 3, 1, 600, 8, 5, 5, 3, 1, 1, 625, 5, 5, 5, 5, 1, 1, 640, 8, 5, 4, 4, 1, 1, 00039 648, 8, 3, 3, 3, 3, 1, 675, 5, 5, 3, 3, 3, 1, 720, 5, 4, 4, 3, 3, 1, 729, 3, 3, 3, 3, 3, 3, 00040 750, 6, 5, 5, 5, 1, 1, 768, 4, 4, 4, 4, 3, 1, 800, 8, 5, 5, 4, 1, 1, 810, 6, 5, 3, 3, 3, 1, 00041 864, 8, 4, 3, 3, 3, 1, 900, 5, 5, 4, 3, 3, 1, 960, 5, 4, 4, 4, 3, 1, 972, 4, 3, 3, 3, 3, 3, 00042 1000, 8, 5, 5, 5, 1, 1, 1024, 4, 4, 4, 4, 4, 1 /),(/7,nt/)) 00043 00044 00045 mloop: DO i = 1, nt 00046 IF ( n == idata ( 1, i ) ) THEN 00047 ic=0 00048 DO j = 1, 6 00049 itt = idata ( 1 + j, i ) 00050 IF ( itt > 1 ) THEN 00051 ic = ic + 1 00052 now ( j ) = idata ( 1 + j, i ) 00053 ELSE 00054 EXIT mloop 00055 END IF 00056 END DO 00057 EXIT mloop 00058 END IF 00059 IF ( i == nt ) THEN 00060 WRITE ( *, '(A,i5,A)' ) " Value of ",n, & 00061 " not allowed for fft, allowed values are:" 00062 WRITE ( *, '(15i5)' ) ( idata ( 1, j ), j = 1, nt ) 00063 STOP 'ctrig' 00064 END IF 00065 END DO mloop 00066 00067 after ( 1 ) = 1 00068 before ( ic ) = 1 00069 DO i = 2, ic 00070 after ( i ) = after ( i - 1 ) * now ( i - 1 ) 00071 before ( ic - i + 1 ) = before ( ic - i + 2 ) * now ( ic - i + 2 ) 00072 END DO 00073 00074 twopi = 8._dp * ATAN ( 1._dp ) 00075 angle = isign * twopi / REAL ( n, dp ) 00076 trig ( 1, 1 ) = 1._dp 00077 trig ( 2, 1 ) = 0._dp 00078 DO i = 1, n - 1 00079 trig ( 1, i + 1 ) = COS ( REAL ( i, dp ) * angle ) 00080 trig ( 2, i + 1 ) = SIN ( REAL ( i, dp ) * angle ) 00081 END DO 00082 00083 END SUBROUTINE ctrig
1.7.3