C *****************************************************************************
C
C       PROGRAM = QWORLD.FOR
C       CODE IDENTIFICATION NUMBER = QWORLD/VERSION 1.0
C       CODE CLASSIFICATION = SCIENTIFIC COMPUTER CODE
C       CREATION DATE = OCTOBER 18, 1989
C       REVISION DATE = not revised
C       REVISION INFORMATION = not applicable
C
C *****************************************************************************

C       This program converts a (72x36) WORLDxx.DAT into a (36x48) array. 
C       The new array has 36 uniformly distributed points in the zonal
C       direction, while 48 Gaussian quadrature points in the meridional
C       direction.


c  Sizes of output file.
      parameter (nxpo=360, nypo=180)
c  Sizes of input file.
      parameter (nxpi=360, nypi=180)

      dimension iwd(nxpi,nypi), jwd(nxpo,nypo)
      character*50 filnm1, formt1, filnm2, formt2

      pi = atan(1.)*4.

      write (*,*) ' Enter input filename: '
      read (*,17) filnm1
   17 format (a)

      write (*,*) ' Enter input file format, e.g. (16i5): '
      read (*,17) formt1

      write (*,*) ' Enter input file size, e.g. 360 180: '
      read (*,*) nxi,nyi

      write (*,*) ' Enter output filename: '
      read (*,17) filnm2

      write (*,*) ' Enter output file format, e.g. (48i1): '
      read (*,17) formt2

      write (*,*) ' Enter output file size, e.g. 48 40: '
      read (*,*) nxo,nyo

      open(unit=9, file=filnm1, status='old')

c  Read input file.
      do 10 j=1,nyi,1
        read (9,formt1) (iwd(i,j),i=1,nxi,1)
   10 continue
c   11 format (16i5)
c   11 format ('formt1')

      dx = 360./float(nxo)
      dy = 180./float(nyo)

      ddx = 360./float(nxi)
      ddy = 180./float(nyi)

      do 20 i=1,nxo
        x = dx*float(i-1)
        ii = int(x/ddx) + 1
        do 20 j=1,nyo
          y = dy*float(j-1)
          jj = int(y/ddy) + 1
          jwd(i,j) = iwd(ii,jj)
c         write (*,*) i,j,ii,jj,iwd(ii,jj),jwd(i,j)
20    continue

      open(unit=6, file=filnm2, status='new', carriagecontrol='list',
     &     recl=400)

      do 100 j=1,nyo,1
        write(6,formt2) (jwd(i,j),i=1,nxo,1)
  100 continue

      stop
      end