checking of nans in export field bundles

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

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,128 @@ 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(:,:)
+    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
+
+#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
+
+    nanfound = .false.
+    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
+          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
+          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('ABORTING JOB', ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u)
+       rc = ESMF_FAILURE
+       return
+    end if
+
+  end subroutine med_methods_FB_check_for_nans
+
+  !-----------------------------------------------------------------------------
+#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 (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: 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 (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

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

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 : 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
@@ -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 FB_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

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

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 : 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
@@ -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 FB_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

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)

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 : FB_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 FB_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)

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)