C**********************************************************                  HANAL.2     
C             SUBROUTINE HANAL                                               HANAL.3     
C**********************************************************                  HANAL.4     
      SUBROUTINE HANAL(GV,GVW,SV,NLS,ITYPE)                                  HANAL.5     
C                                                                            HANAL.6     
C     Performs a direct Legendre transform for a (set of) field(s)           HANAL.7     
C     having a total of NLS levels, from Fourier to spectral space.          HANAL.8     
C                                                                            HANAL.9     
C     The following types of Legendre function and thence types of           HANAL.10    
C     transform may be used:                                                 HANAL.11    
C        ITYPE=1,2  :  ALP   :  ALPN(,,,1)   :  normal transform.            HANAL.12    
C        ITYPE=3,4  :  DALP  :  ALPN(,,,2)   :  y-derivative.                HANAL.13    
C        ITYPE=5,6  :  RLP   :  ALPN(,,,3)   :  del(-2).                     HANAL.14    
C        ITYPE=7,8  :  RDLP  :  ALPN(,,,4)   :  y-derivative of del(-2).     HANAL.15    
C     An even/odd value of ITYPE denotes a spectral field of even/odd        HANAL.16    
C     symmetry.                                                              HANAL.17    
C                                                                            HANAL.18    
C     A Fourier work array GVW prevents corruption of the input Fourier      HANAL.19    
C     array GV that would otherwise occur in global runs.                    HANAL.20    
C                                                                            HANAL.21    
C     NOTE: The y-derivative transforms use integration by parts and         HANAL.22    
C           are valid only if the input field has zero zonal mean at         HANAL.23    
C           both poles.                                                      HANAL.24    
C                                                                            HANAL.25    
C     Version for RSGUP3.                     Mike Blackburn,  05.01.95.     HANAL.26    
C     4R3 : try reversed loop ordering for global code.                      HANAL.27    
C     Work array now a dummy argument (ANSI). Mike Blackburn,  04.09.96.     HANAL.28    
C                                                                            HANAL.29    
C                                                                            PARAM1.2     
C     Determines model resolution                                            PARAM1.3     
C                                                                            PARAM1.4     
      PARAMETER(NN=21,MM=21,NHEM=2,NL=5,MOCT=1,MG=64,JG=16,NWJ2=121          NETCDF.35    
     P         ,NCRAY=64,JGL=JG,NTRAC=1,NLEVRF=1)                            NETCDF.36    
                                                                             PARAM1.7     
C                                                                            PARAM1.8     
C                                                                            PARAM2.2     
C     Sets basic constants, especially those needed for array dimensions     PARAM2.3     
C                                                                            PARAM2.4     
      PARAMETER(MH=2,PI=3.14159265359,PI2=2.0*PI                             PARAM2.5     
     +,NNP=NN+1,MGPP=MG+2,JGP=JG+1,JGG=JG*NHEM,JGGP=JGG+1,MJP=NWJ2+NWJ2      PARAM2.6     
     +,NLM=NL-1,NLP=NL+1,NLPP=NL+2,NLA=NL+3,NLB=NL+4,NL2=NL*NL               PARAM2.7     
     +,IDA=(MG+MG+MG)/2+1,IDB=NWJ2*NL,IDC=IDB+IDB,IDD=MGPP*NL                PARAM2.8     
     +,IDE=NL2*NN,IDF=NCRAY*(MG+1),IDG=JG*NL,IDH=JG*MG                       PARAM2.9     
     +,IDI=NNP/2,IDJ=IDI*IDI,IDK=NL*IDI,IDL=MGPP/2,IDM=NNP/2,IDN=IDM*NL      PARAM2.10    
     +,NWW=1+(MM-1)/MOCT)                                                    PARAM2.11    
      PARAMETER(IGA=NWJ2*NHEM,IGB=IDB*NHEM,IGC=MGPP*NHEM,IGD=IDD*NHEM        PARAM2.12    
     +,IGG=IDG*NHEM,IGL=IDL*NHEM,IGM=IDM*NHEM,IGN=IDN*NHEM                   PARAM2.13    
     +,IGO=IGA+IGA,IGP=IGB+IGB,NFTWG=(5+NTRAC)*NL+3                          PARAM2.14    
     +,NFTGW=(6+3*NTRAC)*NL+2,NFTGD=(3+NTRAC)*NL,NLTR=NL*NTRAC)              PARAM2.15    
C     Number of 2D (surface) output fields. This value is                    PARAM2.16    
C     Doubled due to averaged and instantaneous fields.                      PARAM2.17    
      PARAMETER (N2DFLD=21,NGRPAD=N2DFLD*2*IGC)                              PARAM2.18    
