!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! MODULE CONSTANTS_MODULE
!
! This module defines constants that are used by other modules 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
module constants_module

   real, parameter :: PI = 3.141592653589793
   real, parameter :: OMEGA_E = 7.292e-5 ! Angular rotation rate of the earth

   real, parameter :: DEG_PER_RAD = 180./PI
   real, parameter :: RAD_PER_DEG = PI/180.
 
   ! Mean Earth Radius in m.  The value below is consistent
   ! with NCEP's routines and grids.
   real, parameter :: A_WGS84  = 6378137.
   real, parameter :: B_WGS84  = 6356752.314
   real, parameter :: RE_WGS84 = A_WGS84
   real, parameter :: E_WGS84  = 0.081819192

   real, parameter :: A_NAD83  = 6378137.
   real, parameter :: RE_NAD83 = A_NAD83
   real, parameter :: E_NAD83  = 0.0818187034

   real, parameter :: EARTH_RADIUS_M = 6370000.   ! same as MM5 system
   real, parameter :: EARTH_CIRC_M = 2.*PI*EARTH_RADIUS_M

   real, parameter :: P0 = 1.0e5  ! Reference surface pressure, Pa
   real, parameter :: RD = 287.0  ! Gas constant for dry air
   real, parameter :: CP = 1004.0 ! Heat capacity for dry air at const. pressure

end module constants_module

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! MODULE MISC_DEFINITIONS_MODULE
!
! This module defines various non-meteorological constants that are used 
!   by other modules for readability.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
module misc_definitions_module

   integer, parameter :: MAX_FILENAME_LEN = 1024

   real   , parameter :: NAN=1.E20

   real   , parameter :: NOT_MASKED   = -2.,  &
                         MASKED_BOTH  = -1.,  &
                         MASKED_WATER =  0.,  &
                         MASKED_LAND  =  1.

   integer, parameter :: OUTSIDE_DOMAIN=1E8,  &
                         NOT_PROCESSED=1E9 ,  &
                         INVALID=1E9

   integer, parameter :: SIXTEEN_POINT=1,     &
                         FOUR_POINT=2,        &
                         N_NEIGHBOR=3,        &
                         AVERAGE4=4,          &
                         AVERAGE16=5,         &
                         W_AVERAGE4=6,        &
                         W_AVERAGE16=7,       &
                         SEARCH=8

   integer, parameter :: BOTTOM_TOP=1,        &
                         TOP_BOTTOM=2

   integer, parameter :: CONTINUOUS=0,        &
                         CATEGORICAL=1,       &
                         SP_CONTINUOUS=2

   integer, parameter :: M=1,                 &
                         U=2,                 &
                         V=3,                 &
                         HH=4,                &
                         VV=5,                &
                         CORNER=6

   integer, parameter :: ONETWOONE=1,         &
                         SMTHDESMTH=2,        &
                         SMTHDESMTH_SPECIAL=3

   integer, parameter :: BINARY=1,            &
                         NETCDF=2,            &
                         GRIB1=3,             &
                         HDF=4

   integer, parameter :: BIG_ENDIAN=0,        &
                         LITTLE_ENDIAN=1

   ! Projection codes for proj_info structure:
   INTEGER, PUBLIC, PARAMETER  :: PROJ_LATLON       = 0
   INTEGER, PUBLIC, PARAMETER  :: PROJ_LC           = 1
   INTEGER, PUBLIC, PARAMETER  :: PROJ_PS           = 2
   INTEGER, PUBLIC, PARAMETER  :: PROJ_PS_WGS84     = 102
   INTEGER, PUBLIC, PARAMETER  :: PROJ_MERC         = 3
   INTEGER, PUBLIC, PARAMETER  :: PROJ_GAUSS        = 4
   INTEGER, PUBLIC, PARAMETER  :: PROJ_CYL          = 5
   INTEGER, PUBLIC, PARAMETER  :: PROJ_CASSINI      = 6
   INTEGER, PUBLIC, PARAMETER  :: PROJ_ALBERS_NAD83 = 105 
   INTEGER, PUBLIC, PARAMETER  :: PROJ_ROTLL        = 203

end module misc_definitions_module


module module_debug

