!-------------------------------------- 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 --------------------------------------
!
*CoMpIlAtIoN_OpTiOnS ::AIX=-O4::*
SUBROUTINE LEGDIR3 (KM,PFMS,PFMA,DDSP,DDALP,KDIM, KLATH 5
S ,KTRUNC,KTRUNCDIM)
#if defined (DOC)
*
***s/r LEGDIR3 - Direct Legendre transform going from Fourier to
* . spectral space. All latitudes are processed for a
* . given value KM of the zonal wavenumber
*
*
*Author : P. Gauthier/P. Koclas *ARMA/AES-CMC Nov 1997
*Revision:
* P. Koclas Jp Toviessi CMC Apr 2003
* -openmp and loop nesting order changed for ibm conversion
* P. Koclas CMC AUG 2003
* -removed IREGISTER loop via suggestion by Will Weir of iBM
*
* Method: the coefficients PFMS and PFMA contain respectively
* . the symmetric and antisymmetric part of the result
*
*Arguments
* i : KM : zonal wavenumber being processed
*
* i : DDSP(0:KTRUNC,2*KDIM) : SPECTRAL COEFFICIENTS
* i : DDALP(0:KTRUNC,KJLATH) : EITHER ALP, DALP OR DELALP
* - (LEGENDRE FUNCTIONS)
* i : KLATH : NUMBER OF LATITUDE CIRCLES
* - TO BE TREATED
* i : KTRUNC : truncation order (triangular)
* i : KDIM : NUMBER OF FIELDS
* - TO BE TREATED
* o : PFMS(KJLATH,2*KDIM) : SYMMETRIC PART OF THE INVERSE
* - LEGENDRE TRANSFORM
* o : PFMA(KJLATH,2*KDIM) : ANTISYMMETRIC PART OF THE INVERSE
* - LEGENDRE TRANSFORM
* i : KTRUNCDIM : DIMENSION NEEDED TO PASS ARRAYS
* - AS ARGUMENTS (CAN BE REMOVED IF
* - AUTOMATIC ARRAYS ARE SUPPORTED)
* ------------------------------------------------------------------
*
#endif
IMPLICIT NONE
#include "comdim.cdk"
C
C Arguments
C
C
INTEGER KM, KDIM, KTRUNC, KTRUNCDIM, KLATH
REAL*8 PFMS(NJLATH+1,2*KDIM),PFMA(NJLATH+1,2*KDIM)
REAL*8 DDALP(0:KTRUNCDIM,KLATH)
REAL*8 DDSP(0:KTRUNCDIM,2*KDIM)
C
C Local variables
C
INTEGER JK, JLAT, JN, INM,
s ITRUNC, INMP1, JIND, INK
C
C
C 1. Sum is made on JLAT to obtain both the even and odd modes
C . except possibly for the last even mode that needs to be
C . treated separately
C
100 CONTINUE
ITRUNC = KTRUNC
IF(MOD(KTRUNC-KM+1,2).EQ.1) ITRUNC = KTRUNC-1
C
IF(KM.NE.KTRUNC)THEN
C
C
DDSP(0:KTRUNC,1:2*KDIM)=0.d0
DO 101 JLAT = 1,KLATH
DO 102 JK = 1,2*KDIM
DO 103 JN = KM, ITRUNC, 2
INM = JN - KM
INMP1 = INM + 1
DDSP(INM,JK) = DDSP(INM,JK)
S + DDALP(INM ,JLAT)*PFMS(JLAT,JK)
DDSP(INMP1,JK) = DDSP(INMP1,JK)
S + DDALP(INMP1,JLAT)*PFMA(JLAT,JK)
103 CONTINUE
102 CONTINUE
101 CONTINUE
END IF
C
C 2. When the number of even modes exceed the number of modes by 1,
C . the last even mode needs to be treated separately
C
200 CONTINUE
IF(MOD(KTRUNC-KM+1,2).EQ.1) THEN
JN = KTRUNC
INM = JN - KM
DDSP(INM,1:2*KDIM)=0.d0
C
DO 201 JLAT = 1,KLATH
DO 202 JK = 1,2*KDIM
DDSP(INM,JK) = DDSP(INM,JK)
S + DDALP(INM,JLAT)*PFMS(JLAT,JK )
202 CONTINUE
201 CONTINUE
END IF
C
RETURN
END