        PROGRAM IGCM3                                                        MLTRI.2     
C**********************************************************************      MLTRI.3     
C                    IGCM3_1                                                 MLTRI.4     
C                                                                            MLTRI.5     
C FULL PHYSICS + MIXED LAYER OCEAN                                           MLTRI.6     
C                                                                            MLTRI.7     
C     DEPARTMENT OF METEOROLOGY      UNIVERSITY OF READING                   MLTRI.8     
C                                                                            MLTRI.9     
C**********************************************************************      MLTRI.10    
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(IDDAF=NFTGW*IGC,IDDAG=NFTWG*IGC,IDDAD=NFTGD*IGC              MLTRI.13    
     *         ,IDDZ=(11*NL+4)*JGG)                                          MLTRI.14    
C                                                                            BALAN.2     
C     Constants and arrays needed for balancing                              BALAN.3     
C                                                                            BALAN.4     
      COMMON/BALAN/BFILT(NL),RGT0(NL),RG(NL2),TMEAN(NL)                      BALAN.5     
     +            ,EP1(IGA),EP2(IGA),KBAL,MFTBAL,SRGT0,LTBAL                 BALAN.6     
      LOGICAL LTBAL                                                          BALAN.7     
C                                                                            BALAN.8     
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                                                                            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                                                                            COMFFT.2     
C     Constants and arrays needed for the fast Fourier transforms            COMFFT.3     
C                                                                            COMFFT.4     
      COMMON/COMFFT/NTGW,NRSTGW,NTWG,NRSTWG,NTGD,NRSTGD                      COMFFT.5     
     +              ,TRIG(IDA),WORK(IDF),IFAX(10)                            COMFFT.6     
C                                                                            COMFFT.7     
      COMMON/COMGRM/DUDLSG(IGC,NL),DVDLSG(IGC,NL),DTDLSG(IGC,NL)             COMGRM.2     
C                                                                            COMGRM.3     
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                                                                            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    
      COMMON/PHYS/  LBL,LVD,LCR,LLR,LRD,LCUBM,LCBADJ                         PHYSCA.2     
     :              ,TSTAR(IGC,JG),QSTAR(IGC,JG),FRAD(JG,NHEM)               PHYSCA.3     
     :              ,TSTARO(IGC,JG),TDEEPO(IGC,JG),smstar(igc,jg)            PHYSCA.4     
     :              ,tdeep(igc,jg),hsnow(igc,jg),sqstar(igc,jg)              PHYSCA.5     
     :              ,SALB(IGC,JG),SBAL(IGC,JG),BLCD(IGC)                     PHYSCA.6     
     :              ,SVEGE(IGC,JG),CD,DRAG,BLVAD,BLA,BLRH,BLVB(IGC)          PHYSCA.7     
     :              ,AKVV,AKTV,AKQV,ESCONA,ESCONB,EPSIQ,CTQ,CCC              PHYSCA.8     
     : ,ctqi,sdsn,shcs,shcsp,shcsn,skse,sksn,slhf,sd1,sd2,sdw                PHYSCA.9     
     :        ,ssmc,sdsnd,LSL,sasnow,saice,shsstar,shsmax                    PHYSCA.10    
     :     ,LOC,SHCO,SHCI,LNOICE,LOLDBL,LCOND,LNNSK,ITSLL,ITSLO              PHYSCA.11    
     :              ,CCR,RCON,DTBUOY,TSLA,TSLB,TSLC,TSLD,CUT1,CUT2           PHYSCA.12    
     :              ,NLCR,NCUTOP,CURHM,AKTC,AKQC,CUBMT,CBADJT,CBADJP         PHYSCA.13    
     :              ,SKAP(NL),SK(NLM),FWS(NL),CLR(NL),FB(NLM)                PHYSCA.14    
     :              ,TTDC(NL),QTDC(NL),TTMC(NL),QTMC(NL),TC(NL),QC(NL)       PHYSCA.15    
     :              ,CTCR(NL,NHEM),CTLR(NL,NHEM),NAVRD,NAVWT,DELT2C          PHYSCA.16    
      LOGICAL LBL,LVD,LCR,LLR,LRD,LCUBM,LCBADJ,LSL,LOC                       PHYSCA.17    
     :       ,LNOICE,LOLDBL,LCOND,LNNSK                                      PHYSCA.18    
