Skip to content

Commit

Permalink
Merge pull request #9 from NOAA-EMC/hotfix/debug_mode
Browse files Browse the repository at this point in the history
  • Loading branch information
@uturuncoglu
uturuncoglu authored Apr 30, 2024
2 parents 6a51f02 + 2f30e10 commit 1e25901
Show file tree
Hide file tree
Showing 4 changed files with 254 additions and 167 deletions.
35 changes: 25 additions & 10 deletions drivers/nuopc/lnd_comp_domain.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -60,7 +60,8 @@ subroutine lnd_set_decomp_and_domain_from_mosaic(gcomp, noahmp, rc)
integer, intent(out) :: rc

! local variables
real(r4), target, allocatable :: tmpr4(:)
real(r4), target, allocatable :: tmpr4(:)
real(r8), target, allocatable :: tmpr8(:)
integer :: n
integer :: decomptile(2,6)
integer :: maxIndex(2)
Expand Down Expand Up @@ -183,6 +184,10 @@ subroutine lnd_set_decomp_and_domain_from_mosaic(gcomp, noahmp, rc)
allocate(tmpr4(noahmp%domain%begl:noahmp%domain%endl))
tmpr4(:) = 0.0
end if
if (.not. allocated(tmpr8)) then
allocate(tmpr8(noahmp%domain%begl:noahmp%domain%endl))
tmpr8(:) = 0.0
end if

! ---------------------
! Get fraction from orography file
Expand All @@ -207,18 +212,27 @@ subroutine lnd_set_decomp_and_domain_from_mosaic(gcomp, noahmp, rc)
! following link: https://github.com/ufs-community/ufs-weather-model/issues/1423
! ---------------------

! read field
write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C',noahmp%domain%ni, '.vegetation_type.tile*.nc'
flds(1)%short_name = 'vegetation_type'
flds(1)%ptr1r4 => tmpr4
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

! allocate data
if (.not. allocated(vegtype)) then
allocate(vegtype(noahmp%domain%begl:noahmp%domain%endl))
end if
vegtype(:) = int(tmpr4)

! read field
if (trim(noahmp%nmlist%ic_type) == 'sfc') then
filename = trim(noahmp%nmlist%input_dir)//'sfc_data.tile*.nc'
flds(1)%short_name = 'vtype'
flds(1)%ptr1r8 => tmpr8
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
vegtype(:) = int(tmpr8)
else
write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C',noahmp%domain%ni, '.vegetation_type.tile*.nc'
flds(1)%short_name = 'vegetation_type'
flds(1)%ptr1r4 => tmpr4
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
vegtype(:) = int(tmpr4)
end if

! ---------------------
! Calculate mask from land-sea fraction
Expand All @@ -228,7 +242,7 @@ subroutine lnd_set_decomp_and_domain_from_mosaic(gcomp, noahmp, rc)
allocate(noahmp%domain%mask(noahmp%domain%begl:noahmp%domain%endl))
end if

where (noahmp%domain%frac(:) > 0.0_r8 .and. vegtype(:) >= 0)
where (noahmp%domain%frac(:) > 0.0_r8 .and. vegtype(:) > 0)
noahmp%domain%mask(:) = 1
elsewhere
noahmp%domain%mask(:) = 0
Expand Down Expand Up @@ -319,6 +333,7 @@ subroutine lnd_set_decomp_and_domain_from_mosaic(gcomp, noahmp, rc)
! ---------------------

if (allocated(tmpr4)) deallocate(tmpr4)
if (allocated(tmpr8)) deallocate(tmpr8)

call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO)

Expand Down
2 changes: 1 addition & 1 deletion drivers/nuopc/lnd_comp_driver.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -283,7 +283,7 @@ subroutine drv_run(gcomp, noahmp, rc)
end if

! initialize model variables
call noahmp%InitializeStates(noahmp%nmlist, noahmp%static, month)
call noahmp%InitializeStates(noahmp%nmlist, noahmp%static, noahmp%domain, month)
end if
end if

Expand Down
149 changes: 109 additions & 40 deletions drivers/nuopc/lnd_comp_io.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -467,7 +467,9 @@ subroutine read_static(noahmp, rc)
! local variables
type(field_type), allocatable :: flds(:)
real(r4), target, allocatable :: tmpr4(:)
real(r8), target, allocatable :: tmpr8(:)
real(r4), target, allocatable :: tmp2r4(:,:)
real(r8), target, allocatable :: tmp2r8(:,:)
character(len=CL) :: filename
real(ESMF_KIND_R8), parameter :: pi_8 = 3.14159265358979323846_r8
character(len=*), parameter :: subname=trim(modName)//':(read_static) '
Expand All @@ -485,11 +487,21 @@ subroutine read_static(noahmp, rc)
tmpr4(:) = 0.0
end if

if (.not. allocated(tmpr8)) then
allocate(tmpr8(noahmp%domain%begl:noahmp%domain%endl))
tmpr8(:) = 0.0_r8
end if

if (.not. allocated(tmp2r4)) then
allocate(tmp2r4(noahmp%domain%begl:noahmp%domain%endl,12))
tmp2r4(:,:) = 0.0
end if

if (.not. allocated(tmp2r8)) then
allocate(tmp2r8(noahmp%domain%begl:noahmp%domain%endl,1))
tmp2r8(:,:) = 0.0_r8
end if

!----------------------
! Read latitude, we could also retrive from ESMF mesh object
!----------------------
Expand All @@ -509,66 +521,121 @@ subroutine read_static(noahmp, rc)
! Read soil type
!----------------------

