GFT_common.f90

Go to the documentation of this file.

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -*- Mode: F90 -*- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! GFT_common.f90 --- GFT common objects
!! 
!! Auteur          : Jalel Chergui (CNRS/IDRIS) <Jalel.Chergui@idris.fr>
!! Créé le         : Tue Feb 19 10:02:32 2002
!! Dern. mod. par  : Jalel Chergui (CNRS/IDRIS) <Jalel.Chergui@idris.fr>
!! Dern. mod. le   : Thu Jul  4 13:13:46 2002
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Permission is granted to copy and distribute this file or modified
! versions of this file for no fee, provided the copyright notice and
! this permission notice are preserved on all copies.
! Copyright (C) Februry 2002, CNRS/IDRIS, Jalel.Chergui@idris.fr.
!
MODULE gft_common
  IMPLICIT NONE
 
  !... Floating point precisions
  INTEGER, PARAMETER :: gft_r4  = selected_real_kind(6)
  INTEGER, PARAMETER :: gft_r8  = selected_real_kind(12)
  INTEGER, PARAMETER :: gft_r16 = selected_real_kind(24)
 
  !... Recommended Default Floating Point Precision
  INTEGER, PARAMETER :: gft_prec=gft_r8
 
  !... Default copyright
  LOGICAL            :: copyright=.true.
 
  !... Derived TYPE for 1D, 2D and 3D Complex-Complex FFT
  TYPE gft_cc
    INTEGER             :: nx
    INTEGER             :: ny
    INTEGER             :: nz
    INTEGER             :: bf=1
    INTEGER             :: isign=0
    REAL(kind=gft_prec) :: scale
    INTEGER             :: ldx1
    INTEGER             :: ldx2
    INTEGER             :: ldy1
    INTEGER             :: ldy2
    INTEGER             :: tablesize
    INTEGER             :: worksize
    LOGICAL             :: init=.false.
    REAL(kind=gft_prec), POINTER, DIMENSION(:) :: work
    REAL(kind=gft_prec), POINTER, DIMENSION(:) :: table
  END TYPE gft_cc
 
  !... Derived TYPE for 1D, 2D and 3D Real-Complex and Complex-Real FFT
  TYPE gft_rcr
    INTEGER             :: nx
    INTEGER             :: ny
    INTEGER             :: nz
    INTEGER             :: bf=1
    INTEGER             :: isign=0
    REAL(kind=gft_prec) :: scale
    INTEGER             :: ldx1
    INTEGER             :: ldx2
    INTEGER             :: ldy1
    INTEGER             :: ldy2
    LOGICAL             :: even_x
    LOGICAL             :: even_y
    LOGICAL             :: even_z
    LOGICAL             :: init=.false.
    INTEGER             :: tablesize
    INTEGER             :: worksize
    REAL(kind=gft_prec), POINTER, DIMENSION(:) :: work
    REAL(kind=gft_prec), POINTER, DIMENSION(:) :: table
  END TYPE gft_rcr
 
 
  !... Derived TYPE for Multiple 1D Complex-Complex FFT
  TYPE gft_mcc
    INTEGER             :: nx
    INTEGER             :: ny
    INTEGER             :: bf=1
    INTEGER             :: isign=0
    REAL(kind=gft_prec) :: scale
    INTEGER             :: ldx1
    INTEGER             :: ldy1
    LOGICAL             :: init=.false.
    INTEGER             :: tablesize
    INTEGER             :: worksize
    REAL(kind=gft_prec), POINTER, DIMENSION(:) :: work
    REAL(kind=gft_prec), POINTER, DIMENSION(:) :: table
  END TYPE gft_mcc
 
  !... Derived TYPE for Multiple 1D Real-Complex and Complex-Real FFT
  TYPE gft_mrcr
    INTEGER             :: nx
    INTEGER             :: ny
    INTEGER             :: bf=1
    INTEGER             :: isign=0
    REAL(kind=gft_prec) :: scale
    INTEGER             :: ldx1
    INTEGER             :: ldy1
    LOGICAL             :: even_x
    LOGICAL             :: even_y
    LOGICAL             :: init=.false.
    INTEGER             :: tablesize
    INTEGER             :: worksize
    REAL(kind=gft_prec), POINTER, DIMENSION(:) :: work
    REAL(kind=gft_prec), POINTER, DIMENSION(:) :: table
  END TYPE gft_mrcr
 
  CONTAINS
 
  SUBROUTINE gft_error( Message )
    IMPLICIT NONE
 
    !... Input dummy arguments
    CHARACTER(LEN=*) :: Message
 
    print *,message
    stop
  END SUBROUTINE gft_error
 
  SUBROUTINE gft_warning( Message )
    IMPLICIT NONE
 
    !... Input dummy arguments
    CHARACTER(LEN=*) :: Message
 
    print *,message
  END SUBROUTINE gft_warning
 
  SUBROUTINE gft_copyright
    IMPLICIT NONE
 
    IF (copyright) THEN
      copyright = .false.
      print *," "
      print '(10X,A)',"*** GFT (Generic Fourier Transform) release 1.0.1.  ***"
      print '(10X,A)',"*** Authors: Jalel Chergui & Jean-Marie Teuler      ***"
      print '(10X,A)',"*** (C) March 2002, CNRS/IDRIS Orsay FRANCE.        ***"
      print *," "
    END IF
  END SUBROUTINE gft_copyright
END MODULE gft_common