c ____________________________________________________________________________
c/  Program:   makehumv                                   ROTANG              \
c|  Release:   1.3.0                              http://www.rotang.com/      | 
c|  Date:      $Date: 2001/10/13 23:35:10 $       Email: makehumv@rotang.com  |
c|  Revision:  $Revision: 1.4 $                   ROTANG -- ZOOM! NOT BOOM!   |
c|  Author:    Jace A Mogill                            Copyright 2001        |
c+----------------------------------------------------------------------------+
c|                 makehumv is yours to do with as you please                 |
c\____________________________________________________________________________/
c
c  Example Compilation:
c    f77 -DINT16 makehumv.F -o makehumv
c
c    -D compile options are listed in this failsafe check
c       for a default type.
c       Users should set min/max values appropriate to their
c       field's data range
c
c Basic Experiment Parameters
#define UV            1
#define OUTPUT_WIDTH  50
#define OUTPUT_HEIGHT 30
#define OUTPUT_NPIXELS (OUTPUT_WIDTH * OUTPUT_HEIGHT)


#if defined(INT1)
# define  HUMV_TYPE     integer*1
# define  NBPW          1
# define  INT_TYPE      1
#elif( defined(INT2) )
# define  HUMV_TYPE     integer*2
# define  NBPW          2
# define  INT_TYPE      1
#elif( defined(INT4) )
# define  HUMV_TYPE     integer*4
# define  NBPW          4
# define  INT_TYPE      1
#elif( defined(INT8) )
# define  HUMV_TYPE     integer*8
# define  NBPW          8
# define  INT_TYPE      1
#elif( defined(REAL4) )
# define  HUMV_TYPE     real*4
# define  NBPW          4
# define  INT_TYPE      0
#elif( defined(REAL8) )
# define  HUMV_TYPE     real*8
# define  NBPW          8
# define  INT_TYPE      0
#else
  You must define (-D) a type of INT1, INT2, INT4, INT8, REAL4, REAL8
#endif


c=============================================================================
c=============================================================================

      program make_humv
      IMPLICITNONE!!!

      integer*1    buffer(2 * OUTPUT_HEIGHT, OUTPUT_WIDTH * NBPW)

      call generator(OUTPUT_WIDTH, OUTPUT_HEIGHT, buffer,
     $     NBPW, INT_TYPE, UV)
      call write_humv('foo.humv', 20, buffer)

      stop
      end


      subroutine write_humv(fname, unitn, buffer)
      IMPLICITNONE!!!
#include "humv.incl"

      character*(*) fname
      integer       unitn
      integer*1     buffer(humv_height * humv_width * humv_nbpw * 2)

      data humv_magic /21120/
      data humv_header_length /magic_humv_header_length/
      data humv_signed_int /1/  ! Always TRUE for FORTRAN

      print *, '_______  Writing "', fname,'" on unit ',unitn,' _______'
      print *, 'humv_width       =', humv_width
      print *, 'humv_height      =', humv_height
      print *, 'humv_bpw         =', humv_nbpw
      print *, 'humv_int_type    =', humv_int_type
      print *, 'humv_uv          =', humv_uv

      open(unit=unitn, name=fname, access='direct', 
     $     recl=humv_header_length + 
     $          (humv_width * humv_height * humv_nbpw * 2),
     $     form='unformatted')
      write(unit=unitn, rec=1) humv_header_alias, buffer
      close(unit=unitn)
      
      return
      end


      subroutine generator( w, h, buf, nbpw, int_type, uv)
      IMPLICITNONE!!!
#include "humv.incl"

      integer   w, h
      HUMV_TYPE buf(2, w, h)
      integer   nbpw
      integer   int_type
      integer   uv
      integer   j, i

      humv_width      = w
      humv_height     = h
      humv_nbpw       = nbpw
      humv_int_type   = int_type
      humv_uv         = uv

#if defined(INT1)
      humv_even_min_i1   =  0
      humv_even_max_i1   =  100
      humv_odd_min_i1    =  0
      humv_odd_max_i1    =  127
#elif( defined(INT2) )
      humv_even_min_i2   = -10000
      humv_even_max_i2   =  10000
      humv_odd_min_i2    =  20000
      humv_odd_max_i2    =  30000
#elif( defined(INT4) )
      humv_even_min_i4   = -1000000
      humv_even_max_i4   =  1000000
      humv_odd_min_i4    =  4000000
      humv_odd_max_i4    =  5000000
