From 275b1a4ef65e95b6c893adeeb6f3a0599768bce7 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 11 May 2021 16:45:51 -0600 Subject: [PATCH 1/4] fix initial diag counter --- mediator/med.F90 | 7 ++++--- mediator/med_diag_mod.F90 | 4 +++- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index d5acfb28d..f382c0521 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -664,7 +664,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) ! TransferOfferGeomObject Attribute. use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_SUCCESS, ESMF_LogFoundAllocError - use ESMF , only : ESMF_StateIsCreated + use ESMF , only : ESMF_StateIsCreated use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite use ESMF , only : ESMF_END_ABORT, ESMF_Finalize use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState @@ -2435,7 +2435,8 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- call med_diag_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_diag_zero('all', rc=rc) + call med_diag_zero(mode='all', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- @@ -2492,7 +2493,7 @@ subroutine DataInitialize(gcomp, rc) end if call med_phases_profile(gcomp, rc) - + if (ChkErr(rc,__LINE__,u_FILE_u)) return else ! Not all done call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index ef765604e..d672f0036 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -465,7 +465,8 @@ subroutine med_diag_zero_mode(mode, rc) elseif (trim(mode) == 'all') then budget_local(:,:,:) = 0.0_r8 budget_global(:,:,:) = 0.0_r8 - budget_counter(:,:,:) = 0.0_r8 + budget_counter(:,:,period_inst) = 0.0_r8 + budget_counter(:,:,period_inst+1:) = 1.0_r8 else call ESMF_LogWrite(trim(subname)//' mode '//trim(mode)//& ' not recognized', & @@ -2341,6 +2342,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) ice_area_sh = data(f_area,c_ish_recv,ip) sum_area = atm_area + lnd_area + ocn_area + ice_area_nh + ice_area_sh write(diagunit,FA1) budget_diags%fields(f_area)%name, atm_area, lnd_area, ocn_area, ice_area_nh, ice_area_sh, sum_area + write(diagUnit,*) 'counter: ',budget_counter(f_area, c_atm_recv, ip) ! write out net heat budgets From 801724f8d1c261aa177f8f692070ff4bc9648442 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 16 May 2021 15:12:45 -0600 Subject: [PATCH 2/4] updated run sequence to fix diag problem for wmelt --- cime_config/runseq/runseq_general.py | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cime_config/runseq/runseq_general.py b/cime_config/runseq/runseq_general.py index 3bc307488..db323b3c2 100644 --- a/cime_config/runseq/runseq_general.py +++ b/cime_config/runseq/runseq_general.py @@ -100,7 +100,6 @@ def gen_runseq(case, coupling_times): runseq.add_action("MED med_phases_prep_ice" , med_to_ice) runseq.add_action("MED -> ICE :remapMethod=redist" , med_to_ice) - runseq.add_action("MED med_phases_diag_ice_med2ice" , run_ice and diag_mode) runseq.add_action("MED med_phases_prep_wav" , med_to_wav) runseq.add_action("MED -> WAV :remapMethod=redist" , med_to_wav) @@ -132,9 +131,12 @@ def gen_runseq(case, coupling_times): runseq.add_action("LND -> MED :remapMethod=redist" , run_lnd) runseq.add_action("MED med_phases_post_lnd" , run_lnd) + runseq.add_action("MED med_phases_diag_lnd" , run_lnd and diag_mode) + runseq.add_action("MED med_phases_diag_rof" , run_rof and diag_mode) + runseq.add_action("MED med_phases_diag_ice_ice2med" , run_ice and diag_mode) + runseq.add_action("MED med_phases_diag_glc" , run_glc and diag_mode) runseq.add_action("ICE -> MED :remapMethod=redist" , run_ice) - runseq.add_action("MED med_phases_diag_ice_ice2med" , run_ice and diag_mode) runseq.add_action("MED med_phases_post_ice" , run_ice) runseq.add_action("MED med_phases_prep_atm" , med_to_atm) @@ -142,6 +144,8 @@ def gen_runseq(case, coupling_times): runseq.add_action("ATM" , run_atm) runseq.add_action("ATM -> MED :remapMethod=redist" , run_atm) runseq.add_action("MED med_phases_post_atm" , run_atm) + runseq.add_action("MED med_phases_diag_atm" , run_atm and diag_mode) + runseq.add_action("MED med_phases_diag_ice_med2ice" , run_ice and diag_mode) runseq.add_action("WAV -> MED :remapMethod=redist", run_wav) runseq.add_action("MED med_phases_post_wav" , run_wav) @@ -149,10 +153,6 @@ def gen_runseq(case, coupling_times): runseq.add_action("ROF -> MED :remapMethod=redist", run_rof and not rof_outer_loop) runseq.add_action("MED med_phases_post_rof" , run_rof and not rof_outer_loop) - runseq.add_action("MED med_phases_diag_atm" , run_atm and diag_mode) - runseq.add_action("MED med_phases_diag_lnd" , run_lnd and diag_mode) - runseq.add_action("MED med_phases_diag_rof" , run_rof and diag_mode) - runseq.add_action("MED med_phases_diag_glc" , run_glc and diag_mode) runseq.add_action("MED med_phases_diag_accum" , diag_mode) runseq.add_action("MED med_phases_diag_print" , diag_mode) From f5a4123b66621a7c64c6ee3f64bdf1e4731eeea0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 31 May 2021 19:18:55 -0600 Subject: [PATCH 3/4] fixes for memory leak --- mediator/med_diag_mod.F90 | 1205 ++++++++++++++++++------------------- 1 file changed, 594 insertions(+), 611 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index d672f0036..9f9d37877 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -397,33 +397,31 @@ subroutine med_diag_init(gcomp, rc) alarmname='alarm_stop', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + end subroutine med_diag_init - contains - integer function get_diag_attribute(gcomp, name, rc) - type(ESMF_GridComp) , intent(inout) :: gcomp - character(len=*), intent(in) :: name - integer, intent(out) :: rc - - character(CS) :: cvalue - logical :: isPresent - - rc = ESMF_SUCCESS - get_diag_attribute = 0 - call NUOPC_CompAttributeGet(gcomp, name=name, isPresent=isPresent, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - call NUOPC_CompAttributeGet(gcomp, name=name, value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) get_diag_attribute - else - call NUOPC_CompAttributeAdd(gcomp, (/name/), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name=name, value='0', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - end function get_diag_attribute - - end subroutine med_diag_init + integer function get_diag_attribute(gcomp, name, rc) + type(ESMF_GridComp) , intent(inout) :: gcomp + character(len=*), intent(in) :: name + integer, intent(out) :: rc + + character(CS) :: cvalue + logical :: isPresent + + rc = ESMF_SUCCESS + get_diag_attribute = 0 + call NUOPC_CompAttributeGet(gcomp, name=name, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name=name, value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) get_diag_attribute + else + call NUOPC_CompAttributeAdd(gcomp, (/name/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name=name, value='0', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + end function get_diag_attribute !=============================================================================== subroutine med_diag_zero_mode(mode, rc) @@ -721,197 +719,195 @@ subroutine med_phases_diag_atm(gcomp, rc) f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + deallocate(afrac) call t_stopf('MED:'//subname) + end subroutine med_phases_diag_atm - contains - - subroutine diag_atm_recv(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: afrac(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(in) :: ofrac(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1,size(data) - budget(nf,c_atm_recv,ip) = budget(nf,c_atm_recv,ip) - areas(n)*data(n)*afrac(n) - budget(nf,c_lnd_arecv,ip) = budget(nf,c_lnd_arecv,ip) + areas(n)*data(n)*lfrac(n) - budget(nf,c_ocn_arecv,ip) = budget(nf,c_ocn_arecv,ip) + areas(n)*data(n)*ofrac(n) - if (lats(n) > 0.0_r8) then - budget(nf,c_inh_arecv,ip) = budget(nf,c_inh_arecv,ip) + areas(n)*data(n)*ifrac(n) - else - budget(nf,c_ish_arecv,ip) = budget(nf,c_ish_arecv,ip) + areas(n)*data(n)*ifrac(n) - end if - end do - end if - end subroutine diag_atm_recv - - subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: afrac(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(in) :: ofrac(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1,size(data) - budget(nf,c_atm_send,ip) = budget(nf,c_atm_send,ip) - areas(n)*data(n)*afrac(n) - budget(nf,c_lnd_asend,ip) = budget(nf,c_lnd_asend,ip) + areas(n)*data(n)*lfrac(n) - budget(nf,c_ocn_asend,ip) = budget(nf,c_ocn_asend,ip) + areas(n)*data(n)*ofrac(n) - if (lats(n) > 0.0_r8) then - budget(nf,c_inh_asend,ip) = budget(nf,c_inh_asend,ip) + areas(n)*data(n)*ifrac(n) - else - budget(nf,c_ish_asend,ip) = budget(nf,c_ish_asend,ip) + areas(n)*data(n)*ifrac(n) - end if - end do - end if - end subroutine diag_atm_send - - subroutine diag_atm_wiso_recv(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & - afrac, lfrac, ofrac, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: afrac(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(in) :: ofrac(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_Field) :: lfield - real(r8), pointer :: data(:,:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1,size(data, dim=2) - budget(nf_16O,c_atm_recv,ip) = budget(nf_16O,c_atm_recv,ip) - areas(n)*afrac(n)*data(1,n) - budget(nf_16O,c_lnd_arecv,ip) = budget(nf_16O,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(1,n) - budget(nf_16O,c_ocn_arecv,ip) = budget(nf_16O,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(1,n) - if (lats(n) > 0.0_r8) then - budget(nf_16O,c_inh_arecv,ip) = budget(nf_16O,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(1,n) - else - budget(nf_16O,c_ish_arecv,ip) = budget(nf_16O,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(1,n) - end if - - budget(nf_18O,c_atm_recv,ip) = budget(nf_18O,c_atm_recv,ip) - areas(n)*afrac(n)*data(2,n) - budget(nf_18O,c_lnd_arecv,ip) = budget(nf_18O,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(2,n) - budget(nf_18O,c_ocn_arecv,ip) = budget(nf_18O,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(2,n) - if (lats(n) > 0.0_r8) then - budget(nf_18O,c_inh_arecv,ip) = budget(nf_18O,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(2,n) - else - budget(nf_18O,c_ish_arecv,ip) = budget(nf_18O,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(2,n) - end if - - budget(nf_HDO,c_atm_recv,ip) = budget(nf_HDO,c_atm_recv,ip) - areas(n)*afrac(n)*data(3,n) - budget(nf_HDO,c_lnd_arecv,ip) = budget(nf_HDO,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(3,n) - budget(nf_HDO,c_ocn_arecv,ip) = budget(nf_HDO,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(3,n) - if (lats(n) > 0.0_r8) then - budget(nf_HDO,c_inh_arecv,ip) = budget(nf_HDO,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(3,n) - else - budget(nf_HDO,c_ish_arecv,ip) = budget(nf_HDO,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_atm_wiso_recv - - subroutine diag_atm_wiso_send(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & - afrac, lfrac, ofrac, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: afrac(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(in) :: ofrac(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_Field) :: lfield - real(r8), pointer :: data(:,:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1,size(data, dim=2) - budget(nf_16O,c_atm_send,ip) = budget(nf_16O,c_atm_send,ip) - areas(n)*afrac(n)*data(1,n) - budget(nf_16O,c_lnd_asend,ip) = budget(nf_16O,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(1,n) - budget(nf_16O,c_ocn_asend,ip) = budget(nf_16O,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(1,n) - if (lats(n) > 0.0_r8) then - budget(nf_16O,c_inh_asend,ip) = budget(nf_16O,c_inh_asend,ip) + areas(n)*ifrac(n)*data(1,n) - else - budget(nf_16O,c_ish_asend,ip) = budget(nf_16O,c_ish_asend,ip) + areas(n)*ifrac(n)*data(1,n) - end if - - budget(nf_18O,c_atm_send,ip) = budget(nf_18O,c_atm_send,ip) - areas(n)*afrac(n)*data(2,n) - budget(nf_18O,c_lnd_asend,ip) = budget(nf_18O,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(2,n) - budget(nf_18O,c_ocn_asend,ip) = budget(nf_18O,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(2,n) - if (lats(n) > 0.0_r8) then - budget(nf_18O,c_inh_asend,ip) = budget(nf_18O,c_inh_asend,ip) + areas(n)*ifrac(n)*data(2,n) - else - budget(nf_18O,c_ish_asend,ip) = budget(nf_18O,c_ish_asend,ip) + areas(n)*ifrac(n)*data(2,n) - end if - - budget(nf_HDO,c_atm_send,ip) = budget(nf_HDO,c_atm_send,ip) - areas(n)*afrac(n)*data(3,n) - budget(nf_HDO,c_lnd_asend,ip) = budget(nf_HDO,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(3,n) - budget(nf_HDO,c_ocn_asend,ip) = budget(nf_HDO,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(3,n) - if (lats(n) > 0.0_r8) then - budget(nf_HDO,c_inh_asend,ip) = budget(nf_HDO,c_inh_asend,ip) + areas(n)*ifrac(n)*data(3,n) - else - budget(nf_HDO,c_ish_asend,ip) = budget(nf_HDO,c_ish_asend,ip) + areas(n)*ifrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_atm_wiso_send + subroutine diag_atm_recv(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: afrac(:) + real(r8) , intent(in) :: lfrac(:) + real(r8) , intent(in) :: ofrac(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1,size(data) + budget(nf,c_atm_recv,ip) = budget(nf,c_atm_recv,ip) - areas(n)*data(n)*afrac(n) + budget(nf,c_lnd_arecv,ip) = budget(nf,c_lnd_arecv,ip) + areas(n)*data(n)*lfrac(n) + budget(nf,c_ocn_arecv,ip) = budget(nf,c_ocn_arecv,ip) + areas(n)*data(n)*ofrac(n) + if (lats(n) > 0.0_r8) then + budget(nf,c_inh_arecv,ip) = budget(nf,c_inh_arecv,ip) + areas(n)*data(n)*ifrac(n) + else + budget(nf,c_ish_arecv,ip) = budget(nf,c_ish_arecv,ip) + areas(n)*data(n)*ifrac(n) + end if + end do + end if + end subroutine diag_atm_recv - end subroutine med_phases_diag_atm + subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: afrac(:) + real(r8) , intent(in) :: lfrac(:) + real(r8) , intent(in) :: ofrac(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1,size(data) + budget(nf,c_atm_send,ip) = budget(nf,c_atm_send,ip) - areas(n)*data(n)*afrac(n) + budget(nf,c_lnd_asend,ip) = budget(nf,c_lnd_asend,ip) + areas(n)*data(n)*lfrac(n) + budget(nf,c_ocn_asend,ip) = budget(nf,c_ocn_asend,ip) + areas(n)*data(n)*ofrac(n) + if (lats(n) > 0.0_r8) then + budget(nf,c_inh_asend,ip) = budget(nf,c_inh_asend,ip) + areas(n)*data(n)*ifrac(n) + else + budget(nf,c_ish_asend,ip) = budget(nf,c_ish_asend,ip) + areas(n)*data(n)*ifrac(n) + end if + end do + end if + end subroutine diag_atm_send + + subroutine diag_atm_wiso_recv(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & + afrac, lfrac, ofrac, ifrac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: afrac(:) + real(r8) , intent(in) :: lfrac(:) + real(r8) , intent(in) :: ofrac(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_Field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1,size(data, dim=2) + budget(nf_16O,c_atm_recv,ip) = budget(nf_16O,c_atm_recv,ip) - areas(n)*afrac(n)*data(1,n) + budget(nf_16O,c_lnd_arecv,ip) = budget(nf_16O,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(1,n) + budget(nf_16O,c_ocn_arecv,ip) = budget(nf_16O,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(1,n) + if (lats(n) > 0.0_r8) then + budget(nf_16O,c_inh_arecv,ip) = budget(nf_16O,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(1,n) + else + budget(nf_16O,c_ish_arecv,ip) = budget(nf_16O,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(1,n) + end if + + budget(nf_18O,c_atm_recv,ip) = budget(nf_18O,c_atm_recv,ip) - areas(n)*afrac(n)*data(2,n) + budget(nf_18O,c_lnd_arecv,ip) = budget(nf_18O,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(2,n) + budget(nf_18O,c_ocn_arecv,ip) = budget(nf_18O,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(2,n) + if (lats(n) > 0.0_r8) then + budget(nf_18O,c_inh_arecv,ip) = budget(nf_18O,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(2,n) + else + budget(nf_18O,c_ish_arecv,ip) = budget(nf_18O,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(2,n) + end if + + budget(nf_HDO,c_atm_recv,ip) = budget(nf_HDO,c_atm_recv,ip) - areas(n)*afrac(n)*data(3,n) + budget(nf_HDO,c_lnd_arecv,ip) = budget(nf_HDO,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(3,n) + budget(nf_HDO,c_ocn_arecv,ip) = budget(nf_HDO,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(3,n) + if (lats(n) > 0.0_r8) then + budget(nf_HDO,c_inh_arecv,ip) = budget(nf_HDO,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(3,n) + else + budget(nf_HDO,c_ish_arecv,ip) = budget(nf_HDO,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(3,n) + end if + end do + end if + end subroutine diag_atm_wiso_recv + + subroutine diag_atm_wiso_send(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & + afrac, lfrac, ofrac, ifrac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: afrac(:) + real(r8) , intent(in) :: lfrac(:) + real(r8) , intent(in) :: ofrac(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_Field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1,size(data, dim=2) + budget(nf_16O,c_atm_send,ip) = budget(nf_16O,c_atm_send,ip) - areas(n)*afrac(n)*data(1,n) + budget(nf_16O,c_lnd_asend,ip) = budget(nf_16O,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(1,n) + budget(nf_16O,c_ocn_asend,ip) = budget(nf_16O,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(1,n) + if (lats(n) > 0.0_r8) then + budget(nf_16O,c_inh_asend,ip) = budget(nf_16O,c_inh_asend,ip) + areas(n)*ifrac(n)*data(1,n) + else + budget(nf_16O,c_ish_asend,ip) = budget(nf_16O,c_ish_asend,ip) + areas(n)*ifrac(n)*data(1,n) + end if + + budget(nf_18O,c_atm_send,ip) = budget(nf_18O,c_atm_send,ip) - areas(n)*afrac(n)*data(2,n) + budget(nf_18O,c_lnd_asend,ip) = budget(nf_18O,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(2,n) + budget(nf_18O,c_ocn_asend,ip) = budget(nf_18O,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(2,n) + if (lats(n) > 0.0_r8) then + budget(nf_18O,c_inh_asend,ip) = budget(nf_18O,c_inh_asend,ip) + areas(n)*ifrac(n)*data(2,n) + else + budget(nf_18O,c_ish_asend,ip) = budget(nf_18O,c_ish_asend,ip) + areas(n)*ifrac(n)*data(2,n) + end if + + budget(nf_HDO,c_atm_send,ip) = budget(nf_HDO,c_atm_send,ip) - areas(n)*afrac(n)*data(3,n) + budget(nf_HDO,c_lnd_asend,ip) = budget(nf_HDO,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(3,n) + budget(nf_HDO,c_ocn_asend,ip) = budget(nf_HDO,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(3,n) + if (lats(n) > 0.0_r8) then + budget(nf_HDO,c_inh_asend,ip) = budget(nf_HDO,c_inh_asend,ip) + areas(n)*ifrac(n)*data(3,n) + else + budget(nf_HDO,c_ish_asend,ip) = budget(nf_HDO,c_ish_asend,ip) + areas(n)*ifrac(n)*data(3,n) + end if + end do + end if + end subroutine diag_atm_wiso_send !=============================================================================== subroutine med_phases_diag_lnd( gcomp, rc) @@ -1017,79 +1013,77 @@ subroutine med_phases_diag_lnd( gcomp, rc) budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice call t_stopf('MED:'//subname) + end subroutine med_phases_diag_lnd - contains - subroutine diag_lnd(FB, fldname, nf, ic, areas, lfrac, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data) - if (present(minus)) then - budget(nf,ic,ip) = budget(nf,ic,ip) - areas(n)*lfrac(n)*data(n) - else - budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*lfrac(n)*data(n) - end if - end do - end if - end subroutine diag_lnd - - subroutine diag_lnd_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, lfrac, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:,:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (present(minus)) then - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*lfrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*lfrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*lfrac(n)*data(3,n) - else - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*lfrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*lfrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*lfrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_lnd_wiso + subroutine diag_lnd(FB, fldname, nf, ic, areas, lfrac, budget, minus, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + integer , intent(in) :: ic + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lfrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + logical, optional , intent(in) :: minus + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS - end subroutine med_phases_diag_lnd + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data) + if (present(minus)) then + budget(nf,ic,ip) = budget(nf,ic,ip) - areas(n)*lfrac(n)*data(n) + else + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*lfrac(n)*data(n) + end if + end do + end if + end subroutine diag_lnd + + subroutine diag_lnd_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, lfrac, budget, minus, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + integer , intent(in) :: ic + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lfrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + logical, optional , intent(in) :: minus + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data, dim=2) + if (present(minus)) then + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*lfrac(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*lfrac(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*lfrac(n)*data(3,n) + else + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*lfrac(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*lfrac(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*lfrac(n)*data(3,n) + end if + end do + end if + end subroutine diag_lnd_wiso !=============================================================================== subroutine med_phases_diag_rof( gcomp, rc) @@ -1163,79 +1157,77 @@ subroutine med_phases_diag_rof( gcomp, rc) budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice call t_stopf('MED:'//subname) + end subroutine med_phases_diag_rof - contains - subroutine diag_rof(FB, fldname, nf, ic, areas, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data) - if (present(minus)) then - budget(nf,ic,ip) = budget(nf,ic,ip) - areas(n)*data(n) - else - budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*data(n) - end if - end do - end if - end subroutine diag_rof - - subroutine diag_rof_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:,:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (present(minus)) then - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*data(3,n) - else - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*data(3,n) - end if - end do - end if - end subroutine diag_rof_wiso + subroutine diag_rof(FB, fldname, nf, ic, areas, budget, minus, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + integer , intent(in) :: ic + real(r8) , intent(in) :: areas(:) + real(r8) , intent(inout) :: budget(:,:,:) + logical, optional , intent(in) :: minus + integer , intent(out) :: rc - end subroutine med_phases_diag_rof + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data) + if (present(minus)) then + budget(nf,ic,ip) = budget(nf,ic,ip) - areas(n)*data(n) + else + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*data(n) + end if + end do + end if + end subroutine diag_rof + + subroutine diag_rof_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, budget, minus, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + integer , intent(in) :: ic + real(r8) , intent(in) :: areas(:) + real(r8) , intent(inout) :: budget(:,:,:) + logical, optional , intent(in) :: minus + integer , intent(out) :: rc + + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data, dim=2) + if (present(minus)) then + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*data(3,n) + else + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*data(3,n) + end if + end do + end if + end subroutine diag_rof_wiso !=============================================================================== subroutine med_phases_diag_glc( gcomp, rc) @@ -1283,40 +1275,38 @@ subroutine med_phases_diag_glc( gcomp, rc) budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice call t_stopf('MED:'//subname) - - contains - subroutine diag_glc(FB, fldname, nf, ic, areas, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data) - if (present(minus)) then - budget(nf,ic,ip) = budget(nf,ic,ip) - areas(n)*data(n) - else - budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*data(n) - end if - end do - end if - end subroutine diag_glc - end subroutine med_phases_diag_glc + subroutine diag_glc(FB, fldname, nf, ic, areas, budget, minus, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + integer , intent(in) :: ic + real(r8) , intent(in) :: areas(:) + real(r8) , intent(inout) :: budget(:,:,:) + logical, optional , intent(in) :: minus + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data) + if (present(minus)) then + budget(nf,ic,ip) = budget(nf,ic,ip) - areas(n)*data(n) + else + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*data(n) + end if + end do + end if + end subroutine diag_glc + !=============================================================================== subroutine med_phases_diag_ocn( gcomp, rc) @@ -1431,74 +1421,73 @@ subroutine med_phases_diag_ocn( gcomp, rc) budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice + deallocate(sfrac) call t_stopf('MED:'//subname) - contains - - subroutine diag_ocn(FB, fldname, nf, ic, areas, frac, budget, scale, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: frac(:) - real(r8) , intent(inout) :: budget(:,:,:) - real(r8), optional , intent(in) :: scale - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data) - if (present(scale)) then - budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*frac(n)*data(n)*scale - else - budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*frac(n)*data(n) - end if - end do - end if - end subroutine diag_ocn - - subroutine diag_ocn_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, frac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: frac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - - ! local variables - integer :: n, ip - type(ESMF_field) :: lfield - real(r8), pointer :: data(:,:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*frac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*frac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*frac(n)*data(3,n) - end do - end if - end subroutine diag_ocn_wiso - end subroutine med_phases_diag_ocn + subroutine diag_ocn(FB, fldname, nf, ic, areas, frac, budget, scale, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + integer , intent(in) :: ic + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: frac(:) + real(r8) , intent(inout) :: budget(:,:,:) + real(r8), optional , intent(in) :: scale + integer , intent(out) :: rc + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data) + if (present(scale)) then + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*frac(n)*data(n)*scale + else + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*frac(n)*data(n) + end if + end do + end if + end subroutine diag_ocn + + subroutine diag_ocn_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, frac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + integer , intent(in) :: ic + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: frac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc + + ! local variables + integer :: n, ip + type(ESMF_field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data, dim=2) + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*frac(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*frac(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*frac(n)*data(3,n) + end do + end if + end subroutine diag_ocn_wiso + !=============================================================================== subroutine med_phases_diag_ice_ice2med( gcomp, rc) @@ -1574,98 +1563,95 @@ subroutine med_phases_diag_ice_ice2med( gcomp, rc) f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, areas, lats, ifrac, budget_local, rc=rc) call t_stopf('MED:'//subname) + end subroutine med_phases_diag_ice_ice2med + + subroutine diag_ice_recv(FB, fldname, nf, areas, lats, ifrac, budget, minus, scale, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + logical, optional , intent(in) :: minus + real(r8), optional , intent(in) :: scale + integer , intent(out) :: rc + ! local variables + integer :: n, ic, ip + type(ESMF_Field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1,size(data) + if (lats(n) > 0.0_r8) then + ic = c_inh_recv + else + ic = c_ish_recv + endif + if (present(minus)) then + if (present(scale)) then + budget(nf ,ic,ip) = budget(nf ,ic,ip) - areas(n)*ifrac(n)*data(n)*scale + else + budget(nf ,ic,ip) = budget(nf ,ic,ip) - areas(n)*ifrac(n)*data(n) + end if + else + if (present(scale)) then + budget(nf ,ic,ip) = budget(nf ,ic,ip) + areas(n)*ifrac(n)*data(n)*scale + else + budget(nf ,ic,ip) = budget(nf ,ic,ip) + areas(n)*ifrac(n)*data(n) + end if + end if + end do + end if + end subroutine diag_ice_recv - contains - - subroutine diag_ice_recv(FB, fldname, nf, areas, lats, ifrac, budget, minus, scale, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - real(r8), optional , intent(in) :: scale - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_Field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1,size(data) - if (lats(n) > 0.0_r8) then - ic = c_inh_recv - else - ic = c_ish_recv - endif - if (present(minus)) then - if (present(scale)) then - budget(nf ,ic,ip) = budget(nf ,ic,ip) - areas(n)*ifrac(n)*data(n)*scale - else - budget(nf ,ic,ip) = budget(nf ,ic,ip) - areas(n)*ifrac(n)*data(n) - end if - else - if (present(scale)) then - budget(nf ,ic,ip) = budget(nf ,ic,ip) + areas(n)*ifrac(n)*data(n)*scale - else - budget(nf ,ic,ip) = budget(nf ,ic,ip) + areas(n)*ifrac(n)*data(n) - end if - end if - end do - end if - end subroutine diag_ice_recv - - subroutine diag_ice_recv_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_Field) :: lfield - real(r8), pointer :: data(:,:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (lats(n) > 0.0_r8) then - ic = c_inh_recv - else - ic = c_ish_recv - endif - if (present(minus)) then - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*ifrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*ifrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*ifrac(n)*data(3,n) - else - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*ifrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*ifrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*ifrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_ice_recv_wiso + subroutine diag_ice_recv_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, minus, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + logical, optional , intent(in) :: minus + integer , intent(out) :: rc + ! local variables + integer :: n, ic, ip + type(ESMF_Field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS - end subroutine med_phases_diag_ice_ice2med + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data, dim=2) + if (lats(n) > 0.0_r8) then + ic = c_inh_recv + else + ic = c_ish_recv + endif + if (present(minus)) then + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*ifrac(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*ifrac(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*ifrac(n)*data(3,n) + else + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*ifrac(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*ifrac(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*ifrac(n)*data(3,n) + end if + end do + end if + end subroutine diag_ice_recv_wiso !=============================================================================== subroutine med_phases_diag_ice_med2ice( gcomp, rc) @@ -1755,77 +1741,74 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) f_watr_snow_16O, f_watr_snow_18O, f_watr_snow_HDO, areas, lats, ifrac, budget_local, rc=rc) call t_stopf('MED:'//subname) + end subroutine med_phases_diag_ice_med2ice + + subroutine diag_ice_send(FB, fldname, nf, areas, lats, ifrac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc + ! local variables + integer :: n, ic, ip + type(ESMF_Field) :: lfield + real(r8), pointer :: data(:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + ip = period_inst + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(data) + if (lats(n) > 0.0_r8) then + ic = c_inh_send + else + ic = c_ish_send + endif + budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*ifrac(n)*data(n) + end do + end if + end subroutine diag_ice_send - contains - - subroutine diag_ice_send(FB, fldname, nf, areas, lats, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - ! local variables - integer :: n, ip - type(ESMF_Field) :: lfield - real(r8), pointer :: data(:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - ip = period_inst - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata1d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(data) - if (lats(n) > 0.0_r8) then - ic = c_inh_send - else - ic = c_ish_send - endif - budget(nf,ic,ip) = budget(nf,ic,ip) + areas(n)*ifrac(n)*data(n) - end do - end if - end subroutine diag_ice_send - - subroutine diag_ice_send_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - - ! local variables - integer :: n, ip - type(ESMF_Field) :: lfield - real(r8), pointer :: data(:,:) => null() - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (lats(n) > 0.0_r8) then - ic = c_inh_send - else - ic = c_ish_send - endif - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*ifrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*ifrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*ifrac(n)*data(3,n) - end do - end if - end subroutine diag_ice_send_wiso + subroutine diag_ice_send_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, rc) + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(in) :: nf_16O + integer , intent(in) :: nf_18O + integer , intent(in) :: nf_HDO + real(r8) , intent(in) :: areas(:) + real(r8) , intent(in) :: lats(:) + real(r8) , intent(in) :: ifrac(:) + real(r8) , intent(inout) :: budget(:,:,:) + integer , intent(out) :: rc - end subroutine med_phases_diag_ice_med2ice + ! local variables + integer :: n, ic, ip + type(ESMF_Field) :: lfield + real(r8), pointer :: data(:,:) => null() + ! ------------------------------------------------------------------ + rc = ESMF_SUCCESS + if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then + call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ip = period_inst + do n = 1, size(data, dim=2) + if (lats(n) > 0.0_r8) then + ic = c_inh_send + else + ic = c_ish_send + endif + budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*ifrac(n)*data(1,n) + budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*ifrac(n)*data(2,n) + budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*ifrac(n)*data(3,n) + end do + end if + end subroutine diag_ice_send_wiso !=============================================================================== subroutine med_phases_diag_print(gcomp, rc) From 924b4662404fcff685146249fef110f1f87ee4cd Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 1 Jun 2021 07:52:07 -0600 Subject: [PATCH 4/4] remove debug print statement --- mediator/med_diag_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 9f9d37877..c996f4354 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -2325,8 +2325,6 @@ subroutine med_diag_print_summary(data, ip, date, tod) ice_area_sh = data(f_area,c_ish_recv,ip) sum_area = atm_area + lnd_area + ocn_area + ice_area_nh + ice_area_sh write(diagunit,FA1) budget_diags%fields(f_area)%name, atm_area, lnd_area, ocn_area, ice_area_nh, ice_area_sh, sum_area - write(diagUnit,*) 'counter: ',budget_counter(f_area, c_atm_recv, ip) - ! write out net heat budgets write(diagunit,*) ' '