C                                                                            PARAM2.19    
C                                                                            BLANK.2     
C     Basic planetary parameters for run plus information about              BLANK.3     
C     vertical grid structure                                                BLANK.4     
C                                                                            BLANK.5     
C     Note that RD and GASCON are identical and CPD is set from RD,AKAP.     BLANK.6     
      COMMON        SQ(NNP),RSQ(NNP),SIGMAH(NLM),SIGMA(NL)                   BLANK.7     
     +              ,T01S2(NLM),T0(NL),ALPHA(NL),DSIGMA(NL),RDSIG(NL)        BLANK.8     
     +              ,TKP(NL),C(NL2),SQH(NNP)                                 BLANK.9     
     +              ,MF,MFP,JZF,NF,NFP                                       BLANK.10    
     +              ,AKAP,GA,GASCON,RADEA,WW,P0,PFAC,EZ,AIOCT                BLANK.11    
     +              ,RD,RV,CPD,CLATNT                                        BLANK.12    
     +              ,LRSTRT,LSHORT,LTVEC,LSTRETCH                            BLANK.13    
     +              ,LFLUX                                                   BLANK.14    
     +              ,LBALAN,LRESTIJ                                          BLANK.15    
     +              ,LCLIM, LPERPET, L22L,LOROG ,LCSFCT                      BLANK.16    
     +              ,LNOISE                                                  BLANK.17    
      COMPLEX EZ,AIOCT                                                       BLANK.18    
      LOGICAL LRSTRT,LSHORT,LTVEC,LSTRETCH,LBALAN,LRESTIJ                    BLANK.19    
     +       ,LFLUX,LNOISE                                                   BLANK.20    
     +       ,LCLIM, LPERPET, L22L,LOROG,LCSFCT                              BLANK.21    
C                                                                            BLANK.22    
C                                                                            LEGAU.2     
C     Legendre polynomials and information about gaussian latitudes          LEGAU.3     
C                                                                            LEGAU.4     
      COMMON/LEGAU/ ALPJ(MJP),DALPJ(MJP)                                     LEGAU.5     
     +              ,ALP(NWJ2,2,JGL),DALP(NWJ2,2,JGL)                        LEGAU.6     
     +              ,RLP(NWJ2,2,JGL),RDLP(NWJ2,2,JGL)                        LEGAU.7     
     +              ,SI(JGG),CS(JGG),SISQ(JGG),CSSQ(JGG),SECSQ(JGG)          LEGAU.8     
     +              ,ALAT(JGG),GWT(JGG),AW(JGG),JH,JL,JINC                   LEGAU.9     
C                                                                            LEGAU.10    
C                                                                            POLYNO.2     
C     Polynomial used to aid vectorization of Legendre transforms            POLYNO.3     
C                                                                            POLYNO.4     
      COMMON/POLYNO/POLY(NWJ2,2,4),CMPA(IGL)                                 POLYNO.5     
      COMPLEX CMPA                                                           POLYNO.6     
C                                                                            POLYNO.7     
      COMPLEX     GV(IGL,NLS),GVW(IGL,NLS),SV(IGA,NLS)                       HANAL.35    
      REAL        ALPN(NWJ2,2,JGL,4)                                         HANAL.36    
      EQUIVALENCE (ALPN(1,1,1,1),ALP(1,1,1))                                 HANAL.37    
C                                                                            HANAL.38    
 6900 FORMAT(/' ***ABORT : HANAL CALLED WITH INVALID TYPE =',I5)             HANAL.39    
C                                                                            HANAL.40    
C     Use ITYPE to define transform type and symmetry labels.                HANAL.41    
C     ISPAR is symmetry of spectral field    = 0 for D,T,SP etc.             HANAL.42    
C                                            = 1 for Z.                      HANAL.43    
C     IGPAR is symmetry of Fourier field: same as ISPAR unless transform     HANAL.44    
C                                         involves a d/dy.                   HANAL.45    
C                                                                            HANAL.46    
      IF (ITYPE.LE.0.OR.ITYPE.GT.8) THEN                                     HANAL.47    
         WRITE(2,6900) ITYPE                                                 HANAL.48    
         CALL ABORT                                                          HANAL.49    
      ENDIF                                                                  HANAL.50    
      IALP=(ITYPE+1)/2                                                       HANAL.51    
      ISPAR=MOD(ITYPE,2)                                                     HANAL.52    
      IGPAR=ISPAR                                                            HANAL.53    
      IF (IALP.EQ.2.OR.IALP.EQ.4) IGPAR=1-ISPAR                              HANAL.54    
