Commit 9708683b by Matthias Redies

### merge develop

parents e86a76e6 70243c70
 MODULE m_fft3d CONTAINS SUBROUTINE fft3d(& & afft,bfft,fg3,& & stars,isn,scaled) MODULE m_fft3d CONTAINS SUBROUTINE fft3d(& & afft, bfft, fg3,& & stars, isn, scaled) !************************************************************ !* * ... ... @@ -19,74 +19,74 @@ USE m_types USE m_fft_interface IMPLICIT NONE INTEGER, INTENT (IN) :: isn TYPE(t_stars),INTENT(IN):: stars REAL, INTENT (INOUT) :: afft(0:27*stars%mx1*stars%mx2*stars%mx3-1) REAL, INTENT (INOUT) :: bfft(0:27*stars%mx1*stars%mx2*stars%mx3-1) INTEGER, INTENT(IN) :: isn TYPE(t_stars), INTENT(IN):: stars REAL, INTENT(INOUT) :: afft(0:27*stars%mx1*stars%mx2*stars%mx3 - 1) REAL, INTENT(INOUT) :: bfft(0:27*stars%mx1*stars%mx2*stars%mx3 - 1) COMPLEX :: fg3(stars%ng3) LOGICAL,INTENT(IN),OPTIONAL :: scaled !< determines if coefficients are scaled by stars%nstr LOGICAL, INTENT(IN), OPTIONAL :: scaled !< determines if coefficients are scaled by stars%nstr INTEGER i,ifftd INTEGER i, ifftd REAL scale COMPLEX ctmp LOGICAL forw INTEGER length_zfft(3) complex :: zfft(0:27*stars%mx1*stars%mx2*stars%mx3-1) complex :: zfft(0:27*stars%mx1*stars%mx2*stars%mx3 - 1) ifftd = 27*stars%mx1*stars%mx2*stars%mx3 ifftd=27*stars%mx1*stars%mx2*stars%mx3 IF (isn.GT.0) THEN IF (isn > 0) THEN ! ! ---> put stars onto the fft-grid ! ---> put stars onto the fft-grid ! afft=0.0 bfft=0.0 DO i=0,stars%kimax ctmp = fg3(stars%igfft(i,1))*stars%pgfft(i) afft(stars%igfft(i,2))=real(ctmp) bfft(stars%igfft(i,2))=aimag(ctmp) ENDDO afft = 0.0 bfft = 0.0 DO i = 0, stars%kimax ctmp = fg3(stars%igfft(i, 1))*stars%pgfft(i) afft(stars%igfft(i, 2)) = real(ctmp) bfft(stars%igfft(i, 2)) = aimag(ctmp) ENDDO ENDIF !---> now do the fft (isn=+1 : G -> r ; isn=-1 : r -> G) zfft = cmplx(afft,bfft) zfft = cmplx(afft, bfft) if (isn == -1) then forw = .true. forw = .true. else forw = .false. forw = .false. end if length_zfft(1) = 3*stars%mx1 length_zfft(2) = 3*stars%mx2 length_zfft(3) = 3*stars%mx3 call fft_interface(3,length_zfft,zfft,forw) call fft_interface(3, length_zfft, zfft, forw) afft = real(zfft) bfft = aimag(zfft) IF (isn.LT.0) THEN IF (isn < 0) THEN ! ! ---> collect stars from the fft-grid ! DO i=1,stars%ng3 fg3(i) = cmplx(0.0,0.0) ENDDO DO i=0,stars%kimax fg3(stars%igfft(i,1)) = fg3(stars%igfft(i,1)) + CONJG( stars%pgfft(i) ) * & & zfft(stars%igfft(i,2)) ENDDO scale=1.0/ifftd IF (PRESENT(scaled)) THEN IF (scaled) THEN fg3=scale*fg3/stars%nstr ELSE fg3=scale*fg3 ENDIF ELSE fg3=scale*fg3/stars%nstr ENDIF DO i = 1, stars%ng3 fg3(i) = cmplx(0.0, 0.0) ENDDO DO i = 0, stars%kimax fg3(stars%igfft(i, 1)) = fg3(stars%igfft(i, 1)) + CONJG(stars%pgfft(i))* & & zfft(stars%igfft(i, 2)) ENDDO scale = 1.0/ifftd IF (PRESENT(scaled)) THEN IF (scaled) THEN fg3 = scale*fg3/stars%nstr ELSE fg3 = scale*fg3 ENDIF ELSE fg3 = scale*fg3/stars%nstr ENDIF ENDIF END SUBROUTINE fft3d END MODULE m_fft3d END SUBROUTINE fft3d END MODULE m_fft3d
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!