*-----------------------------------------------------------------------
*     TOMS OZONE DISTRIBUTION (MONTHLY MEAN CLIMATOLOGY)
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 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 UEITLV
        CALL UESTLN(TLEVN, IPATN, NCL)
        CALL UETONF(GXDATA, IXGX, IXGX, JXGX)
        CALL SLPWWR(1)

        CALL SLPWWR(1)
        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
