Merge pull request #2 from DeniseWorthen/feature/cmepsaccum

fixes for ufs error in completeFieldInitialization

Author: mvertens

mediator/esmFldsExchange_hafs_mod.F90

@@ -230,7 +230,7 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc)
     !=====================================================================
 
     ! ---------------------------------------------------------------------
-    ! to wav: 10-m wind components 
+    ! to wav: 10-m wind components
     ! ---------------------------------------------------------------------
     if (hafs_attr%atm_present .and. hafs_attr%wav_present) then
       allocate(S_flds(2))
@@ -510,7 +510,7 @@ subroutine esmFldsExchange_hafs_attr(gcomp, hafs_attr, rc)
     if (chkerr(rc,__LINE__,u_FILE_u)) return
 
     !----------------------------------------------------------
-    ! Component active or not? 
+    ! Component active or not?
     !----------------------------------------------------------
 
     call NUOPC_CompAttributeGet(gcomp, name='ATM_model', &

mediator/esmFldsExchange_nems_mod.F90

@@ -106,10 +106,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc)
     end if
 
     ! unused fields from ice - but that are needed to be realized by the cice cap
-    call addfld(fldListFr(compice)%flds, 'Si_avsdf')
-    call addfld(fldListFr(compice)%flds, 'Si_avsdr')
-    call addfld(fldListFr(compice)%flds, 'Si_anidf')
-    call addfld(fldListFr(compice)%flds, 'Si_anidr')
     call addfld(fldListFr(compice)%flds, 'Faii_evap')
     call addfld(fldListFr(compice)%flds, 'mean_sw_pen_to_ocn')
 
@@ -145,6 +141,18 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc)
     end do
     deallocate(flds)
 
+    allocate(flds(4))
+    flds = (/'avsdr    ', 'avsdf    ', &
+             'anidr    ', 'anidf    '/)
+    do n = 1,size(flds)
+       fldname = 'Si_'//trim(flds(n))
+       call addfld(fldListFr(compice)%flds, trim(fldname))
+       call addfld(fldListTo(compatm)%flds, trim(fldname))
+       call addmap(fldListFr(compice)%flds, trim(fldname), compatm, maptype, 'ifrac', 'unset')
+       call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy')
+    end do
+    deallocate(flds)
+
     ! to atm: unmerged surface temperatures from ocn
     call addfld(fldListFr(compocn)%flds, 'So_t')
     call addfld(fldListTo(compatm)%flds, 'So_t')

mediator/med.F90

@@ -224,7 +224,7 @@ subroutine med_fraction_init(gcomp, rc)
               (ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) .or. &
                ESMF_StateIsCreated(is_local%wrap%NStateExp(n1),rc=rc))) then
              ! Check number of fields in the state
-             call State_GetNumFields(is_local%wrap%NStateImp(n1), fieldCount, rc=rc) 
+             call State_GetNumFields(is_local%wrap%NStateImp(n1), fieldCount, rc=rc)
              if (ChkErr(rc,__LINE__,u_FILE_u)) return
 
              ! create FBFrac

mediator/med_fraction_mod.F90

@@ -71,7 +71,7 @@ module med_internalstate_mod
     type(ESMF_FieldBundle) :: FBImp(ncomps,ncomps)               ! Import data from various components interpolated to various grids
     type(ESMF_FieldBundle) :: FBExp(ncomps)                      ! Export data for various components, on their grid
 
-    ! Mediator field bundles for ocean albedo 
+    ! Mediator field bundles for ocean albedo
     type(ESMF_FieldBundle) :: FBMed_ocnalb_o                     ! Ocn albedo on ocn grid
     type(ESMF_FieldBundle) :: FBMed_ocnalb_a                     ! Ocn albedo on atm grid
     type(packed_data_type) :: packed_data_ocnalb_o2a(nmappers)   ! packed data for mapping ocn->atm

mediator/med_internalstate_mod.F90

@@ -46,10 +46,10 @@ module med_map_mod
   subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogunit, rc)
 
     !---------------------------------------------
-    ! Initialize route handles in the mediator and also 
+    ! Initialize route handles in the mediator and also
     ! nitialize unity normalization fields and do the mapping for
     ! unity normalization up front
-    ! 
+    !
     ! Assumptions:
     !   -  Route handles are created per target field bundles NOT
     !      per individual fields in the bundle