C                                                                            PHYSCA.19    
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     
      COMMON/PTENDZ/UTVDZ(IGG),VTVDZ(IGG),TTVDZ(IGG),QTVDZ(IGG)              PTENDZ.2     
     :              ,TTCRZ(IGG),QTCRZ(IGG),TTLRZ(IGG),QTLRZ(IGG)             PTENDZ.3     
     :              ,TTRDZ(IGG),CTCRZ(IGG),CTLRZ(IGG)                        PTENDZ.4     
     :              ,UTBLZ(JGG),VTBLZ(JGG),TTBLZ(JGG),QTBLZ(JGG)             PTENDZ.5     
     :              ,AUTVDZ(IGG),AVTVDZ(IGG),ATTVDZ(IGG),AQTVDZ(IGG)         PTENDZ.6     
     :              ,ATTCRZ(IGG),AQTCRZ(IGG),ATTLRZ(IGG),AQTLRZ(IGG)         PTENDZ.7     
     :              ,ATTRDZ(IGG),ACTCRZ(IGG),ACTLRZ(IGG)                     PTENDZ.8     
     :              ,AUTBLZ(JGG),AVTBLZ(JGG),ATTBLZ(JGG),AQTBLZ(JGG)         PTENDZ.9     
C                                                                            PTENDZ.10    
C                                                                            RESTIJ.2     
C     Restoration temperature field and constants which determine it,        RESTIJ.3     
C     also contains timescales                                               RESTIJ.4     
C                                                                            RESTIJ.5     
      COMMON/RESTIJ/TTRES(IGB)                                               RESTIJ.6     
     + ,DTNS,DTEP,DTTRP,FAC(NL),DDAMP(NL),TFRC(NL),YRLEN,TRS(NL)             RESTIJ.7     
     +  ,ALR,ZTROP,TGR                                                       RESTIJ.8     
      COMPLEX TTRES                                                          RESTIJ.9     
C                                                                            RESTOR.2     
C     Restoration fields and timescale                                       RESTOR.3     
C                                                                            RESTOR.4     
      COMMON/RESTOR/ZRES(IGN),DRES(IGN),TRES(IGN),SPRES(IGM),DAMP            RESTOR.5     
C                                                                            RESTOR.6     
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    
      COMMON/GRIDSS/ZG1(IGD,JG),DG1(IGD,JG),UG1(IGD,JG),VG1(IGD,JG),         GRIDSS.2     
     :              TG1(IGD,JG),SPG1(IGC,JG)                                 GRIDSS.3     
C                                                                            GRIDSS.4     
       COMMON/CPIERS/ICFLAG(IGC,5,2),CFRAC(IGC,5),PNET(IGC,JG)               CPIERS.2     
     :               ,SNET(IGC,JG),RRFLUX(IGC,JG,6)                          CPIERS.3     
     :               ,TTSW(IGC,NL),TTLW(IGC,NL)                              CPIERS.4     
      COMMON/STATS/GMSP0,GMSPMI,LMASCOR,LMASOLD,LMASPRT                      STATS.2     
      LOGICAL LMASCOR,LMASOLD,LMASPRT                                        STATS.3     
C                                                                            STATS.4     
C-----------------------------------------------------------------------     STATS.5     
      REAL DAG(IDDAG),DAF(IDDAF),DAD(IDDAD)                                  MLTRI.32    
     *    ,DDZ(IDDZ),ADDZ(IDDZ)                                              MLTRI.33    
      EQUIVALENCE (DAG(1),UG(1)),(DAF(1),SPG(1)),(DAD(1),TNLG(1))            MLTRI.34    
     : ,(DDZ(1),UTVDZ(1)),(ADDZ(1),AUTVDZ(1))                                MLTRI.35    
      INTEGER IODSIZE                                                        MLTRI.36    
      PARAMETER (IODSIZE=MAX(NGRPAD+IGD,IGP*(3+NTRAC)+IGO)+7)                MLTRI.37    
      REAL*4 RODATA(IODSIZE)                                                 MLTRI.38    
      REAL R8DATA((3+NTRAC)*IGP)                                             MLTRI.39    
      REAL R8SP(IGO)                                                         MLTRI.40    
      EQUIVALENCE (R8DATA(1),Z(1))                                           MLTRI.41    
      REAL R8TT(IGP)                                                         MLTRI.42    
      EQUIVALENCE(R8TT(1),TT(1))                                             MLTRI.43    
      EQUIVALENCE(R8SP(1),SP(1))                                             MLTRI.44    
       REAL htnet                                                            RADHT.2     
       COMMON /RADHT/ HTNET(NHEM,JG,MG,NL)                                   RADHT.3     
       REAL TAVE(IGP)                                                        RADHT.4     
C                                                                            MLTRI.46    
 2000 FORMAT(/' RESTART RECORD WRITTEN TO CHANNEL ',I3,/                     MLTRI.47    
     +        ' RKOUNT  RNTAPE  DAY  DOY  =',4F12.3)                         MLTRI.48    
 2010 FORMAT(/' HISTORY RECORD WRITTEN TO CHANNEL ',I3,/                     MLTRI.49    
     +        ' RKOUNT  RNTAPE  DAY  DOY  =',4F12.3)                         MLTRI.50    
 2020 FORMAT(/' RESTORATION RECORD WRITTEN TO CHANNEL ',I3,/                 MLTRI.51    
     +        ' RKOUNT  RNTAPE  DAY  DOY  =',4F12.3)                         MLTRI.52    