!#ifdef _GEOGRID 
!   use parallel_module
!#else
!#ifdef _METGRID
!   use parallel_module
!#else
   integer, parameter :: IO_NODE = 0 
   integer            :: my_proc_id = 0 
!#endif
!#endif

   integer, parameter :: QUIET=-100, LOGFILE=-2, DEBUG=0, INFORM=1, WARN=2, ERROR=3, STDOUT=100

   integer :: the_debug_level = DEBUG

   logical :: have_set_logname = .false.

   logical :: continuing_line_logfile = .false.
   logical :: continuing_line_debug   = .false.
   logical :: continuing_line_inform  = .false.
   logical :: continuing_line_warn    = .false.
   logical :: continuing_line_error   = .false.
   logical :: continuing_line_stdout  = .false.


   contains

   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   ! Name: set_debug_level
   !
   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   subroutine set_debug_level(ilev)

      implicit none
     
      ! Arguments
      integer, intent(in) :: ilev

      the_debug_level = ilev

   end subroutine set_debug_level


   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   ! Name: mprintf
   !
   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   subroutine mprintf(assertion, level, fmtstring, &
                      newline, &
                      i1, i2, i3, i4, i5, i6, &
                      f1, f2, f3, f4, f5, f6, &
                      s1, s2, s3, s4, s5, s6, &
                      l1, l2, l3, l4, l5, l6)

      implicit none

      ! Arguments
      integer, intent(in) :: level
      logical, intent(in) :: assertion
      character (len=*), intent(in) :: fmtstring
      logical, intent(in), optional :: newline
      integer, intent(in), optional :: i1, i2, i3, i4, i5, i6
      real, intent(in), optional :: f1, f2, f3, f4, f5, f6
      logical, intent(in), optional :: l1, l2, l3, l4, l5, l6
      character (len=*), intent(in), optional :: s1, s2, s3, s4, s5, s6

      ! Local variables 
      integer :: idxi, idxf, idxs, idxl, istart, i, iend, ia
      real :: fa
      logical :: continuing_line, la
      character (len=8) :: cur_date
      character (len=10) :: cur_time
      character (len=10) :: print_date
      character (len=12) :: print_time
!BUG: sa should be as long as the largest string length used anywhere in WPS
      character (len=1024) :: sa
      character (len=1024) :: ctemp

      if (.not. have_set_logname) then
         write(ctemp,'(a)') 'logfile.log'
         call cio_set_log_filename(ctemp,len_trim(ctemp))
!PK #ifdef _GEOGRID
!PK          if (nprocs == 1) then
!PK             write(ctemp,'(a)') 'geogrid.log'
!PK             call cio_set_log_filename(ctemp,len_trim(ctemp))
!PK          else
!PK             write(ctemp,'(a,i4.4)') 'geogrid.log.',my_proc_id
!PK             call cio_set_log_filename(ctemp,len_trim(ctemp))
!PK          end if
!PK #endif
!PK 
!PK #ifdef _METGRID
!PK          if (nprocs == 1) then
!PK             write(ctemp,'(a)') 'metgrid.log'
!PK             call cio_set_log_filename(ctemp,len_trim(ctemp))
!PK          else
!PK             write(ctemp,'(a,i4.4)') 'metgrid.log.',my_proc_id
!PK             call cio_set_log_filename(ctemp,len_trim(ctemp))
!PK          end if
!PK #endif
!PK 
!PK #ifdef _UNGRIB
!PK          write(ctemp,'(a)') 'ungrib.log'
!PK          call cio_set_log_filename(ctemp,len_trim(ctemp))
!PK #endif
         have_set_logname = .true.

      end if

      idxi = 1
      idxf = 1
      idxs = 1
      idxl = 1
      istart = 1
      iend = len_trim(fmtstring)

!#if (defined _GEOGRID) || (defined _METGRID)
!      if (assertion .and. (.not. (level == STDOUT .and. my_proc_id /= IO_NODE))) then
!#else
      if (assertion) then
