!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! 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