C                                                                            MLTRI.53    
      call ini_graphics                                                      GRAPHIC.1     
      kflag=0                                                                GRAPHIC.2     
      CALL INITAL                                                            MLTRI.54    
 1    CONTINUE                                                               MLTRI.55    
C                                                                            MLTRI.56    
C     Adiabatic part of timestep. Preset tendencies to zero.                 MLTRI.57    
C                                                                            MLTRI.58    
      DO 31 I=1,IGA                                                          MLTRI.59    
         VP(I) =0.0                                                          MLTRI.60    
         SPA(I)=0.0                                                          MLTRI.61    
 31   CONTINUE                                                               MLTRI.62    
      DO 32 I=1,IGB                                                          MLTRI.63    
         ZT(I)=0.0                                                           MLTRI.64    
         DT(I)=0.0                                                           MLTRI.65    
         TT(I)=0.0                                                           MLTRI.66    
         DTE(I)=0.0                                                          MLTRI.67    
 32   CONTINUE                                                               MLTRI.68    
      DO 35 KK=1,NTRAC                                                       MLTRI.69    
         DO 35 I=1,IGB                                                       MLTRI.70    
            TRAT(I,KK)=0.0                                                   MLTRI.71    
 35   CONTINUE                                                               MLTRI.72    
C                                                                            MLTRI.73    
      IF (KOUNT.EQ.0) THEN                                                   MLTRI.74    
C                                                                            MLTRI.75    
C        Initialise new tracer fields.                                       MLTRI.76    
         IF (.NOT. LRSTRT) CALL ICTRAC                                       MLTRI.77    
C                                                                            MLTRI.78    
C        Add white noise perturbation                                        MLTRI.79    
C                                                                            MLTRI.80    
         IF (LNOISE.AND..NOT.LRSTRT) CALL NOISE                              MLTRI.81    
C                                                                            MLTRI.82    
C        Calculate restoration arrays                                        MLTRI.83    
C                                                                            MLTRI.84    
         IF (.NOT. LRESTIJ) CALL SETRES                                      MLTRI.85    
C                                                                            MLTRI.86    
      ENDIF                                                                  MLTRI.87    
C                                                                            MLTRI.88    
      IF (JGL.EQ.1) REWIND 25                                                MLTRI.89    
      KKOUT=KOUNT*(KOUNTP-KOUTP)                                             MLTRI.90    
      JL=1                                                                   MLTRI.91    
C                                                                            MLTRI.92    
C set surface pressure to 976mb                                              MLTRI.93    
      IF (DAY.LT.0.1) THEN                                                   MLTRI.94    
        print *,' setting surface pressure to 976mb'                         MLTRI.95    
        SP(1)=CMPLX((sqr2*(0.976-1.0)),0.0)                                  MLTRI.96    
      ENDIF                                                                  MLTRI.97    
      print*,kount                                                           NETCDF.38    
C     Main loop over latitudes                                               MLTRI.98    
C                                                                            MLTRI.99    
      DO 5 IH=1,JG                                                           MLTRI.100   
         JH=IH                                                               MLTRI.101   
         IF(JGL.EQ.1) READ(25) ALP,DALP,RLP,RDLP                             MLTRI.102   
C                                                                            MLTRI.103   
C        Go from spectral space to grid point space using                    MLTRI.104   
C        inverse Legendre and Fourier transforms                             MLTRI.105   
C                                                                            MLTRI.106   
         CALL LTI                                                            MLTRI.107   
         DO 10 I=1,NTWG                                                      MLTRI.108   
            CALL FFT991(DAG(1+(I-1)*NCRAY*MGPP),WORK,TRIG,IFAX,1,MGPP,MG     MLTRI.109   
     +                 ,NCRAY,1)                                             MLTRI.110   
 10      CONTINUE                                                            MLTRI.111   
         CALL FFT991(DAG(1+ NTWG*NCRAY*MGPP),WORK,TRIG,IFAX,1,MGPP,MG        MLTRI.112   
     +              ,NRSTWG,1)                                               MLTRI.113   
C                                                                            MLTRI.114   
C        Calculate nonlinear terms                                           MLTRI.115   
C                                                                            MLTRI.116   
         CALL MGRMLT                                                         MLTRI.117   
C                                                                            MLTRI.118   
C        Save grid point fields for use in XSECT                             MLTRI.119   
C                                                                            MLTRI.120   
         DO I=1,IGD                                                          MLTRI.121   
            ZG1(I,IH)=ZG(I)                                                  MLTRI.122   
            DG1(I,IH)=DG(I)                                                  MLTRI.123   
            UG1(I,IH)=UG(I)                                                  MLTRI.124   
            VG1(I,IH)=VG(I)                                                  MLTRI.125   
            TG1(I,IH)=TG(I)                                                  MLTRI.126   
         END DO                                                              MLTRI.127   
         DO I=1,IGC                                                          MLTRI.128   
            SPG1(I,IH)=SPG(I)                                                MLTRI.129   
         END DO                                                              MLTRI.130   