allocate(flds(1))
write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.soil_type.tile*.nc'
flds(1)%short_name = 'soil_type'
flds(1)%ptr1r4 => tmpr4
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%soiltyp = int(tmpr4)
deallocate(flds)
if (trim(noahmp%nmlist%ic_type) == 'sfc') then
allocate(flds(1))
write(filename, fmt="(A)") trim(noahmp%nmlist%input_dir)//'sfc_data.tile*.nc'
flds(1)%short_name = 'stype'
flds(1)%ptr1r8 => tmpr8
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%soiltyp = int(tmpr8)
deallocate(flds)
else
allocate(flds(1))
write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.soil_type.tile*.nc'
flds(1)%short_name = 'soil_type'
flds(1)%ptr1r4 => tmpr4
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%soiltyp = int(tmpr4)
deallocate(flds)
end if

!----------------------
! Read vegetation type
!----------------------

allocate(flds(1))
write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.vegetation_type.tile*.nc'
flds(1)%short_name = 'vegetation_type'
flds(1)%ptr1r4 => tmpr4
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%vegtype = int(tmpr4)
deallocate(flds)
if (trim(noahmp%nmlist%ic_type) == 'sfc') then
allocate(flds(1))
write(filename, fmt="(A)") trim(noahmp%nmlist%input_dir)//'sfc_data.tile*.nc'
flds(1)%short_name = 'vtype'
flds(1)%ptr1r8 => tmpr8
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%vegtype = int(tmpr8)
deallocate(flds)
else
allocate(flds(1))
write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.vegetation_type.tile*.nc'
flds(1)%short_name = 'vegetation_type'
flds(1)%ptr1r4 => tmpr4
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%vegtype = int(tmpr4)
deallocate(flds)
end if

!----------------------
! Read slope type
!----------------------

allocate(flds(1))
write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.slope_type.tile*.nc'
flds(1)%short_name = 'slope_type'
flds(1)%ptr1r4 => tmpr4
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%slopetyp = int(tmpr4)
deallocate(flds)
if (trim(noahmp%nmlist%ic_type) == 'sfc') then
allocate(flds(1))
write(filename, fmt="(A)") trim(noahmp%nmlist%input_dir)//'sfc_data.tile*.nc'
flds(1)%short_name = 'slope'
flds(1)%ptr1r8 => tmpr8
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%slopetyp = int(tmpr8)
deallocate(flds)
else
allocate(flds(1))
write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.slope_type.tile*.nc'
flds(1)%short_name = 'slope_type'
flds(1)%ptr1r4 => tmpr4
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%slopetyp = int(tmpr4)
deallocate(flds)
end if

!----------------------
! Read deep soil temperature
!----------------------

allocate(flds(1))
write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.substrate_temperature.tile*.nc'
flds(1)%short_name = 'substrate_temperature'
flds(1)%ptr1r4 => tmpr4
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%tg3 = dble(tmpr4)
deallocate(flds)
if (trim(noahmp%nmlist%ic_type) == 'sfc') then
allocate(flds(1))
write(filename, fmt="(A)") trim(noahmp%nmlist%input_dir)//'sfc_data.tile*.nc'
flds(1)%short_name = 'tg3'
flds(1)%nrec = 1; flds(1)%ptr2r8 => tmp2r8
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%tg3 = tmp2r8(:,1)
deallocate(flds)
else
allocate(flds(1))
write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.substrate_temperature.tile*.nc'
flds(1)%short_name = 'substrate_temperature'
flds(1)%ptr1r4 => tmpr4
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%tg3 = dble(tmpr4)
deallocate(flds)
end if

!----------------------
! Read maximum snow albedo
!----------------------

allocate(flds(1))
write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.maximum_snow_albedo.tile*.nc'
flds(1)%short_name = 'maximum_snow_albedo'
flds(1)%ptr1r4 => tmpr4
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%snoalb = dble(tmpr4)
deallocate(flds)
if (trim(noahmp%nmlist%ic_type) == 'sfc') then
allocate(flds(1))
write(filename, fmt="(A)") trim(noahmp%nmlist%input_dir)//'sfc_data.tile*.nc'
flds(1)%short_name = 'snoalb'
flds(1)%nrec = 1; flds(1)%ptr2r8 => tmp2r8
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%snoalb = tmp2r8(:,1)
deallocate(flds)
else
allocate(flds(1))
write(filename, fmt="(A,I0,A)") trim(noahmp%nmlist%input_dir)//'C', noahmp%domain%ni, '.maximum_snow_albedo.tile*.nc'
flds(1)%short_name = 'maximum_snow_albedo'
flds(1)%ptr1r4 => tmpr4
call read_tiled_file(noahmp, filename, flds, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
noahmp%model%snoalb = dble(tmpr4)
deallocate(flds)
end if

!----------------------
! Read vegetation greenness, monthly average
Expand Down Expand Up @@ -610,7 +677,9 @@ subroutine read_static(noahmp, rc)
!----------------------

if (allocated(tmpr4)) deallocate(tmpr4)
if (allocated(tmpr8)) deallocate(tmpr8)
if (allocated(tmp2r4)) deallocate(tmp2r4)
if (allocated(tmp2r8)) deallocate(tmp2r8)

call ESMF_LogWrite(subname//' done for '//trim(filename), ESMF_LOGMSG_INFO)

Expand Down
Loading

0 comments on commit 1e25901

Please sign in to comment.