C**********************************************************                  WRSPS.2     
C             SUBROUTINE WRSPS                                               WRSPS.3     
C**********************************************************                  WRSPS.4     
      SUBROUTINE WRSPS(A,IA)                                                 WRSPS.5     
C                                                                            WRSPS.6     
C     Prints spectral coefficients                                           WRSPS.7     
C                                                                            WRSPS.8     
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    
      PARAMETER(RAD=180./PI)                                                 WRSPS.11    
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                                                                            OUTCON.2     
C     Switches counters and constants controlling type and frequency of      OUTCON.3     
C     model output                                                           OUTCON.4     
C                                                                            OUTCON.5     
      COMMON/OUTCON/RNTAPE,NCOEFF,NLAT,INLAT,INSPC                           OUTCON.6     
     +              ,RNTAPO                                                  OUTCON.7     
     +              ,KOUNTP,KOUNTE,KOUNTH,KOUNTR                             OUTCON.8     
     +              ,KOUTP,KOUTE,KOUTH,KOUTR,DAY                             OUTCON.9     
     +              ,SQR2,RSQR2,EAM1,EAM2,TOUT1,TOUT2,RMG                    OUTCON.10    
     +              ,LSPO(NL),LGPO(NL)                                       OUTCON.11    
     $              ,LSHIST,LMINIH                                           OUTCON.12    
      LOGICAL LSHIST,LMINIH                                                  OUTCON.13    
      LOGICAL LSPO,LGPO                                                      OUTCON.14    
C                                                                            OUTCON.15    
      COMPLEX A(NWJ2)                                                        WRSPS.14    
      CHARACTER COEFF(NWJ2,2)*8                                              WRSPS.15    
      REAL FP(IGA)                                                           WRSPS.16    
      INTEGER IP(IGA)                                                        WRSPS.17    
      SAVE COEFF,FP,IP                                                       WRSPS.18    
      COMPLEX POLAR,Z                                                        WRSPS.19    
      POLAR(Z)=CMPLX(ABS(Z),ATAN2(AIMAG(Z),REAL(Z)+1.0E-20)*RAD)             WRSPS.20    
      DATA COEFF/MJP*' (  ,  )'/                                             WRSPS.21    
      IG=0                                                                   WRSPS.22    
      I=0                                                                    WRSPS.23    
      DO 200 MP=1,MFP,MOCT                                                   WRSPS.24    
C                                                                            WRSPS.25    
C        Only print if MP<NCOEFF                                             WRSPS.26    
C                                                                            WRSPS.27    
         IF (MP.GT.NCOEFF) RETURN                                            WRSPS.28    
C                                                                            WRSPS.29    
         IBEG=IG                                                             WRSPS.30    
         DO 100 JP=MP,NCOEFF,MH                                              WRSPS.31    
            IG=IG+1                                                          WRSPS.32    
            I=I+1                                                            WRSPS.33    
            IP(I)=IG                                                         WRSPS.34    
            IF (MP.EQ.1) THEN                                                WRSPS.35    
               FP(I)=1.0                                                     WRSPS.36    
            ELSE                                                             WRSPS.37    
               FP(I)=2.0                                                     WRSPS.38    
            ENDIF                                                            WRSPS.39    
            WRITE(COEFF(I,1)(3:4),'(I2)')MP-1                                WRSPS.40    
            WRITE(COEFF(I,2)(3:4),'(I2)')MP-1                                WRSPS.41    
            WRITE(COEFF(I,1)(6:7),'(I2)')JP                                  WRSPS.42    
            WRITE(COEFF(I,2)(6:7),'(I2)')JP-1                                WRSPS.43    
 100     CONTINUE                                                            WRSPS.44    
         IG=IBEG+(NFP-MP+2)/MH                                               WRSPS.45    
 200  CONTINUE                                                               WRSPS.46    
      RETURN                                                                 WRSPS.47    
C******************************                                              WRSPS.48    
      ENTRY WRSPA(A,IA)                                                      WRSPS.49    
      IF (NHEM.EQ.1) THEN                                                    WRSPS.50    
         WRITE(2,1000)(COEFF(I,IA),POLAR(A(IP(I))*FP(I)),I=1,INSPC)          WRSPS.51    
      ELSE                                                                   WRSPS.52    
         WRITE(2,1000)(COEFF(I,2),POLAR(A(IP(I)+(2-IA)*NWJ2)*FP(I)),         WRSPS.53    
     1   COEFF(I,1),POLAR(A(IP(I)+(IA-1)*NWJ2)*FP(I)),I=1,INSPC)             WRSPS.54    
      ENDIF                                                                  WRSPS.55    
 1000 FORMAT(3(A8,1X,1PE8.2,0PF7.1))                                         WRSPS.56    
      RETURN                                                                 WRSPS.57    
      END                                                                    WRSPS.58    