C         IF (KKOUT.EQ.0.AND.NLAT.GT.0) WRITE(24)ZG,DG,UG,VG,TG,SPG          MLTRI.131   
C                                                                            MLTRI.132   
C        Go from grid point space to spectral space using                    MLTRI.133   
C        direct Legendre and Fourier transforms                              MLTRI.134   
C                                                                            MLTRI.135   
         DO 20 I=1,NTGW                                                      MLTRI.136   
            CALL FFT991(DAF(1+(I-1)*NCRAY*MGPP),WORK,TRIG,IFAX,1,MGPP,MG     MLTRI.137   
     +                 ,NCRAY,-1)                                            MLTRI.138   
 20      CONTINUE                                                            MLTRI.139   
         CALL FFT991(DAF(1+ NTGW*NCRAY*MGPP),WORK,TRIG,IFAX,1,MGPP,MG        MLTRI.140   
     +              ,NRSTGW,-1)                                              MLTRI.141   
         CALL LTD                                                            MLTRI.142   
         JL=JL+JINC                                                          MLTRI.143   
 5    CONTINUE                                                               MLTRI.144   
C                                                                            MLTRI.145   
      IF (LBALAN) THEN                                                       MLTRI.146   
C        Balance spectral fields                                             MLTRI.147   
C                                                                            MLTRI.148   
         IF (KOUNT.LT.0) THEN                                                MLTRI.149   
            KOUNT=KOUNT+1                                                    MLTRI.150   
            IF (.NOT.LTBAL) CALL BALANC                                      MLTRI.151   
            IF (     LTBAL) CALL TBAL                                        MLTRI.152   
            CALL ENERGY                                                      MLTRI.153   
            GO TO 1                                                          MLTRI.154   
         ENDIF                                                               MLTRI.155   
      ENDIF                                                                  MLTRI.156   
C                                                                            MLTRI.157   
C      IF (KKOUT.EQ.0.AND.NLAT.GT.0) REWIND 24                               MLTRI.158   
C                                                                            MLTRI.159   
C     First timestep - output history and diagnostics                        MLTRI.160   
C                                                                            MLTRI.161   
      IF (KOUNT.EQ.0) THEN                                                   MLTRI.162   
c         REWIND 9                                                           MLTRI.163   
         RKOUNT=KOUNT                                                        MLTRI.164   
         IF (LMINIH) THEN                                                    MLTRI.165   
           RODATA(1)=RKOUNT                                                  MLTRI.166   
           RODATA(2)=RNTAPE                                                  MLTRI.167   
           RODATA(3)=DAY                                                     MLTRI.168   
           RODATA(4)=DOY                                                     MLTRI.169   
           DO J=1,IGP*(3+NTRAC)                                              MLTRI.170   
             RODATA(J+4)=R8DATA(J)                                           MLTRI.171   
           ENDDO                                                             MLTRI.172   
           DO J=1,IGO                                                        MLTRI.173   
             RODATA(J+4+IGP*(3+NTRAC))=R8SP(J)                               MLTRI.174   
           ENDDO                                                             MLTRI.175   
           RODATA(IGO+5+IGP*(3+NTRAC))=RNTAPE                                MLTRI.176   
           WRITE (9) (RODATA(J),J=1,5+IGO+IGP*(3+NTRAC))                     MLTRI.177   
C           write (*,*) IODSIZE,5+IGO+IGP*(3+NTRAC)                          MLTRI.178   
         ELSE                                                                MLTRI.179   
           WRITE(9) RKOUNT,RNTAPE,DAY,DOY,Z,D,T,TRA,SP,RNTAPE                MLTRI.180   
         ENDIF                                                               MLTRI.181   
         WRITE(2,2010)9,RKOUNT,RNTAPE,DAY,DOY                                MLTRI.182   
         IF (LRESTIJ) THEN                                                   MLTRI.183   
           WRITE(13)RKOUNT,RNTAPE,DAY,DOY,TTRES,RNTAPE                       MLTRI.184   
           WRITE(2,2020)13,RKOUNT,RNTAPE,DAY,DOY                             MLTRI.185   
         ENDIF                                                               MLTRI.186   
         CALL XSECT(INLAT)                                                   MLTRI.187   
         CALL SPOP                                                           MLTRI.188   
         CALL ENERGY                                                         MLTRI.189   
      ELSE IF (KOUNT.EQ.KSTART) THEN                                         MLTRI.190   
         CALL ENERGY                                                         MLTRI.191   
      ENDIF                                                                  MLTRI.192   
      IF (LRESTIJ) THEN                                                      MLTRI.193   
