!-------------------------------------- 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 LEGINV3 (KM,PFMS,PFMA,DDSP,DDALP,KDIM, KLATH 5
S ,KTRUNC,KTRUNCDIM)
#if defined (DOC)
*
***s/r LEGINV3 - Inverse Legendre transform going from spectral to
* . Fourier space. All latitudes are computed for a
* . given value KM of the zonal wavenumber
*
*
*Author : P. Gauthier/P. Koclas *ARMA/AES-CMC Nov 1997
*Revision:
*
* Method: the coefficients PFMS and PFMA contain respectively
* . the symmetric and antisymmetric part of the result
*
* P. Koclas Apr 2003
* -conversion to ibm : changed iregister from 256 to 96
* P. Koclas CMC AUG 2003
* -removed IREGISTER loop via suggestion by Will Weir of iBM
*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, ILEN
s ,ITRUNC, INMP1, JIND, INK
C
CIBM-WLW-BEGIN
INTEGER I,J
CIBM-WLW-END
C
ILEN=(KLATH+1)*2*KDIM
pfms(:,:) = 0.d0
pfma(:,:) = 0.d0
C
C 1. Sum is made on JN for both even and odd modes except possibly
C . for the last even mode that needs to be treated separately
C
100 CONTINUE
ITRUNC = KTRUNC
IF(MOD(KTRUNC-KM+1,2).EQ.1) ITRUNC = KTRUNC-1
*
IF(KM.NE.KTRUNC)THEN
CIBM-WLW-BEGIN1
DO 101 JLAT = 1,KLATH
DO 102 JK = 1,2*KDIM
DO 103 JN = KM, ITRUNC, 2
INM = JN - KM
INMP1 = INM + 1
PFMS(JLAT,JK) = PFMS(JLAT,JK) +
& DDALP(INM,JLAT) * DDSP(INM,JK)
PFMA(JLAT,JK) = PFMA(JLAT,JK) +
& DDALP(INMP1,JLAT) * DDSP(INMP1,JK)
103 CONTINUE
102 END DO
101 END DO
CIBM-WLW-END1
END IF
C
C 2. When the number of even modes exceed the number of modes by 1,
C . an adjustment is needed for the last even mode
C
200 CONTINUE
IF(MOD(KTRUNC-KM+1,2).EQ.1) THEN
JN = KTRUNC
IF ( KM .NE. KTRUNC) THEN
INM = JN - KM
DO 201 JLAT = 1,KLATH
DO 202 JK = 1,2*KDIM
PFMS(JLAT,JK) = PFMS(JLAT,JK) +
& DDALP(INM,JLAT) * DDSP(INM,JK)
202 END DO
201 END DO
ELSE
INM = JN - KM
DO 251 JLAT = 1,KLATH
DO 252 JK = 1,2*KDIM
PFMS(JLAT,JK) =
& DDALP(INM,JLAT) * DDSP(INM,JK)
252 END DO
251 END DO
END IF
END IF
C
RETURN
END