LCOV - code coverage report
Current view: top level - init - ifft235.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 24 46 52.2 %
Date: 2019-09-08 04:53:50 Functions: 1 2 50.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             :       MODULE m_ifft
       8             :       use m_juDFT
       9             :       CONTAINS
      10         726 :       INTEGER FUNCTION  ifft235 (iofile,ksfft,n,gmaxp)
      11             : C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
      12             : C   this function checks wether n can be expressed as :
      13             : C   n =  (2**P) * (3**Q) * (5**R) to match withe the MFFT - routines
      14             : C   used in this program. If close to n there is a number n' which
      15             : c   is solely expressable as n'= 2**p then this number sis choosen
      16             : c   and is outputted by the function. If n is not expressable as
      17             : C   n =  (2**P) * (3**Q) * (5**R) a number n' is choosen close to ns
      18             : c   is selected which fullfilles these requirements.
      19             : c
      20             : c
      21             : c                            Stefan Bl"ugel , kfa, Oct. 1993
      22             : C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
      23             :       IMPLICIT NONE
      24             : c
      25             : c----> declaration part
      26             : c
      27             :       INTEGER iofile,ksfft,n
      28             :       REAL    gmaxp
      29             : c
      30             : c----> local variabels
      31             : c
      32             :       INTEGER np,nn,nl,iexp,is,itrial
      33             :       REAL rl
      34             :       REAL fac_1,two,fac_2,fac_3,one,fac_4
      35             :       PARAMETER ( two=2.0e0,fac_1=1.001e0,fac_2=1.7e0,fac_3=1.95e0 )
      36             :       PARAMETER ( one=1.0e0,fac_4=0.03e0 )
      37             :       INTRINSIC abs,log,mod,real
      38             : c
      39             : c
      40         726 :       ifft235=0
      41         726 :       IF ( n.eq.0 ) THEN
      42           0 :          WRITE (iofile,*) 'n should not be zero'
      43           0 :           CALL juDFT_error("n should not be zero",calledby="ifft235")
      44             :       ENDIF
      45             : c
      46             : c====> RADIX 2 CALCULATION ONLY
      47             : c
      48         726 :       IF ( ksfft .EQ. 0 ) THEN
      49           0 :           rl   = log(real(n))/log(two)
      50           0 :           nl   = rl
      51           0 :           IF ( abs( n - 2 ** nl ) .GT. abs(n - 2 ** (nl+1) ) ) THEN
      52           0 :                np = nl + 1
      53             :           ELSE
      54             :                np = nl
      55             :           ENDIF
      56           0 :           IF ( ( np .eq. nl ) .AND. ( gmaxp * real(nl)/rl .lt. fac_1 ) )
      57             :      >         np = nl + 1
      58           0 :           ifft235 = 2 ** np
      59             :           RETURN
      60             :        ENDIF
      61             : c
      62             : c====> RADIX 2 , 3, 5 CALCULATION
      63             : c
      64             : c
      65             : c----> since gmaxp is large enough, try also smaller n
      66             : c
      67         726 :       IF ( gmaxp .GT. fac_2 .AND. gmaxp .LT. fac_3 ) THEN
      68             :            is = -1
      69             :       ELSE
      70             :            is =  1
      71             :       ENDIF
      72         726 :       np   = n
      73         726 :       nn   = n
      74             : c
      75        1020 :       DO 20 itrial = 1 , 200
      76             : c
      77             : c----> check whether there is a number close by, which is 2**NL
      78             : c      ( FFT very fast )
      79             : c
      80        1020 :           rl   = log(real(nn))/log(two)
      81        1020 :           nl   = rl
      82        1020 :           IF (( abs( real(nl)/rl - one ) .LT. fac_4 ).AND.
      83             :      +        ( 2**nl.GE.n ) ) THEN
      84         160 :              IF (gmaxp * real(nl)/rl .GT. one) ifft235 = 2 ** nl
      85             :              RETURN
      86         919 :           ELSE IF (( abs( real(nl+1)/rl - one ) .lt. fac_4 ).AND.
      87             :      +             ( 2**(nl+1).GE.n ) ) THEN
      88             :              ifft235 = 2 ** (nl + 1)
      89             :              RETURN
      90             :           ELSE
      91             : c
      92             : c----> no , no binary number is arround, check wether number can be
      93             : c      divided by 2,3 or 5
      94             : c
      95        5211 :              DO 10 iexp = 1 , nl+1
      96        2712 :                 IF (mod(nn,2) .EQ. 0) THEN
      97        1218 :                    nn = nn / 2
      98        1494 :                 ELSE IF (mod(nn,3) .EQ. 0 ) THEN
      99         136 :                    nn = nn / 3
     100        1358 :                 ELSE IF (mod(nn,5) .EQ. 0 ) THEN
     101          16 :                    nn = nn / 5
     102             :                 ENDIF
     103        2712 :                 IF ( nn.eq.2 .OR. nn.eq.3 .OR. nn.eq.5 ) THEN
     104             : c---> o.k.
     105             :                    ifft235 = np
     106             :                    RETURN
     107             :                 ENDIF
     108         294 :   10         ENDDO
     109             : c
     110             : c----> no , n  cannot be expressed as (2**P) * (3**Q) * (5**R)
     111             : c      change number
     112         294 :              nn = n + (is ** (itrial)) * ((itrial + 1)/2)
     113         294 :              np = n + (is ** (itrial)) * ((itrial + 1)/2)
     114             :           ENDIF
     115           0 :   20    ENDDO
     116             : c
     117           0 :       WRITE (iofile,'('' to few trials '', i3)') itrial
     118           0 :       STOP
     119             : c
     120             :       END FUNCTION ifft235
     121             : C-----------------------------------------------------------------------
     122           0 :       INTEGER FUNCTION i2357(ii)
     123             : 
     124             : !
     125             : ! simple setup to determine fft-length for ESSL calls
     126             : !
     127             :       IMPLICIT NONE
     128             :       INTEGER, INTENT (IN)  :: ii
     129             :       INTEGER i,j,k,h,m,n,nn
     130             : 
     131           0 :       nn = 12582912
     132           0 :       DO m = 0,1 
     133           0 :         DO k = 0,1 
     134           0 :           DO j = 0,1 
     135           0 :             DO i = 0,1 
     136           0 :               DO h = 1,25
     137           0 :                 n = 2**h * 3**i * 5**j * 7**k * 11**m
     138           0 :                 IF ( (n.GT.ii).AND.(n.LT.nn) ) nn = n
     139             :               ENDDO
     140             :             ENDDO
     141             :           ENDDO
     142             :         ENDDO
     143             :       ENDDO
     144           0 :       i2357 = nn
     145             : 
     146           0 :       END FUNCTION i2357
     147             :  
     148             :       END MODULE m_ifft

Generated by: LCOV version 1.13