C                                                                            HANAL.55    
C     For a global run, sum and difference the complete Fourier              HANAL.56    
C     transforms at the northern and southern latitude rows to give          HANAL.57    
C     the even and odd contributions.                                        HANAL.58    
C     Separate code for each symmetry:                                       HANAL.59    
C        IGPAR=0 : even (IA) to precede odd (IB).                            HANAL.60    
C        IGPAR=1 : odd (IA) to precede even (IB).                            HANAL.61    
C                                                                            HANAL.62    
      IF (NHEM.EQ.2) THEN                                                    HANAL.63    
         IF (IGPAR.EQ.0) THEN                                                HANAL.64    
            DO 10 IA=1,NWW                                                   HANAL.65    
               IB=IA+IDL                                                     HANAL.66    
               DO 10 L=1,NLS                                                 HANAL.67    
                  GVW(IA,L)=0.5*(GV(IA,L)+GV(IB,L))                          HANAL.68    
                  GVW(IB,L)=0.5*(GV(IA,L)-GV(IB,L))                          HANAL.69    
   10       CONTINUE                                                         HANAL.70    
         ELSE                                                                HANAL.71    
            DO 20 IA=1,NWW                                                   HANAL.72    
               IB=IA+IDL                                                     HANAL.73    
               DO 20 L=1,NLS                                                 HANAL.74    
                  GVW(IA,L)=0.5*(GV(IA,L)-GV(IB,L))                          HANAL.75    
                  GVW(IB,L)=0.5*(GV(IA,L)+GV(IB,L))                          HANAL.76    
   20       CONTINUE                                                         HANAL.77    
         ENDIF                                                               HANAL.78    
      ENDIF                                                                  HANAL.79    
C                                                                            HANAL.80    
C     Set up the appropriate Gaussian weight for the current latitude,       HANAL.81    
C     dependent on transform type.                                           HANAL.82    
C     Assumes JH in /LEGAU/ contains latitude counter from calling loop.     HANAL.83    
C                                                                            HANAL.84    
      IF (IALP.EQ.1) AWT=AW(JH)*CSSQ(JH)                                     HANAL.85    
      IF (IALP.EQ.2) AWT=-AW(JH)                                             HANAL.86    
      IF (IALP.EQ.3) AWT=AW(JH)*CSSQ(JH)                                     HANAL.87    
      IF (IALP.EQ.4) AWT=-AW(JH)                                             HANAL.88    
C                                                                            HANAL.89    
C     Calculate POLY array in vector loop before main transform.             HANAL.90    
C                                                                            HANAL.91    
      DO 30 IHEM=1,NHEM                                                      HANAL.92    
         IA=(ISPAR+1)*(2-IHEM) + (2-ISPAR)*(IHEM-1)                          HANAL.93    
         DO 30 IP=1,NWJ2                                                     HANAL.94    
            POLY(IP,IHEM,IALP)=AWT*ALPN(IP,IA,JL,IALP)                       HANAL.95    
   30 CONTINUE                                                               HANAL.96    
C                                                                            HANAL.97    
C     Perform direct Legendre transform from the even and odd                HANAL.98    
C     parts of the Fourier transforms to spectral space.                     HANAL.99    
C     Separate code for NHEM=1,2 to increase efficiency.                     HANAL.100   
C                                                                            HANAL.101   
      IF (NHEM.EQ.1) THEN                                                    HANAL.102   
         IM=0                                                                HANAL.103   
         IP=0                                                                HANAL.104   
         DO 40 M=0,MM-1,MOCT                                                 HANAL.105   
            IM=IM+1                                                          HANAL.106   
            DO 40 N=M,NN-1,2                                                 HANAL.107   
               IP=IP+1                                                       HANAL.108   
               DO 40 L=1,NLS                                                 HANAL.109   
                  SV(IP,L)=SV(IP,L) + POLY(IP,1,IALP)*GV(IM,L)               HANAL.110   
   40    CONTINUE                                                            HANAL.111   
      ELSE                                                                   HANAL.112   
         IM=0                                                                HANAL.113   
         IP=0                                                                HANAL.114   
         DO 50 M=0,MM-1,MOCT                                                 HANAL.115   
            IM=IM+1                                                          HANAL.116   
            IPM=IP                                                           HANAL.117   
            DO 50 L=1,NLS                                                    HANAL.118   
               IP=IPM                                                        HANAL.119   
               DO 50 N=M,NN-1,2                                              HANAL.120   
               IP=IP+1                                                       HANAL.121   
               SV(IP     ,L)=SV(IP     ,L)+POLY(IP,1,IALP)*GVW(IM    ,L)     HANAL.122   
               SV(IP+NWJ2,L)=SV(IP+NWJ2,L)+POLY(IP,2,IALP)*GVW(IM+IDL,L)     HANAL.123   
   50    CONTINUE                                                            HANAL.124   
      ENDIF                                                                  HANAL.125   
C                                                                            HANAL.126   
      RETURN                                                                 HANAL.127   
      END                                                                    HANAL.128   