C                                                                            MLTRI.194   
C        Write a restoration record                                          MLTRI.195   
C                                                                            MLTRI.196   
         IF (KOUTH.EQ.KOUNTH.OR.KOUTR.EQ.KOUNTR) THEN                        MLTRI.197   
            RKOUNT=KOUNT                                                     MLTRI.198   
            WRITE(13)RKOUNT,RNTAPE,DAY,DOY,TTRES,RNTAPE                      MLTRI.199   
            WRITE(2,2020)13,RKOUNT,RNTAPE,DAY,DOY                            MLTRI.200   
         ENDIF                                                               MLTRI.201   
      ENDIF                                                                  MLTRI.202   
C                                                                            MLTRI.203   
C     Write a restart record                                                 MLTRI.204   
C                                                                            MLTRI.205   
      IF (KOUTR.EQ.KOUNTR) THEN                                              MLTRI.206   
         RKOUNT=KOUNT                                                        MLTRI.207   
         WRITE(11) RKOUNT,RNTAPE,DAY,DOY,Z,D,T,TRA,SP,RNTAPE                 MLTRI.208   
     +     ,ZMI,DMI,TMI,TRAMI,SPMI,HTNET,RNTAPE                              MLTRI.209   
         IF (LMASCOR)THEN                                                    MLTRI.210   
           RREC=2.0                                                          MLTRI.211   
           WRITE(11) RKOUNT,RNTAPE,DAY,RREC,GMSP0,GMSPMI,RNTAPE              MLTRI.212   
         ENDIF                                                               MLTRI.213   
         WRITE(19) -999.999                                                  MLTRI.214   
         WRITE(19) RKOUNT,RNTAPE,DAY,DOY,TSTAR,TDEEP,SMSTAR,QSTAR,           MLTRI.215   
     $        HSNOW,SQSTAR,SALB,SBAL,TSTARO,TDEEPO,SNET,RNTAPE               MLTRI.216   
         WRITE(2,2000)11,RKOUNT,RNTAPE,DAY,DOY                               MLTRI.217   
         KOUTR=0                                                             MLTRI.218   
      ENDIF                                                                  MLTRI.219   
C                                                                            MLTRI.220   
C     Write a history record                                                 MLTRI.221   
C                                                                            MLTRI.222   
      IF (KOUTH.EQ.KOUNTH) THEN                                              MLTRI.223   
         RKOUNT=KOUNT                                                        MLTRI.224   
         if (LMINIH) THEN                                                    MLTRI.225   
          RODATA(1)=RKOUNT                                                   MLTRI.226   
          RODATA(2)=RNTAPE                                                   MLTRI.227   
          RODATA(3)=DAY                                                      MLTRI.228   
          RODATA(4)=DOY                                                      MLTRI.229   
C          DO j=1,igb                                                        MLTRI.230   
C            RODATA(4+j)=z(j)                                                MLTRI.231   
C          ENDDO                                                             MLTRI.232   
          DO J=1,IGP*(3+NTRAC)                                               MLTRI.233   
            RODATA(J+4)=R8DATA(J)                                            MLTRI.234   
          ENDDO                                                              MLTRI.235   
          DO J=1,IGP                                                         MLTRI.236   
           RODATA(J+4+2*IGP)=TAVE(J)/REAL(KOUNTH)                            MLTRI.237   
           TAVE(J)=0.0                                                       MLTRI.238   
          ENDDO                                                              MLTRI.239   
          DO J=1,IGO                                                         MLTRI.240   
            RODATA(J+4+IGP*(3+NTRAC))=R8SP(J)                                MLTRI.241   
          ENDDO                                                              MLTRI.242   
          RODATA(IGO+5+IGP*(3+NTRAC))=RNTAPE                                 MLTRI.243   
          WRITE (9) (RODATA(J),J=1,5+IGO+IGP*(3+NTRAC))                      MLTRI.244   
        ELSE                                                                 MLTRI.245   
          WRITE(9) RKOUNT,RNTAPE,DAY,DOY,Z,D,T,TRA,SP,RNTAPE                 MLTRI.246   
        ENDIF                                                                MLTRI.247   
        WRITE(2,2010)9,RKOUNT,RNTAPE,DAY,DOY                                 MLTRI.248   
        KOUTH=0                                                              MLTRI.249   
      ENDIF                                                                  MLTRI.250   
C                                                                            MLTRI.251   
C     Output diagnostics                                                     MLTRI.252   
C                                                                            MLTRI.253   
      IF (KOUTP.EQ.KOUNTP) THEN                                              MLTRI.254   
         CALL XSECT(INLAT)                                                   MLTRI.255   
      call plotfields(0)                                                     GRAPHIC.3     
      kflag=1                                                                GRAPHIC.4     
         CALL SPOP                                                           MLTRI.256   
         KOUTP=0                                                             MLTRI.257   
      ENDIF                                                                  MLTRI.258   
      IF (KOUTE.EQ.KOUNTE) THEN                                              MLTRI.259   
         CALL ENERGY                                                         MLTRI.260   
         KOUTE=0                                                             MLTRI.261   
      ENDIF                                                                  MLTRI.262   