@@ -138,7 +138,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun
                 if (chkerr(rc,__LINE__,u_FILE_u)) return
 
                 ! Check number of fields in source FB on destination mesh and get destination field
-                if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(n1,n2))) then  
+                if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(n1,n2))) then
                    call ESMF_LogWrite(trim(subname)//'FBImp('//trim(compname(n1))//','//trim(compname(n2))//')'// &
                         ' has not been created', ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u)
                    rc = ESMF_FAILURE
@@ -213,7 +213,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun
             allocate(fieldlist(fieldcount))
             call ESMF_FieldBundleGet(is_local%wrap%FBExp(n1), fieldlist=fieldlist, rc=rc)
             if (ChkErr(rc,__LINE__,u_FILE_u)) return
-          else    
+          else
             allocate(fieldlist(fieldcount))
             call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n1), fieldlist=fieldlist, rc=rc)
             if (ChkErr(rc,__LINE__,u_FILE_u)) return
@@ -893,8 +893,10 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, &
 
           packed_data(mapindex)%field_fracsrc = ESMF_FieldCreate(lmesh_src, ESMF_TYPEKIND_R8, &
                meshloc=ESMF_MESHLOC_ELEMENT, rc=rc)
+          if (chkerr(rc,__LINE__,u_FILE_u)) return
           packed_data(mapindex)%field_fracdst = ESMF_FieldCreate(lmesh_dst, ESMF_TYPEKIND_R8, &
                meshloc=ESMF_MESHLOC_ELEMENT, rc=rc)
+          if (chkerr(rc,__LINE__,u_FILE_u)) return
        end if
     end do ! end loop over mapindex
 
@@ -1047,6 +1049,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d
                      maptype=mapindex, &
                      field_normsrc=field_fracsrc, &
                      field_normdst=packed_data(mapindex)%field_fracdst, rc=rc)
+                if (chkerr(rc,__LINE__,u_FILE_u)) return
 
              else if ( trim(packed_data(mapindex)%mapnorm) == 'one' .or. trim(packed_data(mapindex)%mapnorm) == 'none') then
 

mediator/med_map_mod.F90

@@ -168,8 +168,10 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r
              ! set ungridded dimensions and GridToFieldMap for field
              call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", &
                   purpose="Instance", valueList=ungriddedLBound, rc=rc)
+             if (chkerr(rc,__LINE__,u_FILE_u)) return
              call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", &
                   purpose="Instance", valueList=ungriddedUBound, rc=rc)
+             if (chkerr(rc,__LINE__,u_FILE_u)) return
              call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", &
                   purpose="Instance", valueList=gridToFieldMap, rc=rc)
              if (chkerr(rc,__LINE__,u_FILE_u)) return
@@ -464,8 +466,10 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S
                 allocate(ungriddedLBound(ungriddedCount), ungriddedUBound(ungriddedCount))
                 call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", &
                      purpose="Instance", valueList=ungriddedLBound, rc=rc)
+                if (chkerr(rc,__LINE__,u_FILE_u)) return
                 call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", &
                      purpose="Instance", valueList=ungriddedUBound, rc=rc)
+                if (chkerr(rc,__LINE__,u_FILE_u)) return
 
                 call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", &
                      purpose="Instance", itemCount=gridToFieldMapCount, rc=rc)
@@ -667,7 +671,6 @@ subroutine med_methods_State_getNumFields(State, fieldnum, rc)
     ! local variables
     integer                            :: n,itemCount
     type(ESMF_Field), pointer          :: fieldList(:) => null()
-    type(ESMF_StateItem_Flag), pointer :: itemTypeList(:) => null()
     character(len=*),parameter         :: subname='(med_methods_State_getNumFields)'
     ! ----------------------------------------------
 

mediator/med_methods_mod.F90

@@ -189,7 +189,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc)
        end do
     end if
 
-    ! Create required field bundles 
+    ! Create required field bundles
     if (is_local%wrap%aoflux_grid == 'ogrid' .or. is_local%wrap%aoflux_grid == 'agrid') then
 
        ! Create the field bundle is_local%wrap%FBImp(compatm,compocn) if needed

mediator/med_phases_aofluxes_mod.F90

@@ -198,7 +198,7 @@ subroutine med_phases_prep_atm(gcomp, rc)
     end if
 
     ! Note - the following needs a custom merge since Faoo_fco2_ocn is scaled by (ifrac+ofrac)
