*
* Kiso Enshu 2002, Sample program #4
************************************************************************
      program opcor
*
      implicit none
*
      integer     imax, jmax, ify, ifm, nmo, nrec
      real*4      xmiss
      parameter ( imax = 144, jmax = 73 )
      parameter ( ify = 1948, ifm = 1, nmo = 12, nrec = 648 )
      parameter ( xmiss = -999. )
*
      real*4      xdat( imax,jmax )
      real*4      z   ( imax,jmax,nrec )
      real*4      ref( nrec )
      real*4      y( nrec )
      real*4      r( imax,jmax )
      real*4      alon, alat, cor
      integer     iy, im, irec, nobs
      integer     ix, jy
      integer     i, j
*
      character   cfin*90
      character   cfout*90
*
* $BF~=PNO%U%!%$%kL>;XDj(B ($BMW=q$-49$((B)
*-----------------
      data        cfin
     &/'/home/hiro/kiso/data/z500.mon.anm.grd'/
      data        cfout
     &/'/home/hiro/kiso/data/z500.opcor.grd'/
*-----------------
*
*     open file
      open( 10, file=cfin, form='unformatted',
     &          access='direct', recl=4*imax*jmax )
      open( 20, file=cfout, form='unformatted',
     &          access='direct', recl=4*imax*jmax,
     &          status='unknown'                  )
*
      write( *,* )  '@ 1-POINT CORRELATION '

      write( *,* )  ' @ INPUT X (1-144) '
      read( 5,* )   ix
      write( *,* )  ' @ INPUT Y (1-73) '
      read( 5,* )   jy

      alon = 0. + (ix-1) * 2.5
      alat = -90. + (jy-1) * 2.5
      write( *,* )  ' @ REFERENCE POINT IS: '
      write( *,* )  '   LON = ', alon, ' LAT= ', alat
*
      irec = 0
      iy   = ify
      im   = ifm  - 1
 1000 irec = irec + 1
      im   = im   + 1
      read( 10, rec=irec ) xdat

      do j = 1, jmax
         do i = 1, imax
            z( i,j,irec ) = xdat( i,j )
         enddo
      enddo
      ref( irec ) = xdat( ix,jy )

      if( im .eq. nmo ) then
         im = 0
         iy = iy + 1
      endif

      if( irec .eq. nrec ) goto 99
      goto 1000
 99   close( 10 )
      write( *,* )  '@ FINISH READING '
*
* $B;~7ONs(Bref$B$HG[Ns(Bz$B$N3FE@$GAj4X$r7W;;(B ($BMW:n@.(B)
*
      nobs = nrec / 10 * 8
      do j = 1, jmax
         do i = 1, imax
            do irec = 1, nrec
               y( irec ) = z( i,j,irec )
            enddo
            if( i .eq. ix .and. j .eq. jy ) then
               cor = 1.0
            else
               call corcoe 
     I              ( ref, y, nrec, 1, nrec, nobs, xmiss, xmiss,
     O              cor )
               r( i,j ) = cor
            endif
         enddo
      enddo
*
* $B=PNO7k2L$r%U%!%$%k$K=PNO(B ($BMW:n@.(B)
*
      write( 20, rec=1 ) r
      close( 20 )
      write( *,* )  '@ FINISH COMPUTING CORR. '
*
      stop
      end
