mo_buffer_fft.f90

      MODULE mo_buffer_fft
      
        USE mo_decomposition, ONLY: pe_decomposed
      
   5:   IMPLICIT NONE
      
        PRIVATE
      
        PUBLIC :: fftz          ! Fourier space array
  10:   PUBLIC :: fftl          ! Legendre
        PUBLIC :: fbm0          ! buffer with m=0 only (Fourier)
        PUBLIC :: lbm0          ! buffer with m=0 only (Legendre)
        PUBLIC :: construct_fft ! fourier space array deallocation routine
        PUBLIC :: destruct_fft  ! fourier space array allocation routine
  15:   PUBLIC :: fd, ft, fu, fv, fvo, fdtl, fdtm, falps, fdalpsl, fdalpsm
        PUBLIC :: ld, lt, lu, lv, lvo, ldtm, lalps, ldalpsm
        PUBLIC :: fu0, fdu0, ful, lu0, ldu0, lul
        PUBLIC :: ldl,  ldm, ltm1, lrh, lvol, lvom,        lalpsm1 !, lul
        PUBLIC :: fdm1, fdm, ftm1, frh, fvol, fvom, fvom1, falpsm1 !, ful
  20:   PUBLIC :: nvar
      
        !
        ! common array for all variables
        !
  25:   REAL, ALLOCATABLE, TARGET :: fftz  (:,:,:,:) ! the fft is performed in fftz
        REAL, ALLOCATABLE, TARGET :: fftl  (:,:,:,:) ! sym1,2  works in        fftl
        REAL, ALLOCATABLE, TARGET :: fbm0  (:,:,:)   ! buffer with spectral c. m=0 only (Fourier)
        REAL, ALLOCATABLE, TARGET :: lbm0  (:,:,:)   ! buffer with spectral c. m=0 only (Legendr)
        !
  30:   ! pointers into fftz, fftl used by inverse fft
        !                inverse fft,    sym2
        !
        REAL, POINTER :: fd     (:,:,:) ,ld   (:,:,:)
        REAL, POINTER :: ft     (:,:,:) ,lt   (:,:,:)
  35:   REAL, POINTER :: fu     (:,:,:) ,lu   (:,:,:)
        REAL, POINTER :: fv     (:,:,:) ,lv   (:,:,:)
        REAL, POINTER :: fvo    (:,:,:) ,lvo  (:,:,:)
        REAL, POINTER :: fdtm   (:,:,:) ,ldtm (:,:,:)
        REAL, POINTER :: fdtl   (:,:,:) 
  40:   REAL, POINTER :: falps  (:,:)   ,lalps  (:,:)
        REAL, POINTER :: fdalpsl(:,:)
        REAL, POINTER :: fdalpsm(:,:)   ,ldalpsm(:,:)
      
        REAL, POINTER :: fu0    (:,:)   ,lu0    (:,:)
  45:   REAL, POINTER :: fdu0   (:,:)   ,ldu0   (:,:)
        REAL, POINTER :: ful    (:,:)   ,lul    (:,:)
      
        !
        ! pointers into fftz, fftl used by direct fft
  50:   !                direct fft,    sym1
        !
        REAL, POINTER :: fdm1   (:,:,:), ldl    (:,:,:)
        REAL, POINTER :: fdm    (:,:,:), ldm    (:,:,:)
        REAL, POINTER :: ftm1   (:,:,:), ltm1   (:,:,:)
  55:   REAL, POINTER :: frh    (:,:,:), lrh    (:,:,:)
        REAL, POINTER :: fvol   (:,:,:), lvol   (:,:,:)
        REAL, POINTER :: fvom   (:,:,:), lvom   (:,:,:)
        REAL, POINTER :: falpsm1(:,:),   lalpsm1(:,:)
        REAL, POINTER :: fvom1  (:,:,:)
  60: 
        INTEGER, PARAMETER :: nvar = 7 ! number of variables (4th index of zfft)
        INTEGER, PARAMETER :: nva1 = 3 ! number of variables spectral c. m=0 only
      
      CONTAINS
  65: 
        SUBROUTINE construct_fft (dc)
      
        TYPE (pe_decomposed), INTENT(in) :: dc   ! decomposition table
      
  70:     !
          ! multy level arrays
          !
          ALLOCATE (fftz (dc% nlon+2, dc% nflevp1, dc% nflat, nvar))
          ALLOCATE (fftl (dc% nlm *2, dc% nflevp1, dc% nlat , nvar))
  75:     fftz(:,:,:,:) = 0.
          fftl(:,:,:,:) = 0.
          !
          ! arrays with spectral coefficients m=0 only
          !
  80:     ALLOCATE (lbm0 (            dc% nflev  , dc% nlat,  nva1))
          ALLOCATE (fbm0 (            dc% nflev  , dc% nflat, nva1))
          lbm0(:,:,:) = 0.
          fbm0(:,:,:) = 0.
          !
  85:     ! pointers for inverse transforms
          !
          fd  => fftz (:,1:dc% nflev,:,1) ;ld   => fftl (:,1:dc% nflev,:,1)
          ft  => fftz (:,1:dc% nflev,:,2) ;lt   => fftl (:,1:dc% nflev,:,2)
          fu  => fftz (:,1:dc% nflev,:,3) ;lu   => fftl (:,1:dc% nflev,:,3)
  90:     fv  => fftz (:,1:dc% nflev,:,4) ;lv   => fftl (:,1:dc% nflev,:,4)
          fvo => fftz (:,1:dc% nflev,:,5) ;lvo  => fftl (:,1:dc% nflev,:,5)
          fdtm=> fftz (:,1:dc% nflev,:,6) ;ldtm => fftl (:,1:dc% nflev,:,6)
          fdtl=> fftz (:,1:dc% nflev,:,7)
          !
  95:     ! single level arrays
          !
          IF (dc%nflev == dc%nflevp1) THEN
            NULLIFY (falps, fdalpsl, fdalpsm)
          ELSE
 100:       fdalpsl => fftz (:,dc% nflevp1,:,1) 
            fdalpsm => fftz (:,dc% nflevp1,:,2) ;ldalpsm => fftl (:,dc% nflevp1,:,2)
            falps   => fftz (:,dc% nflevp1,:,3) ;lalps   => fftl (:,dc% nflevp1,:,3)
          ENDIF
          !
 105:     ! zonal means (m=0 only)
          !
          ful => fbm0 (:,:,1)             ;lul  => lbm0 (:,:,1)
          fu0 => fbm0 (:,:,2)             ;lu0  => lbm0 (:,:,2)
          fdu0=> fbm0 (:,:,3)             ;ldu0 => lbm0 (:,:,3)
 110:     !
          ! pointers for direct transforms
          !
          fdm1 => fftz (:,1:dc% nflev,:,1); ldl  => fftl (:,1:dc% nflev,:,1)
          fdm  => fftz (:,1:dc% nflev,:,2); ldm  => fftl (:,1:dc% nflev,:,2)
 115:     ftm1 => fftz (:,1:dc% nflev,:,3); ltm1 => fftl (:,1:dc% nflev,:,3)
          frh  => fftz (:,1:dc% nflev,:,4); lrh  => fftl (:,1:dc% nflev,:,4)
          fvol => fftz (:,1:dc% nflev,:,5); lvol => fftl (:,1:dc% nflev,:,5)
          fvom => fftz (:,1:dc% nflev,:,6); lvom => fftl (:,1:dc% nflev,:,6)
          fvom1=> fftz (:,1:dc% nflev,:,7)
 120:     ! ful, lul used for both direct and inverse transform
          !
          ! single level arrays
          !
          IF (dc%nflev == dc%nflevp1) THEN
 125:       NULLIFY (falpsm1)
            NULLIFY (lalpsm1)
          ELSE
            falpsm1 => fftz(:,dc%nflevp1,:,3)
            lalpsm1 => fftl(:,dc%nflevp1,:,3)
 130:     ENDIF
      
        END SUBROUTINE construct_fft
      
        SUBROUTINE destruct_fft
 135:     DEALLOCATE (fftz)
          DEALLOCATE (fftl)
          DEALLOCATE (lbm0)
          DEALLOCATE (fbm0)
        END SUBROUTINE destruct_fft
 140: 
      END MODULE mo_buffer_fft
      
      


Info Section
uses: mo_decomposition
back to top
ECHAM 4 vf90 (C) 1998 Max-Planck-Institut für Meteorologie, Hamburg
Wed Nov 24 01:25:21 CST 1999

HTML derived from FORTRAN source by f2html.pl v0.3 (C) 1997,98 Beroud Jean-Marc.