-    ! in the merge to the atm 
+    ! in the merge to the atm
     if ( FB_FldChk(is_local%wrap%FBExp(compatm)        , 'Faoo_fco2_ocn', rc=rc) .and. &
          FB_FldChk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fco2_ocn', rc=rc)) then
        call ESMF_FieldGet(lfield, farrayPtr=dataptr1, rc=rc)

mediator/med_phases_prep_atm_mod.F90

@@ -29,7 +29,7 @@ subroutine med_phases_prep_ice(gcomp, rc)
     use ESMF                  , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_Field
     use ESMF                  , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE
     use ESMF                  , only : ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND
-    use ESMF                  , only : ESMF_VMBroadCast 
+    use ESMF                  , only : ESMF_VMBroadCast
     use med_utils_mod         , only : chkerr       => med_utils_ChkErr
     use med_methods_mod       , only : FB_fldchk    => med_methods_FB_FldChk
     use med_methods_mod       , only : FB_diagnose  => med_methods_FB_diagnose
@@ -91,12 +91,12 @@ subroutine med_phases_prep_ice(gcomp, rc)
     ! Apply precipitation factor from ocean (that scales atm rain and snow to ice) if appropriate
     if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then
 
-       ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor 
+       ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor
        ! is initialized to 0.
-       ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, 
-       ! it is set to 0. 
+       ! In addition, in med.F90, if this attribute is not present as a mediator component attribute,
+       ! it is set to 0.
        if (mastertask) then
-          call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & 
+          call ESMF_StateGet(is_local%wrap%NstateImp(compocn), &
                itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc)
           if (chkerr(rc,__LINE__,u_FILE_u)) return
           call ESMF_FieldGet(lfield, farrayPtr=dataptr_scalar_ocn, rc=rc)
@@ -111,7 +111,7 @@ subroutine med_phases_prep_ice(gcomp, rc)
        end if
        call ESMF_VMBroadCast(is_local%wrap%vm, precip_fact, 1, 0, rc=rc)
        if (chkerr(rc,__LINE__,u_FILE_u)) return
-       is_local%wrap%flds_scalar_precip_factor = precip_fact(1)      
+       is_local%wrap%flds_scalar_precip_factor = precip_fact(1)
        if (dbug_flag > 5) then
           write(cvalue,*) precip_fact(1)
           call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO)

mediator/med_phases_prep_ice_mod.F90

@@ -472,12 +472,12 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc)
     ! Apply precipitation factor from ocean (that scales atm rain and snow back to ocn ) if appropriate
     if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then
 
-       ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor 
+       ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor
        ! is initialized to 0.
-       ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, 
-       ! it is set to 0. 
+       ! In addition, in med.F90, if this attribute is not present as a mediator component attribute,
+       ! it is set to 0.
        if (mastertask) then
-          call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & 
+          call ESMF_StateGet(is_local%wrap%NstateImp(compocn), &
                itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc)
           if (chkerr(rc,__LINE__,u_FILE_u)) return
           call ESMF_FieldGet(lfield, farrayPtr=dataptr_scalar_ocn, rc=rc)
@@ -492,7 +492,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc)
        end if
        call ESMF_VMBroadCast(is_local%wrap%vm, precip_fact, 1, 0, rc=rc)
        if (chkerr(rc,__LINE__,u_FILE_u)) return
-       is_local%wrap%flds_scalar_precip_factor = precip_fact(1)      
+       is_local%wrap%flds_scalar_precip_factor = precip_fact(1)
        if (dbug_flag > 5) then
           write(cvalue,*) precip_fact(1)
           call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO)

mediator/med_phases_prep_ocn_mod.F90

@@ -273,7 +273,7 @@ subroutine med_phases_restart_write(gcomp, rc)
 
        call ESMF_ClockGetAlarm(clock, alarmname='alarm_stop', alarm=alarm, rc=rc)
        if (ChkErr(rc,__LINE__,u_FILE_u)) return
-       if (ESMF_AlarmIsRinging(alarm, rc=rc).and.write_restart_at_endofrun) then    
+       if (ESMF_AlarmIsRinging(alarm, rc=rc).and.write_restart_at_endofrun) then
           AlarmIsOn = .true.
        else
           AlarmIsOn = .false.
@@ -480,7 +480,7 @@ subroutine med_phases_restart_write(gcomp, rc)
 
   end subroutine med_phases_restart_write
 
-  !=============================================================================== 
+  !===============================================================================
   subroutine med_phases_restart_read(gcomp, rc)
 
     ! Read mediator restart