Skip to content

Commit

Permalink
Merge branch 'support/lisf-557ww-7.6'
Browse files Browse the repository at this point in the history
  • Loading branch information
jvgeiger committed Nov 8, 2024
2 parents 6bf4dca + 966f63b commit 12d02d2
Show file tree
Hide file tree
Showing 414 changed files with 94,980 additions and 1,335 deletions.
4 changes: 2 additions & 2 deletions docs/LDT_users_guide/LDT_users_guide.adoc
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
= Land Data Toolkit (LDT): LDT {lisfrevision} Users Guide
:revnumber: 3.0
:revdate: 10 Jan 2024
:revnumber: 2.6
:revdate: 1 Nov 2024
:doctype: book
:sectnums:
:toc:
Expand Down
1 change: 1 addition & 0 deletions docs/LDT_users_guide/revision_table.adoc
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
|====
| Revision | Summary of Changes | Date

| 2.6 | LISF 557WW 7.5.19 release | Nov 1, 2024
| 2.5 | LISF 557WW 7.5.18 release | Aug 27, 2024
| 3.0 | LISF Public 7.5.0 release | Jan 10, 2024
| 2.4 | LISF Public 7.4.3 release | Oct 03, 2023
Expand Down
2 changes: 1 addition & 1 deletion ldt/USAFSI/USAFSI_amsr2Mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1400,7 +1400,7 @@ subroutine search_files(date10, amsr2_in)

! EMK
character*12 :: program_name ! NAME OF CALLING PROGRAM
character*12 :: routine_name ! NAME OF THIS ROUTINE
character*20 :: routine_name ! NAME OF THIS ROUTINE

! define data values
data routine_name / 'search_files' /
Expand Down
88 changes: 59 additions & 29 deletions ldt/USAFSI/USAFSI_analysisMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@
! run_seaice_analysis_navy to reflect use of
! ESPC-D or GOFS data. Also fixed uninitialized
! variable.
! 15 Oct 2024 Eric Kemp Updated error_message logic.
!
! DESCRIPTION:
! Source code for Air Force snow depth analysis.
Expand Down Expand Up @@ -331,7 +332,8 @@ subroutine getfrac (date10, fracdir)
character*255 :: file_path ! FULLY-QUALIFIED FILE NAME
character*7 :: iofunc ! ACTION TO BE PERFORMED
character*90 :: message (msglns) ! ERROR MESSAGE
character*12 :: routine_name ! NAME OF THIS SUBROUTINE
character*20 :: routine_name ! NAME OF THIS SUBROUTINE
character*10 :: yyyymmddhh
integer :: fracnt ! NUMBER OF FRACTIONAL POINTS
integer :: i ! SNODEP I-COORDINATE
integer :: icount ! LOOP COUNTER
Expand All @@ -352,6 +354,8 @@ subroutine getfrac (date10, fracdir)
allocate(pntcnt( ldt_rc%lnc(1), ldt_rc%lnr(1)))
allocate(snocum( ldt_rc%lnc(1), ldt_rc%lnr(1)))

yyyymmddhh = date10

! INITIALIZE VARIABLES.
fracnt = 0
icount = 1
Expand Down Expand Up @@ -440,7 +444,8 @@ subroutine getfrac (date10, fracdir)
usafsi_settings%usefrac = .false.
message(1) = '[WARN] FRACTIONAL SNOW FILE NOT FOUND'
message(2) = '[WARN] PATH = ' // trim(file_path)
call error_message (program_name, routine_name, message)
call error_message (program_name, routine_name, yyyymmddhh, &
message)
write (LDT_logunit, 6400) routine_name, file_path

