C**********************************************************                  HANAL1.2     
C             SUBROUTINE HANAL1                                              HANAL1.3     
C**********************************************************                  HANAL1.4     
      SUBROUTINE HANAL1(GV,GVW,SV,NLS,ITYPE)                                 HANAL1.5     
C                                                                            HANAL1.6     
C     Performs a direct Legendre transform for a single-level field,         HANAL1.7     
C     from Fourier to spectral space.                                        HANAL1.8     
C                                                                            HANAL1.9     
C     The following types of Legendre function and thence types of           HANAL1.10    
C     transform may be used:                                                 HANAL1.11    
C        ITYPE=1,2  :  ALP   :  ALPN(,,,1)   :  normal transform.            HANAL1.12    
C        ITYPE=3,4  :  DALP  :  ALPN(,,,2)   :  y-derivative.                HANAL1.13    
C        ITYPE=5,6  :  RLP   :  ALPN(,,,3)   :  del(-2).                     HANAL1.14    
C        ITYPE=7,8  :  RDLP  :  ALPN(,,,4)   :  y-derivative of del(-2).     HANAL1.15    
C     An even/odd value of ITYPE denotes a spectral field of even/odd        HANAL1.16    
C     symmetry.                                                              HANAL1.17    
C                                                                            HANAL1.18    
C     A Fourier work array GVW prevents corruption of the input Fourier      HANAL1.19    
C     array GV that would otherwise occur in global runs.                    HANAL1.20    
C                                                                            HANAL1.21    
C     NOTE: The y-derivative transforms use integration by parts and         HANAL1.22    
C           are valid only if the input field has zero zonal mean at         HANAL1.23    
C           both poles.                                                      HANAL1.24    
C                                                                            HANAL1.25    
C     Version for RSGUP3.                     Mike Blackburn,  05.01.95.     HANAL1.26    
C     Work array now a dummy argument (ANSI). Mike Blackburn,  04.09.96.     HANAL1.27    
C                                                                            HANAL1.28    
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),GVW(IGL),SV(IGA)                                       HANAL1.34    
      REAL ALPN(NWJ2,2,JGL,4)                                                HANAL1.35    
      EQUIVALENCE (ALPN(1,1,1,1),ALP(1,1,1))                                 HANAL1.36    
C                                                                            HANAL1.37    
 6900 FORMAT(/' ***ABORT : HANAL1 CALLED WITH INVALID TYPE =',I5)            HANAL1.38    
 6910 FORMAT(/' ***ABORT : HANAL1 CALLED WITH NLS =',I3,' : MUST BE 1')      HANAL1.39    
C                                                                            HANAL1.40    
C     Check this is a single-level call.                                     HANAL1.41    
C                                                                            HANAL1.42    
      IF (NLS.NE.1) THEN                                                     HANAL1.43    
         WRITE(2,6910) NLS                                                   HANAL1.44    
         CALL ABORT                                                          HANAL1.45    
      ENDIF                                                                  HANAL1.46    
C                                                                            HANAL1.47    
C     Use ITYPE to define transform type and symmetry labels.                HANAL1.48    
C     ISPAR is symmetry of spectral field    = 0 for D,T,SP etc.             HANAL1.49    
C                                            = 1 for Z.                      HANAL1.50    
C     IGPAR is symmetry of Fourier field: same as ISPAR unless transform     HANAL1.51    
C                                         involves a d/dy.                   HANAL1.52    
C                                                                            HANAL1.53    
      IF (ITYPE.LE.0.OR.ITYPE.GT.8) THEN                                     HANAL1.54    
         WRITE(2,6900) ITYPE                                                 HANAL1.55    
         CALL ABORT                                                          HANAL1.56    
      ENDIF                                                                  HANAL1.57    
      IALP=(ITYPE+1)/2                                                       HANAL1.58    
      ISPAR=MOD(ITYPE,2)                                                     HANAL1.59    
      IGPAR=ISPAR                                                            HANAL1.60    
      IF (IALP.EQ.2.OR.IALP.EQ.4) IGPAR=1-ISPAR                              HANAL1.61    