C                                                                            MLTRI.263   
      IF (KOUNT.LT.KTOTAL) THEN                                              MLTRI.264   
         KOUTP=KOUTP+1                                                       MLTRI.265   
         KOUTE=KOUTE+1                                                       MLTRI.266   
         KOUTH=KOUTH+1                                                       MLTRI.267   
         KOUTR=KOUTR+1                                                       MLTRI.268   
         KOUNT=KOUNT+1                                                       MLTRI.269   
         IF(KOUNT.EQ.1.AND.KITS.GT.0) DAY=DAY+DELT/PI2                       MLTRI.270   
         DAY=DAY+DELT/PI2                                                    MLTRI.271   
         IF (.NOT. LPERPET) THEN                                             MLTRI.272   
           IF(KOUNT.EQ.1.AND.KITS.GT.0) DOY=DOY+DELT/PI2                     MLTRI.273   
           DOY=DOY+DELT/PI2                                                  MLTRI.274   
           IF (DOY.GE.361) DOY = DOY-360.0                                   MLTRI.275   
         ENDIF                                                               MLTRI.276   
C                                                                            MLTRI.277   
C Adiabatic part of timestep                                                 MLTRI.278   
C                                                                            MLTRI.279   
         CALL TSTEP                                                          MLTRI.280   
C                                                                            MLTRI.281   
C Mass correction.                                                           MLTRI.282   
C                                                                            MLTRI.283   
         IF (LMASCOR) THEN                                                   MLTRI.284   
            CALL MASCOR                                                      MLTRI.285   
         ELSE IF(LRESTIJ) THEN                                               MLTRI.286   
C Simple fix to maintain mass.                                               MLTRI.287   
            SP(1)=CMPLX(0.,0.)                                               MLTRI.288   
         ENDIF                                                               MLTRI.289   
C                                                                            MLTRI.290   
C Diabatic part of timestep. Preset tendencies to zero.                      MLTRI.291   
C                                                                            MLTRI.292   
         DO 33 I=1,IGB                                                       MLTRI.293   
            ZT(I)=0.0                                                        MLTRI.294   
            DT(I)=0.0                                                        MLTRI.295   
            TT(I)=0.0                                                        MLTRI.296   
   33    CONTINUE                                                            MLTRI.297   
         DO 36 KK=1,NTRAC                                                    MLTRI.298   
            DO 36 I=1,IGB                                                    MLTRI.299   
               TRAT(I,KK)=0.0                                                MLTRI.300   
   36    CONTINUE                                                            MLTRI.301   
C                                                                            MLTRI.302   
C        Set parameters for optional Newtonian cooling.                      MLTRI.303   
C                                                                            MLTRI.304   
         IF (LRESTIJ) CALL SETTEE                                            MLTRI.305   
C                                                                            MLTRI.306   
C        Preset accumulated diagnostics.                                     MLTRI.307   
C                                                                            MLTRI.308   
         IF (KOUTH.EQ.1) THEN                                                MLTRI.309   
            DO 232 I=1,IDDZ                                                  MLTRI.310   
               ADDZ(I)=0.0                                                   MLTRI.311   
  232       CONTINUE                                                         MLTRI.312   
         ENDIF                                                               MLTRI.313   
C                                                                            MLTRI.314   
C        Loop over latitude for spectral transforms                          MLTRI.315   
C        and calculation of diabatic tendencies.                             MLTRI.316   
C                                                                            MLTRI.317   
         IF (JGL.EQ.1) REWIND(25)                                            MLTRI.318   
C      REWIND NAVRD                                                          MLTRI.319   
C      REWIND NAVWT                                                          MLTRI.320   
         JL=1                                                                MLTRI.321   
         DO 260 IH=1,JG                                                      MLTRI.322   
            JH=IH                                                            MLTRI.323   
            IF(JGL.EQ.1) READ(25) ALP,DALP,RLP,RDLP                          MLTRI.324   
C                                                                            MLTRI.325   
C        Go from spectral space to grid point space using                    MLTRI.326   
C        inverse Legendre and Fourier transforms                             MLTRI.327   
C                                                                            MLTRI.328   
            CALL LTI                                                         MLTRI.329   
            DO 210 I=1,NTWG                                                  MLTRI.330   
               CALL FFT991(DAG(1+(I-1)*NCRAY*MGPP),WORK,TRIG,IFAX,           MLTRI.331   
     +                 1,MGPP,MG,NCRAY,1)                                    MLTRI.332   
 210        CONTINUE                                                         MLTRI.333   
            CALL FFT991(DAG(1+ NTWG*NCRAY*MGPP),WORK,TRIG,IFAX,              MLTRI.334   
     +                  1,MGPP,MG,NRSTWG,1)                                  MLTRI.335   
C                                                                            MLTRI.336   
C        Calculate diabatic terms                                            MLTRI.337   
C                                                                            MLTRI.338   
            CALL DGRMLT                                                      MLTRI.339   