!#endif

         ! If this is a debug message give up if level is not high enough
         if (level == DEBUG .and. the_debug_level > DEBUG) return 

         if (level /= STDOUT) then 
            call date_and_time(date=cur_date,time=cur_time)
         end if

         if (level == LOGFILE .and. .not.continuing_line_logfile) then
            write(print_date,'(a10)') cur_date(1:4)//'-'//cur_date(5:6)//'-'//cur_date(7:8)
            write(print_time,'(a12)') cur_time(1:2)//':'//cur_time(3:4)//':'//cur_time(5:10)
            write(ctemp,'(a)') print_date//' '//print_time//' --- '
            call cio_prints(1,ctemp,len(print_date//' '//print_time//' --- '))
         else if (level == DEBUG .and. .not.continuing_line_debug) then
            write(print_date,'(a10)') cur_date(1:4)//'-'//cur_date(5:6)//'-'//cur_date(7:8)
            write(print_time,'(a12)') cur_time(1:2)//':'//cur_time(3:4)//':'//cur_time(5:10)
            write(ctemp,'(a)') print_date//' '//print_time//' --- '
            call cio_prints(1,ctemp,len(print_date//' '//print_time//' --- '))
            write(ctemp,'(a)') 'DEBUG: '
            call cio_prints(1,ctemp,7)
         else if (level == INFORM .and. .not.continuing_line_inform) then
            write(print_date,'(a10)') cur_date(1:4)//'-'//cur_date(5:6)//'-'//cur_date(7:8)
            write(print_time,'(a12)') cur_time(1:2)//':'//cur_time(3:4)//':'//cur_time(5:10)
            write(ctemp,'(a)') print_date//' '//print_time//' --- '
            call cio_prints(1,ctemp,len(print_date//' '//print_time//' --- '))
            write(ctemp,'(a)') 'INFORM: '
            if (level >= the_debug_level) &
               call cio_prints(0,ctemp,8)
            call cio_prints(1,ctemp,8)
         else if (level == WARN .and. .not.continuing_line_warn) then
            write(print_date,'(a10)') cur_date(1:4)//'-'//cur_date(5:6)//'-'//cur_date(7:8)
            write(print_time,'(a12)') cur_time(1:2)//':'//cur_time(3:4)//':'//cur_time(5:10)
            write(ctemp,'(a)') print_date//' '//print_time//' --- '
            call cio_prints(1,ctemp,len(print_date//' '//print_time//' --- '))
            write(ctemp,'(a)') 'WARNING: '
            if (level >= the_debug_level) &
               call cio_prints(0,ctemp,9)
            call cio_prints(1,ctemp,9)
         else if (level == ERROR .and. .not.continuing_line_error) then
            write(print_date,'(a10)') cur_date(1:4)//'-'//cur_date(5:6)//'-'//cur_date(7:8)
            write(print_time,'(a12)') cur_time(1:2)//':'//cur_time(3:4)//':'//cur_time(5:10)
            write(ctemp,'(a)') print_date//' '//print_time//' --- '
            call cio_prints(1,ctemp,len(print_date//' '//print_time//' --- '))
            write(ctemp,'(a)') 'ERROR: '
            if (level >= the_debug_level) &
               call cio_prints(0,ctemp,7)
            call cio_prints(1,ctemp,7)
         end if
      
         i = index(fmtstring(istart:iend),'%')
         do while (i > 0 .and. i < iend)
            i = i + istart - 1
            write(ctemp,'(a)') fmtstring(istart:i-1)
            if (level >= the_debug_level .and. level /= DEBUG) &
               call cio_prints(0,ctemp,i-istart)
            if (level /= STDOUT) &
               call cio_prints(1,ctemp,i-istart)
   
            if (fmtstring(i+1:i+1) == '%') then
               write(ctemp,'(a)') '%'
               if (level >= the_debug_level .and. level /= DEBUG) &
                  call cio_prints(0,ctemp,1)
               if (level /= STDOUT) &
                  call cio_prints(1,ctemp,1)
                            
            else if (fmtstring(i+1:i+1) == 'i') then
               if (idxi == 1 .and. present(i1)) then
                  ia = i1
               else if (idxi == 2 .and. present(i2)) then
                  ia = i2
               else if (idxi == 3 .and. present(i3)) then
                  ia = i3
               else if (idxi == 4 .and. present(i4)) then
                  ia = i4
               else if (idxi == 5 .and. present(i5)) then
                  ia = i5
               else if (idxi == 6 .and. present(i6)) then
                  ia = i6
               end if
   
               if (level >= the_debug_level .and. level /= DEBUG) &
                  call cio_printi(0,ia)
               if (level /= STDOUT) &
                  call cio_printi(1,ia)

               idxi = idxi + 1
   
            else if (fmtstring(i+1:i+1) == 'f') then
               if (idxf == 1 .and. present(f1)) then
                  fa = f1
               else if (idxf == 2 .and. present(f2)) then
                  fa = f2
               else if (idxf == 3 .and. present(f3)) then
                  fa = f3
               else if (idxf == 4 .and. present(f4)) then
                  fa = f4
               else if (idxf == 5 .and. present(f5)) then
                  fa = f5
               else if (idxf == 6 .and. present(f6)) then
                  fa = f6
               end if
   
               if (level >= the_debug_level .and. level /= DEBUG) &
                  call cio_printf(0,fa)
               if (level /= STDOUT) &
                  call cio_printf(1,fa)

               idxf = idxf + 1
   
            else if (fmtstring(i+1:i+1) == 's') then
               if (idxs == 1 .and. present(s1)) then
                  sa = s1
               else if (idxs == 2 .and. present(s2)) then
                  sa = s2
               else if (idxs == 3 .and. present(s3)) then
                  sa = s3
               else if (idxs == 4 .and. present(s4)) then
                  sa = s4
               else if (idxs == 5 .and. present(s5)) then
                  sa = s5
               else if (idxs == 6 .and. present(s6)) then
                  sa = s6
               end if
   
               write(ctemp,'(a)') trim(sa)
               if (level >= the_debug_level .and. level /= DEBUG) &
                  call cio_prints(0,ctemp,len_trim(ctemp))
               if (level /= STDOUT) &
                  call cio_prints(1,ctemp,len_trim(ctemp))
               idxs = idxs + 1

            else if (fmtstring(i+1:i+1) == 'l') then
               if (idxl == 1 .and. present(l1)) then
                  la = l1
               else if (idxl == 2 .and. present(l2)) then
                  la = l2
               else if (idxl == 3 .and. present(l3)) then
                  la = l3
               else if (idxl == 4 .and. present(l4)) then
                  la = l4
               else if (idxl == 5 .and. present(l5)) then
                  la = l5
               else if (idxl == 6 .and. present(l6)) then
                  la = l6
               end if
   
               if (la) then
                  write(ctemp,'(a)') '.TRUE.'
               else
                  write(ctemp,'(a)') '.FALSE.'
               end if
               if (level >= the_debug_level .and. level /= DEBUG) &
                  call cio_prints(0,ctemp,len_trim(ctemp))
               if (level /= STDOUT) &
                  call cio_prints(1,ctemp,len_trim(ctemp))
               idxl = idxl + 1
   
            end if
   
            istart = i+2
            i = index(fmtstring(istart:iend),'%')
         end do
   
         continuing_line = .false.
         if (present(newline)) then
            if (.not.newline) then
               continuing_line = .true.
            end if
         end if
 
         if (continuing_line) then
            write(ctemp,'(a)') fmtstring(istart:iend)
         else
            write(ctemp,'(a)') fmtstring(istart:iend)//achar(10)  ! Add newline character 0xA
         end if

         if (level == LOGFILE) then
            continuing_line_logfile = continuing_line
         else if (level == DEBUG) then
            continuing_line_debug   = continuing_line
         else if (level == INFORM) then
            continuing_line_inform  = continuing_line
         else if (level == WARN) then
            continuing_line_warn    = continuing_line
         else if (level == ERROR) then
            continuing_line_error   = continuing_line
         else if (level == STDOUT) then
            continuing_line_stdout  = continuing_line
         end if

         if (level >= the_debug_level .and. level /= DEBUG) &
            call cio_prints(0,ctemp,iend-istart+2)
         if (level /= STDOUT) &
            call cio_prints(1,ctemp,iend-istart+2)

         if (level == ERROR) then
!PK #ifdef _GEOGRID 
!PK             call parallel_abort()
!PK #endif
!PK #ifdef _METGRID 
!PK             call parallel_abort()
!PK #endif
            stop
         end if

      end if


   end subroutine mprintf

end module module_debug