C                                                                            HANAL1.62    
C     For a global run, sum and difference the complete Fourier              HANAL1.63    
C     transforms at the northern and southern latitude rows to give          HANAL1.64    
C     the even and odd contributions.                                        HANAL1.65    
C     Separate code for each symmetry:                                       HANAL1.66    
C        IGPAR=0 : even (IA) to precede odd (IB).                            HANAL1.67    
C        IGPAR=1 : odd (IA) to precede even (IB).                            HANAL1.68    
C                                                                            HANAL1.69    
      IF (NHEM.EQ.2) THEN                                                    HANAL1.70    
         IF (IGPAR.EQ.0) THEN                                                HANAL1.71    
            DO 10 IA=1,NWW                                                   HANAL1.72    
               IB=IA+IDL                                                     HANAL1.73    
               GVW(IA)=0.5*(GV(IA)+GV(IB))                                   HANAL1.74    
               GVW(IB)=0.5*(GV(IA)-GV(IB))                                   HANAL1.75    
   10       CONTINUE                                                         HANAL1.76    
         ELSE                                                                HANAL1.77    
            DO 20 IA=1,NWW                                                   HANAL1.78    
               IB=IA+IDL                                                     HANAL1.79    
               GVW(IA)=0.5*(GV(IA)-GV(IB))                                   HANAL1.80    
               GVW(IB)=0.5*(GV(IA)+GV(IB))                                   HANAL1.81    
   20       CONTINUE                                                         HANAL1.82    
         ENDIF                                                               HANAL1.83    
      ENDIF                                                                  HANAL1.84    
C                                                                            HANAL1.85    
C     Set up the appropriate Gaussian weight for the current latitude,       HANAL1.86    
C     dependent on transform type.                                           HANAL1.87    
C     Assumes JH in /LEGAU/ contains latitude counter from calling loop.     HANAL1.88    
C                                                                            HANAL1.89    
      IF (IALP.EQ.1) AWT=AW(JH)*CSSQ(JH)                                     HANAL1.90    
      IF (IALP.EQ.2) AWT=-AW(JH)                                             HANAL1.91    
      IF (IALP.EQ.3) AWT=AW(JH)*CSSQ(JH)                                     HANAL1.92    
      IF (IALP.EQ.4) AWT=-AW(JH)                                             HANAL1.93    
C                                                                            HANAL1.94    
C     Calculate POLY array in vector loop before main transform.             HANAL1.95    
C                                                                            HANAL1.96    
      DO 30 IHEM=1,NHEM                                                      HANAL1.97    
         IA=(ISPAR+1)*(2-IHEM) + (2-ISPAR)*(IHEM-1)                          HANAL1.98    
         DO 30 IP=1,NWJ2                                                     HANAL1.99    
            POLY(IP,IHEM,IALP)=AWT*ALPN(IP,IA,JL,IALP)                       HANAL1.100   
   30 CONTINUE                                                               HANAL1.101   
C                                                                            HANAL1.102   
C     Perform direct Legendre transform from the even and odd                HANAL1.103   
C     parts of the Fourier transforms to spectral space.                     HANAL1.104   
C     Separate code for NHEM=1,2 to increase efficiency.                     HANAL1.105   
C                                                                            HANAL1.106   
      IF (NHEM.EQ.1) THEN                                                    HANAL1.107   
         IM=0                                                                HANAL1.108   
         IP=0                                                                HANAL1.109   
         DO 40 M=0,MM-1,MOCT                                                 HANAL1.110   
            IM=IM+1                                                          HANAL1.111   
            DO 40 N=M,NN-1,2                                                 HANAL1.112   
               IP=IP+1                                                       HANAL1.113   
               SV(IP)=SV(IP) + POLY(IP,1,IALP)*GV(IM)                        HANAL1.114   
   40    CONTINUE                                                            HANAL1.115   
      ELSE                                                                   HANAL1.116   
         IM=0                                                                HANAL1.117   
         IP=0                                                                HANAL1.118   
         DO 50 M=0,MM-1,MOCT                                                 HANAL1.119   
            IM=IM+1                                                          HANAL1.120   
            DO 50 N=M,NN-1,2                                                 HANAL1.121   
               IP=IP+1                                                       HANAL1.122   
               SV(IP     )=SV(IP     ) + POLY(IP,1,IALP)*GVW(IM    )         HANAL1.123   
               SV(IP+NWJ2)=SV(IP+NWJ2) + POLY(IP,2,IALP)*GVW(IM+IDL)         HANAL1.124   
   50    CONTINUE                                                            HANAL1.125   
      ENDIF                                                                  HANAL1.126   
C                                                                            HANAL1.127   
      RETURN                                                                 HANAL1.128   
      END                                                                    HANAL1.129   