C                                                                            MLTRI.340   
C        Write accumulated diagnostics to history file.                      MLTRI.341   
      if (kflag.eq.1.and.nlat.gt.0) write(24)grpad                           GRAPHIC.5     
            RKOUNT=KOUNT                                                     MLTRI.342   
            RIH=IH                                                           MLTRI.343   
            IF (KOUTH.EQ.KOUNTH) THEN                                        MLTRI.344   
              RODATA(1)=RKOUNT                                               MLTRI.345   
              RODATA(2)=RNTAPE                                               MLTRI.346   
              RODATA(3)=DAY                                                  MLTRI.347   
              RODATA(4)=DOY                                                  MLTRI.348   
              RODATA(5)=RIH                                                  MLTRI.349   
              IF (LSHIST) THEN                                               MLTRI.350   
                DO J=1,NGRPAD/2                                              MLTRI.351   
                  RODATA(J+5)=GRPAD(J)                                       MLTRI.352   
                ENDDO                                                        MLTRI.353   
                RODATA(NGRPAD/2+6)=RNTAPE                                    MLTRI.354   
                DO J=1,IGD                                                   MLTRI.355   
                  RODATA(NGRPAD/2+6+J)=TNLG(J)                               MLTRI.356   
                ENDDO                                                        MLTRI.357   
                RODATA(NGRPAD/2+7+IGD)=RNTAPE                                MLTRI.358   
                WRITE (9) (RODATA(J),J=1,NGRPAD/2+IGD+7)                     MLTRI.359   
              ELSE                                                           MLTRI.360   
                DO J=1,NGRPAD                                                MLTRI.361   
                  RODATA(J+5)=GRPAD(J)                                       MLTRI.362   
                ENDDO                                                        MLTRI.363   
                RODATA(NGRPAD+6)=RNTAPE                                      MLTRI.364   
                DO J=1,IGD                                                   MLTRI.365   
                  RODATA(NGRPAD+6+J)=TNLG(J)                                 MLTRI.366   
C  TNLG (gridded heating) is not required in history file. When new          MLTRI.367   
C  version of flux programme is created TNLG should be removed               MLTRI.368   
C  from RODATA.                                                              MLTRI.369   
                ENDDO                                                        MLTRI.370   
                RODATA(NGRPAD+7+IGD)=RNTAPE                                  MLTRI.371   
                WRITE (9) (RODATA(J),J=1,NGRPAD+IGD+7)                       MLTRI.372   
              ENDIF                                                          MLTRI.373   
            ENDIF                                                            MLTRI.374   
C                                                                            MLTRI.375   
C        Go from grid point space to spectral space using                    MLTRI.376   
C        direct Legendre and Fourier transforms                              MLTRI.377   
C                                                                            MLTRI.378   
            DO 220 I=1,NTGD                                                  MLTRI.379   
               CALL FFT991(DAD(1+(I-1)*NCRAY*MGPP),WORK,TRIG,IFAX,           MLTRI.380   
     +                     1,MGPP,MG,NCRAY,-1)                               MLTRI.381   
 220        CONTINUE                                                         MLTRI.382   
            CALL FFT991(DAD(1+ NTGD*NCRAY*MGPP),WORK,TRIG,IFAX,              MLTRI.383   
     +                  1,MGPP,MG,NRSTGD,-1)                                 MLTRI.384   
C                                                                            MLTRI.385   
            CALL LTDDIA                                                      MLTRI.386   
            JL=JL+JINC                                                       MLTRI.387   
 260     CONTINUE                                                            MLTRI.388   