end if
Expand Down Expand Up @@ -548,7 +553,7 @@ subroutine getgeo (month, static, nc, nr, elevations)
character*4 :: file_ext ! LAST PORTION OF FILE NAME
character*255 :: file_path ! FULLY-QUALIFIED FILE NAME
character*90 :: message (msglns) ! ERROR MESSAGE
character*12 :: routine_name ! NAME OF THIS SUBROUTINE
character*20 :: routine_name ! NAME OF THIS SUBROUTINE
real, allocatable :: climo_0p25deg(:,:)
integer*1, allocatable :: snow_poss_0p25deg(:,:)
type(proj_info) :: snodep_0p25deg_proj
Expand Down Expand Up @@ -793,7 +798,8 @@ subroutine getobs (date10, month, sfcobs, netid, staid, stacnt, &
character*5, allocatable :: oldnet (:) ! ARRAY OF NETWORKS FOR OLDSTA
character*32, allocatable :: oldsta (:) ! ARRAY OF PROCESSED STATIONS WITH SNOW DEPTHS

character*12 :: routine_name ! NAME OF THIS SUBROUTINE
character*20 :: routine_name ! NAME OF THIS SUBROUTINE
character*10 :: yyyymmddhh
integer :: ctrgrd ! TEMP HOLDER FOR GROUND OBS INFO
integer :: ctrtmp ! TEMP HOLDER FOR TOO WARM TEMPERATURE OBS
integer :: ctrtrs ! TEMP HOLDER FOR TEMP THRES OBS
Expand Down Expand Up @@ -833,6 +839,8 @@ subroutine getobs (date10, month, sfcobs, netid, staid, stacnt, &
allocate (oldnet (usafsi_settings%maxsobs))
allocate (oldsta (usafsi_settings%maxsobs))

yyyymmddhh = date10

! INITIALIZE VARIABLES.
depth = missing
istat = 0
Expand Down Expand Up @@ -1115,7 +1123,8 @@ subroutine getobs (date10, month, sfcobs, netid, staid, stacnt, &
'[WARN] NO SURFACE OBSERVATIONS READ FOR ' // &
date10
end if
call error_message (program_name, routine_name, message)
call error_message (program_name, routine_name, &
yyyymmddhh, message)

end if

Expand All @@ -1132,7 +1141,8 @@ subroutine getobs (date10, month, sfcobs, netid, staid, stacnt, &
// date10
end if
message(2) = '[WARN] Looked for ' // trim(obsfile)
call error_message (program_name, routine_name, message)
call error_message (program_name, routine_name, &
yyyymmddhh, message)

end if file_check

Expand Down Expand Up @@ -1255,7 +1265,8 @@ subroutine getsfc ( date10, stmpdir, sfctmp_found, sfctmp_lis )
character*7 :: iofunc ! ACTION TO BE PERFORMED
character*90 :: message (msglns) ! ERROR MESSAGE

character*12 :: routine_name ! NAME OF THIS ROUTINE
character*20 :: routine_name ! NAME OF THIS ROUTINE
character*10 :: yyyymmddhh
integer :: icount ! LOOP COUNTER
integer :: julhr ! AFWA JULIAN HOUR
logical :: isfile ! FLAG FOR INPUT FILE FOUND
Expand All @@ -1269,6 +1280,8 @@ subroutine getsfc ( date10, stmpdir, sfctmp_found, sfctmp_lis )

allocate(sfctmp_lis_0p25deg(igrid, jgrid_lis))

yyyymmddhh = date10

! GET LATEST LIS SHELTER TEMPERATURES.
dtglis = date10
icount = 1
Expand Down Expand Up @@ -1309,7 +1322,8 @@ subroutine getsfc ( date10, stmpdir, sfctmp_found, sfctmp_lis )
! IF NOT FOUND FOR PAST 24 HOURS, SEND ERROR MESSAGE.
if (.not. sfctmp_found) then
message(1) = '[WARN] LIS DATA NOT FOUND FOR PAST 24 HOURS'
call error_message (program_name, routine_name, message)
call error_message (program_name, routine_name, yyyymmddhh, &
message)
write (ldt_logunit, 6400) routine_name
end if

Expand Down Expand Up @@ -1458,7 +1472,8 @@ subroutine getsmi (date10, ssmis)
character*6 :: interval ! TIME INTERVAL FOR FILENAME
character*90 :: message (msglns) ! ERROR MESSAGE
character*4 :: msgval ! PLACEHOLDER FOR ERROR MESSAGE VALUES
character*12 :: routine_name ! NAME OF THIS SUBROUTINE
character*20 :: routine_name ! NAME OF THIS SUBROUTINE
character*10 :: yyyymmddhh
integer :: edri16 ! EDR 16TH MESH I-COORDINATE
integer :: edrj16 ! EDR 16TH MESH J-COORDINATE
integer :: edrlat ! EDR LATITUDE (100THS OF DEGREES)
Expand Down Expand Up @@ -1501,6 +1516,8 @@ subroutine getsmi (date10, ssmis)
data lunsrc / 43, 44 /
data routine_name / 'GETSMI '/

yyyymmddhh = date10

! ALLOCATE ARRAYS.
allocate (icecount_0p25deg (igrid , jgrid))
allocate (icetotal_0p25deg (igrid , jgrid))
Expand Down Expand Up @@ -1658,7 +1675,7 @@ subroutine getsmi (date10, ssmis)
end if
end do
end do

! Interpolate the 0.25deg data to the LDT grid
nr = LDT_rc%lnr(1)
nc = LDT_rc%lnc(1)
Expand Down Expand Up @@ -1702,7 +1719,8 @@ subroutine getsmi (date10, ssmis)

if (msgline > 1) then

call error_message (program_name, routine_name, message)
call error_message (program_name, routine_name, yyyymmddhh, &
message)

end if

Expand Down Expand Up @@ -1812,7 +1830,7 @@ subroutine getsno (date10, modif, unmod, nc, nr, landice, julhr_beg, &
character*10 :: date10_prev ! PREVIOUS CYCLE DATE-TIME GROUP
character*255 :: file_path ! INPUT FILE PATH AND NAME
character*90 :: message (msglns) ! ERROR MESSAGE
character*12 :: routine_name ! NAME OF THIS SUBROUTINE
character*20 :: routine_name ! NAME OF THIS SUBROUTINE
character*255 :: prevdir ! PATH TO PREVIOUS CYCLE'S DATA
integer :: runcycle ! CYCLE HOUR
integer :: julhr ! AFWA JULIAN HOUR
Expand Down Expand Up @@ -2111,7 +2129,7 @@ subroutine getsno (date10, modif, unmod, nc, nr, landice, julhr_beg, &
4200 continue
message(1) = '[ERR] ERROR CONVERTING DATA FROM CHARACTER TO INTEGER'
message(2) = '[ERR] DATE10 = ' // date10
call abort_message (program_name, program_name, message)
call abort_message (program_name, routine_name, message)
call LDT_endrun()

! FORMAT STATEMENTS.
Expand Down Expand Up @@ -2145,7 +2163,7 @@ subroutine getsno_nc(date10, julhr_beg, ierr)
integer :: limit, tries
integer :: runcycle
integer :: julhr
character*12 :: routine_name
character*20 :: routine_name
character*10 :: date10_prev
character*90 :: message(msglns)

Expand Down Expand Up @@ -2214,7 +2232,7 @@ subroutine getsno_nc(date10, julhr_beg, ierr)
4200 continue
message(1) = '[ERR] ERROR CONVERTING DATA FROM CHARACTER TO INTEGER'
message(2) = '[ERR] DATE10 = ' // date10
call abort_message (program_name, program_name, message)
call abort_message (program_name, routine_name, message)
call LDT_endrun()

! Other format statements
Expand Down Expand Up @@ -2292,7 +2310,8 @@ subroutine getsst (date10, stmpdir, sstdir)
character*7 :: iofunc ! ACTION TO BE PERFORMED
!character*90 :: message (msglns) ! ERROR MESSAGE
character*255 :: message (msglns) ! ERROR MESSAGE
character*12 :: routine_name ! NAME OF THIS SUBROUTINE
character*20 :: routine_name ! NAME OF THIS SUBROUTINE
character*10 :: yyyymmddhh
integer :: runcycle ! CYCLE TIME
integer :: hrdiff ! DIFFERENCE BETWEEN HOURS
integer :: julsno ! JULIAN HOUR OF SNODEP CYCLE
Expand All @@ -2312,6 +2331,8 @@ subroutine getsst (date10, stmpdir, sstdir)

data routine_name / 'GETSST '/

yyyymmddhh = date10

! FIND THE DATE/TIME GROUP OF THE PREVIOUS CYCLE.
! GET SEA SURFACE TEMPERATURE DATA.
iofunc = 'READING'
Expand Down Expand Up @@ -2387,14 +2408,16 @@ subroutine getsst (date10, stmpdir, sstdir)
else
message(1) = '[ERR] ERROR READING FILE'
message(2) = '[ERR] PATH = ' // file_grib
call error_message(program_name, routine_name, message)
call error_message(program_name, routine_name, &
yyyymmddhh, message)
write(ldt_logunit, 6400) routine_name, iofunc, file_grib, &
grstat
end if
else
message(1) = '[ERR] ERROR OPENING FILE'
message(2) = '[ERR] PATH = ' // file_grib
call error_message(program_name, routine_name, message)
call error_message(program_name, routine_name, &
yyyymmddhh, message)
write(ldt_logunit, 6400) routine_name, iofunc, file_grib, grstat
end if
end if
Expand All @@ -2414,7 +2437,8 @@ subroutine getsst (date10, stmpdir, sstdir)
message(1) = ' SST DATA IS MORE THAN 24 HOURS OLD'
message(2) = ' USAFSI CYCLE = ' // date10
message(3) = ' SEA SFC TEMP = ' // date10_sst
call error_message (program_name, routine_name, message)
call error_message (program_name, routine_name, &
yyyymmddhh, message)

end if

Expand All @@ -2423,7 +2447,8 @@ subroutine getsst (date10, stmpdir, sstdir)
else

message(1) = '[WARN] SEA SURFACE TEMPERATURE DATA NOT FOUND'
call error_message (program_name, routine_name, message)
call error_message (program_name, routine_name, &
yyyymmddhh, message)
write (ldt_logunit, 6600) routine_name

end if
Expand Down Expand Up @@ -2557,7 +2582,8 @@ subroutine getviirs (date10, viirsdir)
character(255) :: snoage_path ! FULLY-QUALIFIED SNOAGE FILE NAME
character(7) :: iofunc ! ACTION TO BE PERFORMED
character(90) :: message (msglns) ! ERROR MESSAGE
character(12) :: routine_name ! NAME OF THIS SUBROUTINE
character(20) :: routine_name ! NAME OF THIS SUBROUTINE
character(10) :: yyyymmddhh
integer :: i ! SNODEP I-COORDINATE
integer :: icount ! LOOP COUNTER
integer :: julhr ! AFWA JULIAN HOUR
Expand All @@ -2583,12 +2609,14 @@ subroutine getviirs (date10, viirsdir)
write(LDT_logunit,*)&
'[ERR] Recompile with LIBGEOTIFF support and try again!'
call LDT_endrun()

#else
external :: ztif_frac_slice ! EMK 20220113

data routine_name / 'GETVIIRS ' /

yyyymmddhh = date10

! ALLOCATE DATA ARRAYS.
nc = LDT_rc%lnc(1)
nr = LDT_rc%lnr(1)
Expand All @@ -2611,7 +2639,7 @@ subroutine getviirs (date10, viirsdir)
idim = igrid_viirs, &
jdim = jgrid_viirs, &
proj=viirs_0p005deg_proj)

! INITIALIZE VARIABLES.
icount = 0
iofunc = 'READING'
Expand Down Expand Up @@ -2694,7 +2722,7 @@ subroutine getviirs (date10, viirsdir)

! No error for this slice, so process
do i_viirs = 1, igrid_viirs

! Find lat/lon of VIIRS pixel, and then determine which
! LDT grid box this falls in.
ri_viirs = real(i_viirs)
Expand All @@ -2720,13 +2748,13 @@ subroutine getviirs (date10, viirsdir)
j = 1
else if (j > nr) then
j = nr
end if
end if
pixels(i,j) = pixels(i,j) + 1

! Skip if the pixel age is too old.
if (agebuf_slice(i_viirs) > &
usafsi_settings%maxpixage) cycle

! Increment the appropriate snow/bare counter
if (mapbuf_slice(i_viirs) .eq. 0) then
bare(i,j) = bare(i,j) + 1
Expand Down Expand Up @@ -2754,7 +2782,7 @@ subroutine getviirs (date10, viirsdir)

end do file_search

if (map_exists .and. age_exists .and. ierr .eq. 0) then
if (map_exists .and. age_exists .and. ierr .eq. 0) then

! From the geolocated data, create the final VIIRS snow cover map
do j = 1, nr
Expand All @@ -2780,15 +2808,17 @@ subroutine getviirs (date10, viirsdir)
usafsi_settings%useviirs = .false.
message(1) = '[WARN] VIIRS SNOW MAP FILE NOT FOUND'
!message(2) = '[WARN] PATH = ' // trim(snomap_path)
call error_message (program_name, routine_name, message)
call error_message (program_name, routine_name, &
yyyymmddhh, message)
write (ldt_logunit, 6400) routine_name, snomap_path
end if

if (.not. age_exists) then
usafsi_settings%useviirs = .false.
message(1) = '[WARN] VIIRS SNOW AGE FILE NOT FOUND'
!message(2) = '[WARN] PATH = ' // trim(snoage_path)
call error_message (program_name, routine_name, message)
call error_message (program_name, routine_name, &
yyyymmddhh, message)
write (ldt_logunit, 6400) routine_name, snoage_path
end if

Expand Down
Loading

0 comments on commit 12d02d2

Please sign in to comment.