From 7bb5053618aca5c4bf146b2e370d9af2a77c70bc Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 15:03:27 +0200 Subject: [PATCH 1/7] check for nans --- mediator/med_methods_mod.F90 | 108 +++++++++++++++++++++++++++ mediator/med_phases_prep_atm_mod.F90 | 5 ++ mediator/med_phases_prep_glc_mod.F90 | 7 ++ mediator/med_phases_prep_ice_mod.F90 | 5 ++ mediator/med_phases_prep_lnd_mod.F90 | 5 ++ mediator/med_phases_prep_ocn_mod.F90 | 5 ++ mediator/med_phases_prep_rof_mod.F90 | 5 ++ mediator/med_phases_prep_wav_mod.F90 | 5 ++ 8 files changed, 145 insertions(+) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index bd5b60793..710ba51c7 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -24,6 +24,11 @@ module med_methods_mod med_methods_FieldPtr_compare2 end interface + interface med_methods_check_for_nans + module procedure med_methods_check_for_nans_1d + module procedure med_methods_check_for_nans_2d + end interface med_methods_check_for_nans + ! used/reused in module logical :: isPresent @@ -49,6 +54,7 @@ module med_methods_mod public med_methods_FB_getdata2d public med_methods_FB_getdata1d public med_methods_FB_getmesh + public med_methods_FB_check_for_nans public med_methods_State_reset public med_methods_State_diagnose @@ -71,6 +77,8 @@ module med_methods_mod #ifdef DIAGNOSE private med_methods_Array_diagnose #endif + private med_methods_check_for_nans + !----------------------------------------------------------------------------- contains !----------------------------------------------------------------------------- @@ -2497,4 +2505,104 @@ subroutine med_methods_FB_getmesh(FB, mesh, rc) end subroutine med_methods_FB_getmesh + !----------------------------------------------------------------------------- + subroutine med_methods_FB_check_for_nans(FB, rc) + + use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet + + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + integer , intent(inout) :: rc + + ! local variables + type(ESMF_Field) :: field + integer :: index + integer :: fieldcount + integer :: fieldrank + character(len=CL) :: fieldname + real(r8) , pointer :: dataptr1d(:) + real(r8) , pointer :: dataptr2d(:,:) + ! ---------------------------------------------- + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + do index=1,fieldCount + call med_methods_FB_getNameN(FB, index, fieldname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(FB, fieldName=fieldname, field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, rank=fieldrank, name=fieldname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fieldrank == 1) then + call ESMF_FieldGet(field, farrayPtr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_FieldGet(field, farrayPtr=dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end do + + end subroutine med_methods_FB_check_for_nans + + !----------------------------------------------------------------------------- + subroutine med_methods_check_for_nans_1d(dataptr, name, rc) + ! input/output variables + real(r8) , intent(in) :: dataptr(:) + character(len=*) , intent(in) :: name + integer , intent(out) :: rc + + ! local variables + integer :: n + integer :: nancount + character(len=CS) :: nancount_char + character(len=*), parameter :: subname='(med_methods_check_for_nans_1d)' + ! ---------------------------------------------- + rc = ESMF_SUCCESS + + nancount = 0 + do n = 1,size(dataptr) + if (isnan(dataptr(n))) then + nancount = nancount + 1 + end if + end do + if (nancount > 0) then + write(nancount_char, '(i0)') nancount + call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & + ESMF_LOGMSG_ERROR) + return + endif + end subroutine med_methods_check_for_nans_1d + + subroutine med_methods_check_for_nans_2d(dataptr, name, rc) + ! input/output variables + real(r8) , intent(in) :: dataptr(:,:) + character(len=*) , intent(in) :: name + integer , intent(out) :: rc + + ! local variables + integer :: n,k + integer :: nancount + character(len=CS) :: nancount_char + character(len=*), parameter :: subname='(med_methods_check_for_nans_2d)' + ! ---------------------------------------------- + rc = ESMF_SUCCESS + + nancount = 0 + do k = 1,size(dataptr, dim=1) + do n = 1,size(dataptr, dim=2) + if (isnan(dataptr(k,n))) then + nancount = nancount + 1 + end if + end do + end do + if (nancount > 0) then + write(nancount_char, '(i0)') nancount + call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & + ESMF_LOGMSG_ERROR) + return + end if + end subroutine med_methods_check_for_nans_2d + end module med_methods_mod diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 9bb2b059f..bccf8e07c 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -14,6 +14,7 @@ module med_phases_prep_atm_mod use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk use med_methods_mod , only : FB_getfldptr=> med_methods_FB_GetFldPtr + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, maintask @@ -243,6 +244,10 @@ subroutine med_phases_prep_atm(gcomp, rc) end do end if + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compatm), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 311d91c8a..2861f3324 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -34,6 +34,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_init => med_methods_FB_init + use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -706,6 +707,12 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) endif end if + ! Check for nans in fields export to atm + do ns = 1,is_local%wrap%num_icesheets + call fldbun_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 428f3afef..1e0496b3d 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -34,6 +34,7 @@ subroutine med_phases_prep_ice(gcomp, rc) use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_merge_mod , only : med_merge_auto use med_internalstate_mod , only : InternalState, logunit, maintask @@ -149,6 +150,10 @@ subroutine med_phases_prep_ice(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compice), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 0c0bad212..93780c254 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -29,6 +29,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use esmFlds , only : med_fldList_GetFldListTo, med_fldList_type use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose + use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm @@ -127,6 +128,10 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! Set first call logical to false first_call = .false. + ! Check for nans in fields export to atm + call fldbun_check_for_nans(is_local%wrap%FBExp(complnd), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 60e37a95e..de989ac49 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -19,6 +19,7 @@ module med_phases_prep_ocn_mod use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type use med_internalstate_mod , only : compocn, compatm, compice, coupling_mode use perf_mod , only : t_startf, t_stopf @@ -295,6 +296,10 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccumOcn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compocn), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! zero accumulator is_local%wrap%ExpAccumOcnCnt = 0 call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 5d603a141..8d690124a 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -23,6 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d + use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf implicit none @@ -376,6 +377,10 @@ subroutine med_phases_prep_rof(gcomp, rc) FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to atm + call fldbun_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then call fldbun_diagnose(is_local%wrap%FBExp(comprof), & string=trim(subname)//' FBexp(comprof) ', rc=rc) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 5fcb9ba7e..3028303bc 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -17,6 +17,7 @@ module med_phases_prep_wav_mod use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use esmFlds , only : med_fldList_GetfldListTo use med_internalstate_mod , only : compwav use perf_mod , only : t_startf, t_stopf @@ -176,6 +177,10 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compwav), is_local%wrap%FBExpAccumWav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! zero accumulator is_local%wrap%ExpAccumWavCnt = 0 call FB_reset(is_local%wrap%FBExpAccumWav, value=czero, rc=rc) From 9ee4d83648b2939273ee1091cb7d9a12524879ee Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 15:53:47 +0200 Subject: [PATCH 2/7] refactored logic --- mediator/med_methods_mod.F90 | 53 ++++++++++++++++-------------------- 1 file changed, 23 insertions(+), 30 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 710ba51c7..e9d545a99 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2522,12 +2522,17 @@ subroutine med_methods_FB_check_for_nans(FB, rc) character(len=CL) :: fieldname real(r8) , pointer :: dataptr1d(:) real(r8) , pointer :: dataptr2d(:,:) + integer :: nancount + character(len=CS) :: nancount_char + logical :: nanfound + character(len=*), parameter :: subname='(med_methods_FB_check_for_nans)' ! ---------------------------------------------- rc = ESMF_SUCCESS call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + nanfound = .false. do index=1,fieldCount call med_methods_FB_getNameN(FB, index, fieldname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -2538,57 +2543,51 @@ subroutine med_methods_FB_check_for_nans(FB, rc) if (fieldrank == 1) then call ESMF_FieldGet(field, farrayPtr=dataptr1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_check_for_nans(dataptr1d, nancount) else call ESMF_FieldGet(field, farrayPtr=dataptr2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_check_for_nans(dataptr2d, nancount) + end if + if (nancount > 0) then + write(nancount_char, '(i0)') nancount + call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(fieldname), & + ESMF_LOGMSG_WARNING) + nanfound = .true. end if end do + if (nanfound) then + call ESMF_LogWrite(trim(subname)//": ERROR nans found in export field bundle ",ESMF_LOGMSG_ERROR) + return + end if end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- - subroutine med_methods_check_for_nans_1d(dataptr, name, rc) + subroutine med_methods_check_for_nans_1d(dataptr, nancount) ! input/output variables - real(r8) , intent(in) :: dataptr(:) - character(len=*) , intent(in) :: name - integer , intent(out) :: rc + real(r8) , intent(in) :: dataptr(:) + integer , intent(out) :: nancount ! local variables integer :: n - integer :: nancount - character(len=CS) :: nancount_char - character(len=*), parameter :: subname='(med_methods_check_for_nans_1d)' ! ---------------------------------------------- - rc = ESMF_SUCCESS - nancount = 0 do n = 1,size(dataptr) if (isnan(dataptr(n))) then nancount = nancount + 1 end if end do - if (nancount > 0) then - write(nancount_char, '(i0)') nancount - call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & - ESMF_LOGMSG_ERROR) - return - endif end subroutine med_methods_check_for_nans_1d - subroutine med_methods_check_for_nans_2d(dataptr, name, rc) + subroutine med_methods_check_for_nans_2d(dataptr, nancount) ! input/output variables - real(r8) , intent(in) :: dataptr(:,:) - character(len=*) , intent(in) :: name - integer , intent(out) :: rc + real(r8) , intent(in) :: dataptr(:,:) + integer , intent(out) :: nancount ! local variables integer :: n,k - integer :: nancount - character(len=CS) :: nancount_char - character(len=*), parameter :: subname='(med_methods_check_for_nans_2d)' ! ---------------------------------------------- - rc = ESMF_SUCCESS - nancount = 0 do k = 1,size(dataptr, dim=1) do n = 1,size(dataptr, dim=2) @@ -2597,12 +2596,6 @@ subroutine med_methods_check_for_nans_2d(dataptr, name, rc) end if end do end do - if (nancount > 0) then - write(nancount_char, '(i0)') nancount - call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(name), & - ESMF_LOGMSG_ERROR) - return - end if end subroutine med_methods_check_for_nans_2d end module med_methods_mod From 3ad7f1f7e9df8a236a3b2d6ab89b37711bab701f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 5 May 2023 16:00:53 +0200 Subject: [PATCH 3/7] updated med_diag_mod with recent changes from escomp --- mediator/med_diag_mod.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 802334f6f..8ea6651ea 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -95,6 +95,8 @@ module med_diag_mod character(*), parameter :: FA1 = "(' ',a12,6f15.8)" character(*), parameter :: FA0r = "(' ',12x,8(6x,a8,1x))" character(*), parameter :: FA1r = "(' ',a12,8f15.8)" + character(*), parameter :: FA0s = "(' ',12x,8(7x,a8,2x))" + character(*), parameter :: FA1s = "(' ',a12,8g18.8)" ! --------------------------------- ! C for component @@ -2683,7 +2685,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,'NET SALT BUDGET (kg/m2s): period = ',& trim(budget_diags%periods(ip)%name), ': date = ',date,tod - write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' + write(diagunit,FA0s) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = f_salt_beg, f_salt_end net_salt_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) net_salt_lnd = data(nf, c_lnd_recv, ip) + data(nf, c_lnd_send, ip) @@ -2695,7 +2697,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) net_salt_tot = net_salt_atm + net_salt_lnd + net_salt_rof + net_salt_ocn + & net_salt_ice_nh + net_salt_ice_sh + net_salt_glc - write(diagunit,FA1r) budget_diags%fields(nf)%name,& + write(diagunit,FA1s) budget_diags%fields(nf)%name,& net_salt_atm, net_salt_lnd, net_salt_rof, net_salt_ocn, & net_salt_ice_nh, net_salt_ice_sh, net_salt_glc, net_salt_tot enddo @@ -2718,7 +2720,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) sum_net_salt_tot = sum_net_salt_atm + sum_net_salt_lnd + sum_net_salt_rof + sum_net_salt_ocn + & sum_net_salt_ice_nh + sum_net_salt_ice_sh + sum_net_salt_glc - write(diagunit,FA1r)' *SUM*',& + write(diagunit,FA1s)' *SUM*',& sum_net_salt_atm, sum_net_salt_lnd, sum_net_salt_rof, sum_net_salt_ocn, & sum_net_salt_ice_nh, sum_net_salt_ice_sh, sum_net_salt_glc, sum_net_salt_tot end if From 83bba42b9671e2c76c73db654d884fcf2f2082b6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 13:51:06 +0200 Subject: [PATCH 4/7] updated counters for nans --- mediator/med_methods_mod.F90 | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index e9d545a99..5188ed9f2 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2515,16 +2515,17 @@ subroutine med_methods_FB_check_for_nans(FB, rc) integer , intent(inout) :: rc ! local variables - type(ESMF_Field) :: field - integer :: index - integer :: fieldcount - integer :: fieldrank - character(len=CL) :: fieldname - real(r8) , pointer :: dataptr1d(:) - real(r8) , pointer :: dataptr2d(:,:) - integer :: nancount - character(len=CS) :: nancount_char - logical :: nanfound + type(ESMF_Field) :: field + integer :: index + integer :: fieldcount + integer :: fieldrank + character(len=CL) :: fieldname + real(r8) , pointer :: dataptr1d(:) + real(r8) , pointer :: dataptr2d(:,:) + integer :: nancount + character(len=CS) :: nancount_char + character(len=CL) :: msg_error + logical :: nanfound character(len=*), parameter :: subname='(med_methods_FB_check_for_nans)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -2543,21 +2544,22 @@ subroutine med_methods_FB_check_for_nans(FB, rc) if (fieldrank == 1) then call ESMF_FieldGet(field, farrayPtr=dataptr1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_check_for_nans(dataptr1d, nancount) + call med_methods_check_for_nans(dataptr1d, nancount) else call ESMF_FieldGet(field, farrayPtr=dataptr2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call med_methods_check_for_nans(dataptr2d, nancount) + call med_methods_check_for_nans(dataptr2d, nancount) end if if (nancount > 0) then write(nancount_char, '(i0)') nancount - call ESMF_LogWrite(trim(subname)//": ERROR "//trim(nancount_char)//" NaNs found in field: "//trim(fieldname), & - ESMF_LOGMSG_WARNING) + msg_error = "ERROR: " // trim(nancount_char) //" nans found in "//trim(fieldname) + call ESMF_LogWrite(trim(msg_error), ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) nanfound = .true. end if end do if (nanfound) then - call ESMF_LogWrite(trim(subname)//": ERROR nans found in export field bundle ",ESMF_LOGMSG_ERROR) + call ESMF_LogWrite('ABORTING JOB', ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE return end if @@ -2565,6 +2567,7 @@ end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- subroutine med_methods_check_for_nans_1d(dataptr, nancount) + use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) ! input/output variables real(r8) , intent(in) :: dataptr(:) integer , intent(out) :: nancount @@ -2581,6 +2584,7 @@ subroutine med_methods_check_for_nans_1d(dataptr, nancount) end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) + use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount From 0b59db6514a76cf8369cdbeb5c829e58e44b9df5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 13:55:09 +0200 Subject: [PATCH 5/7] consistent alias of use statements for check_for_nans --- mediator/med_phases_prep_glc_mod.F90 | 4 ++-- mediator/med_phases_prep_lnd_mod.F90 | 4 ++-- mediator/med_phases_prep_rof_mod.F90 | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 2861f3324..97049d5b9 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -34,7 +34,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_init => med_methods_FB_init - use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -709,7 +709,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! Check for nans in fields export to atm do ns = 1,is_local%wrap%num_icesheets - call fldbun_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 93780c254..b73412937 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -29,7 +29,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use esmFlds , only : med_fldList_GetFldListTo, med_fldList_type use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose - use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm @@ -129,7 +129,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) first_call = .false. ! Check for nans in fields export to atm - call fldbun_check_for_nans(is_local%wrap%FBExp(complnd), rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(complnd), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 8d690124a..cf0ad0f4e 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -23,7 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d - use med_methods_mod , only : fldbun_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf implicit none @@ -378,7 +378,7 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Check for nans in fields export to atm - call fldbun_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) + call FB_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then From 64439f74578d01ece0f4a87b41f6c25897751321 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 14:03:16 +0200 Subject: [PATCH 6/7] fixed compilation bug --- mediator/med_methods_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 5188ed9f2..8c781e7c3 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2567,7 +2567,8 @@ end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- subroutine med_methods_check_for_nans_1d(dataptr, nancount) - use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) + use shr_infnan_mod, only: nan => isnan + ! input/output variables real(r8) , intent(in) :: dataptr(:) integer , intent(out) :: nancount @@ -2584,7 +2585,8 @@ subroutine med_methods_check_for_nans_1d(dataptr, nancount) end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) - use shr_infnan_mod, only: nan => shr_infnan_nan, inf => shr_infnan_inf, assignment(=) + use shr_infnan_mod, only: isnan + ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount From 5e02def6328fc0352cae83e2f366604c712caf8b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 May 2023 14:26:13 +0200 Subject: [PATCH 7/7] add ability to compile without needed shr_infnan - as is the case for UFS --- mediator/med_methods_mod.F90 | 45 ++++++++++++++++++++++++++++-------- 1 file changed, 35 insertions(+), 10 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 8c781e7c3..3d29fde6f 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2530,6 +2530,11 @@ subroutine med_methods_FB_check_for_nans(FB, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS +#ifndef CESM_COUPLED + ! For now only CESM uses shr_infnan_isnan - so until other models provide this + RETURN +#endif + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2566,42 +2571,62 @@ subroutine med_methods_FB_check_for_nans(FB, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- - subroutine med_methods_check_for_nans_1d(dataptr, nancount) - use shr_infnan_mod, only: nan => isnan +#ifdef CESM_COUPLED + subroutine med_methods_check_for_nans_1d(dataptr, nancount) + use shr_infnan_mod, only: shr_infnan_isnan ! input/output variables real(r8) , intent(in) :: dataptr(:) integer , intent(out) :: nancount - ! local variables integer :: n - ! ---------------------------------------------- + nancount = 0 do n = 1,size(dataptr) - if (isnan(dataptr(n))) then + if (shr_infnan_isnan(dataptr(n))) then nancount = nancount + 1 end if end do end subroutine med_methods_check_for_nans_1d subroutine med_methods_check_for_nans_2d(dataptr, nancount) - use shr_infnan_mod, only: isnan - + use shr_infnan_mod, only: shr_infan_isnan ! input/output variables real(r8) , intent(in) :: dataptr(:,:) integer , intent(out) :: nancount - ! local variables integer :: n,k - ! ---------------------------------------------- + nancount = 0 do k = 1,size(dataptr, dim=1) do n = 1,size(dataptr, dim=2) - if (isnan(dataptr(k,n))) then + if (shr_infan_isnan(dataptr(k,n))) then nancount = nancount + 1 end if end do end do end subroutine med_methods_check_for_nans_2d +#else + + ! For now only CESM uses shr_infnan_isnan - so until other models provide this + ! nancount will just be set to zero + + subroutine med_methods_check_for_nans_1d(dataptr, nancount) + ! input/output variables + real(r8) , intent(in) :: dataptr(:) + integer , intent(out) :: nancount + + nancount = 0 + end subroutine med_methods_check_for_nans_1d + + subroutine med_methods_check_for_nans_2d(dataptr, nancount) + ! input/output variables + real(r8) , intent(in) :: dataptr(:,:) + integer , intent(out) :: nancount + + nancount = 0 + end subroutine med_methods_check_for_nans_2d +#endif + end module med_methods_mod