C**********************************************************                  SPOP.2     
C             SUBROUTINE SPOP                                                SPOP.3     
C**********************************************************                  SPOP.4     
      SUBROUTINE SPOP                                                        SPOP.5     
C                                                                            SPOP.6     
C     Controls diagnostic output from model run.                             SPOP.7     
C     Outputs spectral coefficients.                                         SPOP.8     
C                                                                            SPOP.9     
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                                                                            SPECTR.2     
C     Array ordering in SPECTR must correspond to that in GRIDP.             SPECTR.3     
C                                                                            SPECTR.4     
      COMMON/SPECTR/Z(IGB),D(IGB),T(IGB),TRA(IGB,NTRAC),SP(IGA),GS(IGA)      SPECTR.5     
     :              ,SPA(IGA),VP(IGA),DTE(IGB),TT(IGB)                       SPECTR.6     
     :              ,TRAT(IGB,NTRAC),DT(IGB),ZT(IGB)                         SPECTR.7     
     :              ,ZMI(IGB),DMI(IGB),TMI(IGB)                              SPECTR.8     
     :              ,TRAMI(IGB,NTRAC),SPMI(IGA)                              SPECTR.9     
      COMPLEX Z,D,T,TRA,SP,GS,SPA,VP,DTE,TT,TRAT,DT,ZT                       SPECTR.10    
     :       ,ZMI,DMI,TMI,TRAMI,SPMI                                         SPECTR.11    
C                                                                            SPECTR.12    
C                                                                            GRIDP.2     
C     Array ordering in GRIDP must correspond to that in SPECTR.             GRIDP.3     
C     Real arrays: multi-level arrays are 1-dimensional.                     GRIDP.4     
C                                                                            GRIDP.5     
      COMMON/GRIDP/ CHIG(IGD),SFG(IGD),UG(IGD),VG(IGD)                       GRIDP.6     
     *              ,ZG(IGD),DG(IGD),TG(IGD)                                 GRIDP.7     
     +              ,TRAG(IGD,NTRAC)                                         GRIDP.8     
     *              ,PLG(IGC),PJG(IGC),PMG(IGC)                              GRIDP.9     
     *              ,SPG(IGC),VPG(IGC),EG(IGD)                               GRIDP.10    
     +              ,TNLG(IGD),TRANLG(IGD,NTRAC),FUG(IGD),FVG(IGD)           GRIDP.11    
     +              ,UTG(IGD),UTRAG(IGD,NTRAC)                               GRIDP.12    
     +              ,VTG(IGD),VTRAG(IGD,NTRAC),FVGT(IGD),FUGT(IGD)           GRIDP.13    
     $              ,GRPAD(NGRPAD)                                           GRIDP.14    
C                                                                            GRIDP.15    
C                                                                            BATS.2     
C     Constant arrays and variables associated with time and vertical        BATS.3     
C     differencing. Also counters.                                           BATS.4     
C                                                                            BATS.5     
      COMMON/BATS/  BM1(IDE),AK(NNP),AQ(NL2),G(NL2),TAU(NL2)                 BATS.6     
     +              ,KOUNT,KITS,KSTART,KTOTAL,KRUN,BEGDAY,ITSPD              BATS.7     
     +              ,DELT,DELT2,CV,CG,CT,CQ,PNU,PNU2,PNU21                   BATS.8     
     +              ,NTRACO,CTRA(NTRAC),KOLOUR(NTRAC),RGG(NL2)               BATS.9     
     +              ,BEGDOY,DOY                                              BATS.10    
C                                                                            BATS.11    
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                                                                            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    
C                                                                            SPOP.18    
 200  FORMAT(/' NUMBER OF TIME STEPS COMPLETED =',I5)                        SPOP.19    
 202  FORMAT(' SPECTRAL COEFFICIENTS (COEFF ; AMPLITUDE ; PHASE)')           SPOP.20    
 204  FORMAT(' VORTICITY AT LEVEL',I2)                                       SPOP.21    
 206  FORMAT(' DIVERGENCE AT LEVEL',I2)                                      SPOP.22    
 208  FORMAT(' PERTURBATION TEMPERATURE AT LEVEL',I2)                        SPOP.23    
 211  FORMAT(' LOG(SURFACE PRESSURE)')                                       SPOP.24    
 215  FORMAT(' TRACER FIELD ',I4,' AT LEVEL',I2)                             SPOP.25    
C                                                                            SPOP.26    
      IF (NCOEFF.EQ.0) RETURN                                                SPOP.27    
C                                                                            SPOP.28    
C     Spectral coeficients are wanted                                        SPOP.29    
C                                                                            SPOP.30    
      WRITE (2,200) KOUNT                                                    SPOP.31    
      WRITE (2,202)                                                          SPOP.32    
C                                                                            SPOP.33    
C     Absolute vorticity                                                     SPOP.34    
C                                                                            SPOP.35    
      DO 18 L=1,NL                                                           SPOP.36    
         IF (LSPO(L)) THEN                                                   SPOP.37    
            WRITE (2,204) L                                                  SPOP.38    
            CALL WRSPA(Z(1+(L-1)*IGA),1)                                     SPOP.39    
         ENDIF                                                               SPOP.40    
 18   CONTINUE                                                               SPOP.41    
C                                                                            SPOP.42    
C     Divergence                                                             SPOP.43    
C                                                                            SPOP.44    
      DO 28 L=1,NL                                                           SPOP.45    
         IF (LSPO(L)) THEN                                                   SPOP.46    
            WRITE (2,206) L                                                  SPOP.47    
            CALL WRSPA(D(1+(L-1)*IGA),2)                                     SPOP.48    
         ENDIF                                                               SPOP.49    
 28   CONTINUE                                                               SPOP.50    
C                                                                            SPOP.51    
C     Temperature                                                            SPOP.52    
C                                                                            SPOP.53    
      DO 38 L=1,NL                                                           SPOP.54    
         IF (LSPO(L)) THEN                                                   SPOP.55    
            WRITE (2,208) L                                                  SPOP.56    
            CALL WRSPA(T(1+(L-1)*IGA),2)                                     SPOP.57    
         ENDIF                                                               SPOP.58    
 38   CONTINUE                                                               SPOP.59    
C                                                                            SPOP.60    
C     Tracers                                                                SPOP.61    
C                                                                            SPOP.62    
      DO 48 KK=1,NTRAC                                                       SPOP.63    
         DO 49 L=1,NL                                                        SPOP.64    
            IF(LSPO(L)) THEN                                                 SPOP.65    
               WRITE(2,215) KK,L                                             SPOP.66    
               CALL WRSPA(TRA(1+(L-1)*IGA,KK),2)                             SPOP.67    
            ENDIF                                                            SPOP.68    
   49    CONTINUE                                                            SPOP.69    
   48 CONTINUE                                                               SPOP.70    
C                                                                            SPOP.71    
C     Log (Surface Pressure)                                                 SPOP.72    
C                                                                            SPOP.73    
      WRITE(2,211)                                                           SPOP.74    
      CALL WRSPA(SP(1),2)                                                    SPOP.75    
C                                                                            SPOP.76    
      RETURN                                                                 SPOP.77    
      END                                                                    SPOP.78    