#elif( defined(INT8) )
      humv_even_min_i8   = -100000000
      humv_even_max_i8   =  100000000
      humv_odd_min_i8    =  600000000
      humv_odd_max_i8    =  700000000
#elif( defined(REAL4) )
      humv_even_min_r4   = -1.0
      humv_even_max_r4   =  1.0
      humv_odd_min_r4    =  8.0
      humv_odd_max_r4    =  9.0
#elif( defined(REAL8) )
      humv_even_min_r8   = -1.0
      humv_even_max_r8   =  1.0
      humv_odd_min_r8    =  100.0
      humv_odd_max_r8    =  10E+100
#else
  You must define (-D) one of INT1, INT2, INT4, INT8, REAL4, REAL8
#endif

      do j = 1, h
         do i = 1, w
#if defined(INT1)
              buf(1,i,j) = ((real(i-1)/real(w-1)) * 
     $                      real(humv_even_max_i1 - humv_even_min_i1)) + 
     $                     humv_even_min_i1
              buf(2,i,j) = ((real(j-1)/real(h-1)) * 
     $                      real(humv_odd_max_i1 - humv_odd_min_i1)) + 
     $                     humv_odd_min_i1
#elif( defined(INT2) )
            if( (i .ge. (j-5)) .and.
     $          (i .le. (j+5)) .and.
     $          (j .ge. (i-5)) .and.
     $          (j .le. (i+5)) ) then
               buf(1,i,j) = humv_even_min_i2 - 1
               buf(2,i,j) = humv_odd_min_i2 - 1
            else
              buf(1,i,j) = ((real(i-1)/real(w-1)) * 
     $                     (humv_even_max_i2 - humv_even_min_i2)) + 
     $                    humv_even_min_i2
              buf(2,i,j) = ((real(j-1)/real(h-1)) * 
     $                     (humv_odd_max_i2 - humv_odd_min_i2)) + 
     $                    humv_odd_min_i2
           endif
#elif( defined(INT4) )
           if( (i .lt. w/8      .and.  j .lt. h/8 )  .or.
     $         (i .gt. (w-w/8)  .and.  j .gt. (h-h/8)) ) then
               buf(1,i,j) = humv_even_min_i4 - 1
               buf(2,i,j) = humv_odd_max_i4 + 1
            else
              buf(1,i,j) = ((real(i-1)/real(w-1)) * 
     $                     (humv_even_max_i4 - humv_even_min_i4)) + 
     $                    humv_even_min_i4
              buf(2,i,j) = ((real(j-1)/real(h-1)) * 
     $                     (humv_odd_max_i4 - humv_odd_min_i4)) + 
     $                    humv_odd_min_i4
           endif
#elif( defined(INT8) )
              buf(1,i,j) = ((real(i-1)/real(w-1)) * 
     $                     (humv_even_max_i8 - humv_even_min_i8)) + 
     $                    humv_even_min_i8
              buf(2,i,j) = ((real(j-1)/real(h-1)) * 
     $                     (humv_odd_max_i8 - humv_odd_min_i8)) + 
     $                    humv_odd_min_i8
#elif( defined(REAL4) )
            if(i .eq. j) then
               buf(1,i,j) = 9999.9
               buf(2,i,j) = 9999.9
            else
              buf(1,i,j) = ((real(i-1)/real(w-1)) * 
     $                     (humv_even_max_r4 - humv_even_min_r4)) + 
     $                    humv_even_min_r4
              buf(2,i,j) = ((real(j-1)/real(h-1)) * 
     $                     (humv_odd_max_r4 - humv_odd_min_r4)) + 
     $                    humv_odd_min_r4
           endif
#elif( defined(REAL8) )
           if(i .gt. w/2  .or.  j .gt. h/2) then
              buf(1,i,j) = ((real(i-1)/real(w-1)) * 
     $                     (humv_even_max_r8 - humv_even_min_r8)) + 
     $                    humv_even_min_r8
              buf(2,i,j) = ((real(j-1)/real(h-1)) * 
     $                     (humv_odd_max_r8 - humv_odd_min_r8)) + 
     $                    humv_odd_min_r8
           else
               buf(1,i,j) = humv_even_max_r8 + 1.0
               buf(2,i,j) = humv_odd_min_r8 - 1.0
            endif
#else
  You must define (-D) a type of INT1, INT2, INT4, INT8, REAL4, REAL8
#endif
         enddo
      enddo
         
      return
      end
