!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
subroutine dft2d_rpn(psp,pgd,kiway,kni,knj) 2,4
!
!**s/r dft2d_rpn -
!
!Author : Luc Fillion *MSC/CAN - 2 Nov 2004. Adaptation for 3D-VAR of original Bertrand Denis's version.
!Revision:
!
!Arguments
! psp: Output spectral array (kni+2,knj+2)
! pgd: Input gridpoint array (kni,knj)
!
IMPLICIT NONE
*implicits
#include "taglam4d.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
!
integer kiway,kni,knj
real*8 psp((kni+2)*(knj+2))
real*8 pgd(kni*knj)
!
integer nid,njd,mmax,nmax,nip,njp,init,injt
integer i,j,ij,ijt,imaxl,cas
integer iway,iaxe,nx,ny,nfact
real*8 zr1((kni+2)*(knj+2))
real*8 zr2((kni+2)*(knj+2))
real*8 zr3((kni+2)*(knj+2))
!
!!
! write(nulout,*) 'DFT2DRPN: START'
cas=5 ! regular (sin,cos) DFT
imaxl=(kni+2)*(knj+2)
!
IF (MOD( kni,2 ).EQ.0 .OR.
& MOD( knj,2 ).EQ.0 ) THEN
! WRITE(6,*) ' STANDARD PERIODIC FOURIER TRANSFORMS',
! & ' REQUIRE THAT DIMENSIONS BE ODD'
! CALL XIT(' Varspec',-6 )
endif
nid = kni ! NUMBER OF DISTINCT POSITION IN X.
njd = knj ! NUMBER OF DISTINCT POSITION IN X.
*** ISSUE A WARNING IF A FAST TRANSFORM CANNOT BE USED.
NFACT = NID
CALL NGFFT( NFACT )
IF (NFACT.NE.NID) THEN
WRITE(6,*) 'WARNING: A FAST TRANSFORM CANNOT BE USED:'
WRITE(6,6110) NID,NFACT
endif
!
NFACT = NJD
CALL NGFFT( NFACT )
IF (NFACT.NE.NJD) THEN
WRITE(6,*) 'WARNING: A FAST TRANSFORM CANNOT BE USED:'
WRITE(6,6120) NJD,NFACT
endif
!
*** SET THE MAXIMUM OF INTEGER WAVENUMBERS SUPPORTED BY THE GRID.
!
MMAX = NID/2
NMAX = NJD/2
*** NEED TO PADD THE INPUT ARRAY
!
* --------------------
* |O O O O O O O O O |
* |O O O O O O O O O |
* |X X X X X X X O O |
* |X X X X X X X O O |
* |X X X X X X X O O |
* |X X X X X X X O O |
* --------------------
!
if(kiway.eq.-1) then
NIP = 2 ! EXTRA SPACES NEEDED BY THE FFT
NJP = 2
!
init = NID+NIP
injt = NJD+NJP
!
IJ = 0
IJT = 0
DO J=1,injt
DO I=1,init
IJT = IJT+1
IF (I.GT.NID .OR.
+ J.GT.NJD ) THEN
psp(IJT) = 0.0
ELSE
IJ = IJ+1
psp(IJT) = pgd(IJ)
END IF
END DO
END DO
else
endif
*** DO THE TRANSFORMS IN TWO 1-D PASSES.
* ======================================
*** FIRST PASS ==> ALONG INDEX "I"
* ----------
IWAY = kiway ! -1: gd2sp; +1: sp2gd
IAXE = 0 ! TRANSFORM FOLLOWING X
IF (IAXE.EQ.0) THEN
NX = NID ! TRANSFORM FOLLOWING X
NY = NJD
ELSE
NX = NJD ! TRANSFORM FOLLOWING Y
NY = NID
END IF
CALL TRANS1D(psp,zr1,zr2,zr3,imaxl,NX,NY,CAS,IAXE,IWAY )
IAXE = 1 ! TRANSFORM FOLLOWING Y
IF (IAXE.EQ.0) THEN
NX = NID ! TRANSFORM FOLLOWING X
NY = NJD ! TRANSFORM FOLLOWING X
ELSE
NX = NJD ! TRANSFORM FOLLOWING Y
NY = NID ! TRANSFORM FOLLOWING X
END IF
*** SECOND PASS => ALONG INDEX "J"
* -----------
CALL TRANS1D(psp,zr1,zr2,zr3,imaxl,NX,NY,CAS,IAXE,IWAY )
if(kiway.eq.+1) then
NIP = 2 ! EXTRA SPACES NEEDED BY THE FFT
NJP = 2
!
init = NID+NIP
injt = NJD+NJP
!
IJ = 0
IJT = 0
DO J=1,injt
DO I=1,init
IJT = IJT+1
IF (I.GT.NID .OR.
+ J.GT.NJD ) THEN
psp(IJT) = 0.0
ELSE
IJ = IJ+1
pgd(IJ) = psp(IJT)
END IF
END DO
END DO
endif
!
!
0004 FORMAT(A4)
0005 FORMAT(BN,I5)
0010 FORMAT(BN,E10.0)
5000 FORMAT(10X,3I5,E5.0)
6000 FORMAT(5X,A4,I12,1X,A4,I10,2I4,I8,I6)
6001 FORMAT(' CAS =',I1)
6002 FORMAT(' LOGV =',I1)
6003 FORMAT(' CLUST=',I1)
6004 FORMAT(' DX =',F10.5,' Kilometers.')
6010 FORMAT('0',I6,' records processed.')
6110 FORMAT('N = kni-1 = ', I4,' THE nearest factorizable N = ',I4)
6120 FORMAT('N = knj-1 = ', I4,' the nearest factorizable N = ',I4)
6130 FORMAT('N = kni = ', I4,' the nearest factorizable N = ',I4)
6140 FORMAT('N = knj = ', I4,' the nearest factorizable N = ',I4)
6160 FORMAT(' Problem reading input parametres.')
!
! write(nulout,*) 'DFT2DRPN: END'
return
end