C                                                                            MLTRI.389   
C Write zonally averaged diagnostics and spectral heating                    MLTRI.390   
C to history file.                                                           MLTRI.391   
C                                                                            MLTRI.392   
      if (kflag.eq.1) then                                                   GRAPHIC.6     
         if (nlat.gt.0) rewind 24                                            GRAPHIC.7     
         call plotfields2(1)                                                 GRAPHIC.8     
      call netout2                                                           NETCDF.33    
         kflag=0                                                             GRAPHIC.9     
      end if                                                                 GRAPHIC.10    
         IF(KOUTH.GE.1.AND.KOUTH.LE.KOUNTH) THEN                             MLTRI.393   
           DO 270 I=1,IDDZ                                                   MLTRI.394   
  270      ADDZ(I)=ADDZ(I)+DDZ(I)                                            MLTRI.395   
         ENDIF                                                               MLTRI.396   
         IF(KOUTH.EQ.KOUNTH) THEN                                            MLTRI.397   
           RKP=1.0/REAL(KOUNTH)                                              MLTRI.398   
           DO 280 I=1,IDDZ                                                   MLTRI.399   
  280      ADDZ(I)=ADDZ(I)*RKP                                               MLTRI.400   
           RKOUNT=KOUNT                                                      MLTRI.401   
           RIH=JGP                                                           MLTRI.402   
           IF (LMINIH) THEN                                                  MLTRI.403   
             RODATA(1)=RKOUNT                                                MLTRI.404   
             RODATA(2)=RNTAPE                                                MLTRI.405   
             RODATA(3)=DAY                                                   MLTRI.406   
             RODATA(4)=DOY                                                   MLTRI.407   
             RODATA(5)=RIH                                                   MLTRI.408   
             DO j=1,iddz                                                     MLTRI.409   
               RODATA(J+5)=ADDZ(J)                                           MLTRI.410   
               RODATA(J+IDDZ+5)=DDZ(J)                                       MLTRI.411   
             ENDDO                                                           MLTRI.412   
             RODATA(6+IDDZ*2)=RNTAPE                                         MLTRI.413   
             WRITE (9) (RODATA(J),J=1,IDDZ*2+6)                              MLTRI.414   
             RIH=RIH+1                                                       MLTRI.415   
             RODATA(5)=RIH                                                   MLTRI.416   
             DO J=1,IGP                                                      MLTRI.417   
               RODATA(J+5)=R8TT(J)                                           MLTRI.418   
             ENDDO                                                           MLTRI.419   
             RODATA(IGP+6)=RNTAPE                                            MLTRI.420   
             WRITE (9) (RODATA(J),J=1,IGP+6)                                 MLTRI.421   
           ELSE                                                              MLTRI.422   
             WRITE(9)RKOUNT,RNTAPE,DAY,DOY,RIH,ADDZ,DDZ,RNTAPE               MLTRI.423   
             RIH=RIH+1                                                       MLTRI.424   
             WRITE(9)RKOUNT,RNTAPE,DAY,DOY,RIH,TT,RNTAPE                     MLTRI.425   
           ENDIF                                                             MLTRI.426   
         ENDIF                                                               MLTRI.427   
C      NTEMP=NAVRD                                                           MLTRI.428   
C      NAVRD=NAVWT                                                           MLTRI.429   
C      NAVWT=NTEMP                                                           MLTRI.430   
 300     CONTINUE                                                            MLTRI.431   
C                                                                            MLTRI.432   
C Apply dissipation and optional linear restoration.                         MLTRI.433   
C                                                                            MLTRI.434   
         CALL DIFUSE                                                         MLTRI.435   
C                                                                            MLTRI.436   
C Update spectral fields in the diabatic timestep.                           MLTRI.437   
C                                                                            MLTRI.438   
         CALL DSTEP                                                          MLTRI.439   
C                                                                            MLTRI.440   
C End of timestep                                                            MLTRI.441   
         DO J=1,IGB                                                          MLTRI.442   
           TAVE(j*2-1)=TAVE(J*2-1)+REAL(T(J))                                MLTRI.443   
           TAVE(j*2)=TAVE(J*2)+AIMAG(T(J))                                   MLTRI.444   
         ENDDO                                                               MLTRI.445   
C                                                                            MLTRI.446   
         GO TO 1 ! time loop                                                 MLTRI.447   
      ENDIF ! end of IF(KOUNT.LT.KTOTAL)                                     MLTRI.448   
C                                                                            MLTRI.449   
C Write the final restart record                                             MLTRI.450   
C                                                                            MLTRI.451   
      call end_netcdf                                                        NETCDF.34    
      RKOUNT=KOUNT                                                           MLTRI.452   
      WRITE(12) RKOUNT,RNTAPE,DAY,DOY,Z,D,T,TRA,SP,RNTAPE                    MLTRI.453   
     +     ,ZMI,DMI,TMI,TRAMI,SPMI,HTNET,RNTAPE                              MLTRI.454   
      IF(LMASCOR)THEN                                                        MLTRI.455   
         RREC=2.0                                                            MLTRI.456   
         WRITE(12) RKOUNT,RNTAPE,DAY,RREC,GMSP0,GMSPMI,RNTAPE                MLTRI.457   
      ENDIF                                                                  MLTRI.458   
      WRITE(17) -999.999                                                     MLTRI.459   
      WRITE(17) RKOUNT,RNTAPE,DAY,DOY,TSTAR,TDEEP,SMSTAR,QSTAR,              MLTRI.460   
     $        HSNOW,SQSTAR,SALB,SBAL,TSTARO,TDEEPO,SNET,RNTAPE               MLTRI.461   
      WRITE(2,2000)12,RKOUNT,RNTAPE,DAY,DOY                                  MLTRI.462   
      IF (LRESTIJ) THEN                                                      MLTRI.463   
         WRITE(13)RKOUNT,RNTAPE,DAY,DOY,TTRES,RNTAPE                         MLTRI.464   
         WRITE(2,2020)13,RKOUNT,RNTAPE,DAY,DOY                               MLTRI.465   
      ENDIF                                                                  MLTRI.466   
      call end_graphics                                                      GRAPHIC.11    
C                                                                            MLTRI.467   
      STOP                                                                   MLTRI.468   
      END                                                                    MLTRI.469   
