!-------------------------------------- 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 ZLEGDIR(PF,PN,PLEG,DDWT,KTRUNC,KNJ,KLEV 1 S ,KNJDIM,KLEVDIM,KNDIM) #if defined (DOC) * ***s/r ZLEGDIR - Direct Legendre transform restricted to * . fields that vary with latitude only * *Author : P. Gauthier *ARMA/AES February 1997 *Revision: * JM Belanger CMDA/SMC Aug 2000 * . 32 bits conversion * (MXMA8 instead of MXMA) * *Arguments * i PF(KNJDIM,KLEVDIM) : field in physical space * o PN(0:KNDIM, KLEVDIM ): spectral coefficients * o PLEG(0:KNDIM, KNJDIM): Legendre polynomials evaluated at the Gaussian latitudes * i DDWT(KNJDIM) : weights of the Gaussian quadrature * i KNJ : number of Gaussian latitudes * i KTRUNC : spectral truncation * i KLEV : number of fields to transform * i KNJDIM : dimensioning of the field (in latitude) * i KLEVDIM : dimensioning of the field (in KLEV) * I KNDIM : dimensioning of the field (in KTRUNC) #endif IMPLICIT NONE * * Arguments * INTEGER KNJ, KLEV, KTRUNC, KNJDIM, KLEVDIM, KNDIM REAL*8 PF(KNJDIM,4*KLEVDIM), PN(0:KNDIM, 4*KLEVDIM) S , PLEG(0:KNDIM,KNJDIM) REAL*8 DDWT(KNJ) * * Local variables * INTEGER J, JN, ILEN, IERR REAL*8 ZWORK(0:KTRUNC,KNJ) POINTER (PXWORK,ZWORK) * * 0. Allocate workspace * ILEN = KNJ*(KTRUNC+1) CALL HPALLOC(PXWORK,MAX(ILEN,1),IERR,8) * * 1. Prepare the matrix used for the transform * DO J = 1, KNJ DO JN = 0,KTRUNC ZWORK(JN,J) = PLEG(JN,J)*DDWT(J) END DO END DO * * 2. Do the transform * CALL MXMA8(ZWORK(0,1),1,KTRUNC+1,PF(1,1),1,KNJDIM S ,PN(0,1),1,KNDIM+1,KTRUNC+1,KNJ,KLEV) * * 9. Deallocate local arrays * CALL HPDEALLC(PXWORK,IERR,1) * RETURN END