*-----------------------------------------------------------------------
*     TOMS OZONE DISTRIBUTION (MONTHLY MEAN CLIMATOLOGY)
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      PROGRAM XIMG01

      PARAMETER (KXBK=12,IXBK=KXBK*2+1,JXBK=37)
      PARAMETER (IXBG=73,JXBG=37)
      PARAMETER (IXGX=361,JXGX=181)
      PARAMETER (NCL=100, NCL1=NCL+1)

      INTEGER   IPATN(NCL)
      REAL      BKDATA(IXBK,JXBK),BGDATA(IXBG,JXBG),GXDATA(IXGX,JXGX),
     +          TLEVN(NCL1)
      CHARACTER CDSN*80

      EXTERNAL  ISGTRC


      DO 10 I=1, NCL
        IPATN(I) = MAX(11, I) *1000 + 999
   10 CONTINUE

      DO 20 I=1,NCL+1
        TLEVN(I) = I*3.0 + 200
   20 CONTINUE

      CDSN='tomsclm.dat'
      OPEN(11,FILE=CDSN,FORM='FORMATTED')

      CALL SWLSTX('LWAIT', .TRUE.)
      CALL SWLSTX('LWAIT0', .FALSE.)
      CALL SWLSTX('LALT', .FALSE.)
      CALL SWISTX('IPOSX', 200)
      CALL SWISTX('IPOSY', 200)
      CALL SWISTX('IWIDTH',  800)
      CALL SWISTX('IHEIGHT', 400)

      CALL SGPWSN
      READ(*,*) IWS

      CALL GROPN(IWS)
      CALL GLLSET('LMISS', .TRUE.)
      CALL GLRGET('RMISS', RMISS)
      CALL SGLSET('LFULL', .TRUE.)
      CALL SGLSET('LSOFTF', .FALSE.)
      CALL UMLSET('LGLOBE', .TRUE.)
      CALL SLRAT(1.0, 0.5)

      DO 100 M=1, 12

        READ(11,'(TR9,I2)') MON
        DO 30 J=1,JXBK
          READ(11,'(F8.3,8F8.3,2(/TR8,8F8.3))') 
     +         (BKDATA(I,J),I=1,IXBK)
   30   CONTINUE
        CALL BKTOBG(BKDATA,BGDATA)
        CALL RSET0(GXDATA,IXGX*JXGX,1,RMISS)
        DO 40 J=1,JXBG
          JJ=(J-1)*5+1
          CALL VRSET(BGDATA(1,J),GXDATA(1,JJ),IXBG,1,5)
          CALL VRINTR(GXDATA(1,JJ),IXGX,1)
   40   CONTINUE
        DO 50 I=1,IXGX
          CALL VRINTR(GXDATA(I,1),JXGX,IXGX)
   50   CONTINUE

        CALL GRFRM

        CALL GRSWND(0., 360., -90., 90.)
        CALL GRSMPL(180., 90., 0.)
        CALL GRSTRN(ISGTRC('HMR'))
        CALL UMPFIT
        CALL GRSTRF

        CALL SLPWWR(1)
        CALL UEITLV
        CALL UESTLN(TLEVN, IPATN, NCL)
        CALL UETONF(GXDATA, IXGX, IXGX, JXGX)

        CALL UMPGRD
        CALL UMPLIM
        CALL UMPMAP('coast_world')

  100 CONTINUE

      CALL GRCLS

      END
*-----------------------------------------------------------------------
*     BKTOBG
*-----------------------------------------------------------------------
      SUBROUTINE BKTOBG(BKDATA,BGDATA)
 
      PARAMETER (IXBG=73,JXBG=37)
 
      REAL      BKDATA(*),BGDATA(IXBG,JXBG)
 
 
      CALL GLRGET('RMISS',RMISS)
*     CALL DTPGET('MAXWN',KX)
      KX=12
      IXBK=KX*2+1
      JXBK=JXBG
 
      DO 10 J=1,JXBG
        IDXBK=IXBK*(J-1)+1
        IF (BKDATA(IDXBK).EQ.RMISS) THEN
          CALL RSET0(BGDATA(1,J),IXBG,1,RMISS)
        ELSE
          CALL FFTEZB(BKDATA(IDXBK),KX,BGDATA(1,J),IXBG-1)
          BGDATA(IXBG,J)=BGDATA(1,J)
        END IF
   10 CONTINUE
 
      END
*-----------------------------------------------------------------------
      SUBROUTINE FFTEZB(FC,MAXWN,X,NX)
 
      REAL      X(NX),FC(0:MAXWN*2)
 
      PARAMETER (NMAX=512,NWORK=NMAX*2+15)
 
      REAL      Y(NMAX+1),WSAVE(NWORK)
      CHARACTER CMSG*80
 
      SAVE
 
      DATA      NN/0/
 
 
      IF (NX.GT.NMAX) THEN
        CMSG='WORKING AREA IS NOT ENOUGH / NX SHOULD BE .LE. ####.'
        WRITE(CMSG(48:51),'(I4)') NMAX
        CALL MSGDMP('E','FFTEZB',CMSG)
      END IF
      IF (NX.LT.MAXWN*2) THEN
        CMSG='MAXWN CANNOT BE CALCULATED / NX SOULD BE .GE. MAXWN*2.'
        CALL MSGDMP('E','FFTEZB',CMSG)
      END IF
 
      IF (NX.NE.NN) THEN
        CALL RFFTI(NX,WSAVE)
        NN=NX
      END IF
 
      CALL RSET0(Y,NX+1,1,0.0)
      CALL VRSET(FC,Y,MAXWN*2+1,1,1)
      CALL RMLT0(Y(2),MAXWN,2,+0.5)
      CALL RMLT0(Y(3),MAXWN,2,-0.5)
      CALL RFFTB(NX,Y,WSAVE)
      CALL VRSET(Y,X,NX,1,1)
 
      END
