diff --git a/CHANGELOG.md b/CHANGELOG.md index e90f306..fd7bcc8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,6 +23,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Fixed some crashes in debug mode +- Workaround compiler bug where(elemental) by extra mask - Fixed string matching for EASE tile file to accommodate new "EASE*-Pfafstetter" tile file for runoff routing purposes. - Fixed GEOSlandpert build when MKL is unavailable by enabling MKL-specific code paths only when MKL is detected. - Fixed NAG Fortran compiler issues. diff --git a/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 5fe2d89..5930612 100644 --- a/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -2758,7 +2758,7 @@ subroutine get_mwrtm_param(MAPL, clock, N_catl, INTERNAL, rc) integer :: N_catl_tmp, n, mpierr, status logical :: mwp_nodata, all_nodata_l - + real, allocatable :: tmpR(:) if(.not. allocated(mwRTM_param)) then @@ -2806,8 +2806,15 @@ subroutine get_mwrtm_param(MAPL, clock, N_catl, INTERNAL, rc) allocate(mwRTM_param(N_catl)) mwRTM_param(:)%sand = SAND(:) - mwRTM_param(:)%vegcls = nint(VEGCLS(:)) - mwRTM_param(:)%soilcls = nint(SOILCLS(:)) + ! when in debug mode, nint(VEGCLS) with 1.0e15 may crash + allocate(tmpR(N_catl)) + tmpR = VEGCLS(:) + where(tmpR > 1.0e10) tmpR = nodata_generic + mwRTM_param(:)%vegcls = nint(tmpR(:)) + tmpR = SOILCLS(:) + where(tmpR > 1.0e10) tmpR = nodata_generic + mwRTM_param(:)%soilcls = nint(tmpR(:)) + mwRTM_param(:)%clay = CLAY(:) mwRTM_param(:)%poros = mw_POROS(:) mwRTM_param(:)%wang_wt = WANGWT(:) diff --git a/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 b/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 index d9cb827..b0bc0fb 100644 --- a/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 +++ b/GEOSlandassim_GridComp/clsm_ensupd_enkf_update.F90 @@ -1807,7 +1807,7 @@ subroutine write_ObsFcstAna_nc4(fname, exp_id, N_obsf, Observations_f, & character(len=128) :: created_by integer :: user_len, user_status integer :: i - + logical, allocatable :: mask(:) integer, dimension(N_obsf) :: tmpvecint real, dimension(N_obsf) :: tmpvecreal @@ -1944,50 +1944,36 @@ subroutine write_ObsFcstAna_nc4(fname, exp_id, N_obsf, Observations_f, & ! for assim flag, convert logical to integer tmpvecint = 0 - where (Observations_f(1:N_obsf)%assim) - tmpvecint = 1 - end where - call nc4_check( nf90_put_var(ncid, assim_flag_varid, tmpvecint) ) - + where (Observations_f(1:N_obsf)%assim) tmpvecint = 1; call nc4_check( nf90_put_var(ncid, assim_flag_varid, tmpvecint) ) + ! for data fields, replace LDAS no-data-value with MAPL_UNDEF for consistency with MAPL HISTORY output tmpvecreal = Observations_f(1:N_obsf)%obs - do i=1,N_obsf - if (LDAS_is_nodata(tmpvecreal(i))) tmpvecreal(i) = MAPL_UNDEF - end do - call nc4_check( nf90_put_var(ncid, obs_varid, tmpvecreal) ) + mask = LDAS_is_nodata(tmpvecreal) + where (mask) tmpvecreal=MAPL_UNDEF; call nc4_check( nf90_put_var(ncid, obs_varid, tmpvecreal)) tmpvecreal = Observations_f(1:N_obsf)%obsvar - do i=1,N_obsf - if (LDAS_is_nodata(tmpvecreal(i))) tmpvecreal(i) = MAPL_UNDEF - end do - call nc4_check( nf90_put_var(ncid, obsvar_varid, tmpvecreal) ) + mask = LDAS_is_nodata(tmpvecreal) + where (mask) tmpvecreal=MAPL_UNDEF; call nc4_check( nf90_put_var(ncid, obsvar_varid, tmpvecreal)) tmpvecreal = Observations_f(1:N_obsf)%fcst - do i=1,N_obsf - if (LDAS_is_nodata(tmpvecreal(i))) tmpvecreal(i) = MAPL_UNDEF - end do - call nc4_check( nf90_put_var(ncid, fcst_varid, tmpvecreal) ) - + mask = LDAS_is_nodata(tmpvecreal) + where (mask) tmpvecreal=MAPL_UNDEF; call nc4_check( nf90_put_var(ncid, fcst_varid, tmpvecreal)) + tmpvecreal = Observations_f(1:N_obsf)%fcstvar - do i=1,N_obsf - if (LDAS_is_nodata(tmpvecreal(i))) tmpvecreal(i) = MAPL_UNDEF - end do - call nc4_check( nf90_put_var(ncid, fcstvar_varid, tmpvecreal) ) - + mask = LDAS_is_nodata(tmpvecreal) + where (mask) tmpvecreal=MAPL_UNDEF; call nc4_check( nf90_put_var(ncid, fcstvar_varid, tmpvecreal)) + tmpvecreal = Observations_f(1:N_obsf)%ana - do i=1,N_obsf - if (LDAS_is_nodata(tmpvecreal(i))) tmpvecreal(i) = MAPL_UNDEF - end do - call nc4_check( nf90_put_var(ncid, ana_varid, tmpvecreal) ) + mask = LDAS_is_nodata(tmpvecreal) + where (mask) tmpvecreal=MAPL_UNDEF; call nc4_check( nf90_put_var(ncid, ana_varid, tmpvecreal)) tmpvecreal = Observations_f(1:N_obsf)%anavar - do i=1,N_obsf - if (LDAS_is_nodata(tmpvecreal(i))) tmpvecreal(i) = MAPL_UNDEF - end do - call nc4_check( nf90_put_var(ncid, anavar_varid, tmpvecreal) ) - + mask = LDAS_is_nodata(tmpvecreal) + where (mask) tmpvecreal=MAPL_UNDEF; call nc4_check( nf90_put_var(ncid, anavar_varid, tmpvecreal)) + end if + if (N_obs_param > 0) then allocate(species_assim_int( N_obs_param)) diff --git a/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 b/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 index 4bd263d..1d7f4f4 100644 --- a/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 +++ b/GEOSlandassim_GridComp/clsm_ensupd_read_obs.F90 @@ -5979,10 +5979,10 @@ subroutine read_obs_MODIS_SCF( & N_lat = last_ind(1) - start_ind(1) + 1 - start_ind = (lon_min_vec - CMG_ll_lon)/CMG_dlon - last_ind = (lon_max_vec - CMG_ll_lon)/CMG_dlon + start_ind(1:N_files) = (lon_min_vec(1:N_files) - CMG_ll_lon)/CMG_dlon + last_ind(1:N_files) = (lon_max_vec(1:N_files) - CMG_ll_lon)/CMG_dlon - N_lon_vec = last_ind - start_ind + 1 + N_lon_vec(1:N_files) = last_ind(1:N_files) - start_ind(1:N_files) + 1 N_lon = sum( N_lon_vec(1:N_files) ) @@ -9752,7 +9752,11 @@ subroutine scale_obs_tskin_zscore( N_catd, tile_coord, & ! check for no-data-values in observation and fit parameters ! (any negative number could be no-data-value for observations) - if ( sclprm_mean_obs(ind)>0. .and. & + if ( sclprm_mean_obs(ind)==sclprm_mean_obs(ind) .and. & + sclprm_mean_mod(ind)==sclprm_mean_mod(ind) .and. & + sclprm_std_obs(ind) ==sclprm_std_obs(ind) .and. & + sclprm_std_mod(ind) ==sclprm_std_mod(ind) .and. & + sclprm_mean_obs(ind)>0. .and. & sclprm_mean_mod(ind)>0. .and. & sclprm_std_obs(ind)>=0. .and. & sclprm_std_mod(ind)>=0. ) then @@ -9986,7 +9990,11 @@ subroutine scale_obs_sfmc_zscore( N_catd, tile_coord, & ! Check for no-data-values in observation and fit parameters ! (any negative number could be no-data-value for observations) - if ( sclprm_mean_obs(j_ind, i_ind)>0. .and. & + if ( sclprm_mean_obs(j_ind, i_ind)==sclprm_mean_obs(j_ind, i_ind) .and. & + sclprm_mean_mod(j_ind, i_ind)==sclprm_mean_mod(j_ind, i_ind) .and. & + sclprm_std_obs(j_ind, i_ind) ==sclprm_std_obs(j_ind, i_ind) .and. & + sclprm_std_mod(j_ind, i_ind) ==sclprm_std_mod(j_ind, i_ind) .and. & + sclprm_mean_obs(j_ind, i_ind)>0. .and. & sclprm_mean_mod(j_ind, i_ind)>0. .and. & sclprm_std_obs(j_ind, i_ind)>=0. .and. & sclprm_std_mod(j_ind, i_ind)>=0. ) then @@ -10381,7 +10389,11 @@ subroutine scale_obs_Tb_zscore( N_catd, tile_coord, date_time, this_obs_param, ! check for no-data-values in observation and fit parameters ! (any negative number could be no-data-value for observations) - if ( sclprm_mean_obs(ind)>0. .and. & + if ( sclprm_mean_obs(ind)==sclprm_mean_obs(ind) .and. & + sclprm_mean_mod(ind)==sclprm_mean_mod(ind) .and. & + sclprm_std_obs( ind)==sclprm_std_obs( ind) .and. & + sclprm_std_mod( ind)==sclprm_std_mod( ind) .and. & + sclprm_mean_obs(ind)>0. .and. & sclprm_mean_mod(ind)>0. .and. & sclprm_std_obs( ind)>0. .and. & sclprm_std_mod( ind)>0. ) then diff --git a/LDAS_Shared/LDAS_ensdrv_Globals.F90 b/LDAS_Shared/LDAS_ensdrv_Globals.F90 index c690c55..a306bd8 100644 --- a/LDAS_Shared/LDAS_ensdrv_Globals.F90 +++ b/LDAS_Shared/LDAS_ensdrv_Globals.F90 @@ -39,8 +39,8 @@ module LDAS_ensdrv_Globals real, parameter :: nodata_generic = -9999. real, parameter :: nodata_tolfrac_generic = 1.e-4 - real :: nodata_tol_generic = abs(nodata_generic*nodata_tolfrac_generic) - real :: MAPL_UNDEF_tol_generic = abs(MAPL_UNDEF *nodata_tolfrac_generic) + real, parameter :: nodata_tol_generic = abs(nodata_generic*nodata_tolfrac_generic) + real, parameter :: MAPL_UNDEF_tol_generic = abs(MAPL_UNDEF *nodata_tolfrac_generic) ! ---------------------------------------------------------------- !