diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 7afcbc992..337b7bc56 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -522,7 +522,7 @@ subroutine esm_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .true. - case (optNYears) + case (optNYears, trim(optNYears)//'s') call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n diff --git a/cesm/nuopc_cap_share/shr_drydep_mod.F90 b/cesm/nuopc_cap_share/shr_drydep_mod.F90 index ae67df4f9..8b6464da4 100644 --- a/cesm/nuopc_cap_share/shr_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/shr_drydep_mod.F90 @@ -6,15 +6,17 @@ module shr_drydep_mod ! dry deposition of tracers !======================================================================== - use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet, ESMF_LOGMSG_INFO use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS + use ESMF , only : ESMF_LogWrite, ESMF_VMBroadCast use shr_sys_mod , only : shr_sys_abort use shr_kind_mod , only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX use shr_const_mod , only : SHR_CONST_MWWV - use shr_mpi_mod , only : shr_mpi_bcast use shr_nl_mod , only : shr_nl_find_group_name use shr_log_mod , only : s_logunit => shr_log_Unit + use shr_file_mod , only : shr_file_getLogUnit use shr_infnan_mod , only : shr_infnan_posinf, assignment(=) + use nuopc_shr_methods, only : chkerr implicit none private @@ -32,8 +34,6 @@ module shr_drydep_mod integer, public, parameter :: NLUse = 11 ! Number of land-use types integer, private, protected :: NHen - logical, private :: drydep_initialized = .false. - ! public data members: real(r8), public, parameter :: ph = 1.e-5_r8 ! measure of the acidity (dimensionless) @@ -222,12 +222,15 @@ module shr_drydep_mod character(len=16), public, protected, allocatable :: species_name_table(:) !--- data for effective Henry's Law coefficient --- - real(r8), public, protected, allocatable :: dheff(:,:) + real(r8), public, protected, allocatable, target :: dheff(:,:) real(r8), private, parameter :: wh2o = SHR_CONST_MWWV real(r8), allocatable :: mol_wgts(:) character(len=500) :: dep_data_file = 'NONE' ! complete file path + character(len=*), parameter :: u_FILE_u = & + __FILE__ + !=============================================================================== CONTAINS @@ -263,6 +266,7 @@ subroutine shr_drydep_readnl(NLFilename, drydep_nflds) ! Read namelist and figure out the drydep field list to pass ! First check if file exists and if not, n_drydep will be zero !----------------------------------------------------------------------------- + call ESMF_LogWrite(subname//' start', ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS @@ -274,10 +278,11 @@ subroutine shr_drydep_readnl(NLFilename, drydep_nflds) call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=mpicom, rc=rc) + call ESMF_VMGet(vm, localPet=localPet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (localPet==0) then + call shr_file_getLogUnit(s_logunit) inquire( file=trim(NLFileName), exist=exists) if ( exists ) then open(newunit=unitn, file=trim(NLFilename), status='old' ) @@ -293,8 +298,10 @@ subroutine shr_drydep_readnl(NLFilename, drydep_nflds) close( unitn ) end if end if - call shr_mpi_bcast( drydep_list, mpicom ) - call shr_mpi_bcast( dep_data_file, mpicom ) + call ESMF_LogWrite(subname//' bcast drydep_list', ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, drydep_list, maxspc*32, 0) + call ESMF_LogWrite(subname//' bcast dep_data_file', ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, dep_data_file, 500, 0) drydep_nflds = 0 @@ -314,25 +321,22 @@ subroutine shr_drydep_readnl(NLFilename, drydep_nflds) write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', drydep_nflds end if end if - - if (.not. drydep_initialized) then - call shr_drydep_init() - end if + call shr_drydep_init() + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine shr_drydep_readnl !==================================================================================== subroutine shr_drydep_init( ) - - use shr_pio_mod, only: shr_pio_getiosys, shr_pio_getiotype - use pio use netcdf !======================================================================== ! Initialization of dry deposition fields ! reads drydep_inparm namelist and sets up CCSM driver list of fields for ! land-atmosphere communications. + ! This is called by both lnd and atm - we need to do this in order to + ! allow for these components to run on disjoint sets of tasks !======================================================================== !----- local ----- @@ -342,26 +346,27 @@ subroutine shr_drydep_init( ) type(ESMF_VM) :: vm integer :: localPet integer :: mpicom + integer :: bint(2) + real(kind=r8), pointer :: dptr(:) integer :: rc + logical, save :: drydep_initialized=.false. + character(len=256) :: msg !----- formats ----- character(*),parameter :: subName = '(shr_drydep_init) ' character(*),parameter :: F00 = "('(shr_drydep_init) ',8a)" - !----------------------------------------------------------------------------- - ! Return if this routine has already been called (e.g. cam and clm both call this) - !----------------------------------------------------------------------------- - if(allocated(foxd)) return + call ESMF_LogWrite(subname//' start', ESMF_LOGMSG_INFO) if (dep_data_file=='NONE' .or. len_trim(dep_data_file)==0) return rc = ESMF_SUCCESS call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=mpicom, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return rc = nf90_noerr @@ -372,23 +377,29 @@ subroutine shr_drydep_init( ) rc = nf90_inq_dimid(fileid,'n_species_table',dimid) if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_dimid n_species_table') - rc = nf90_inquire_dimension(fileid,dimid,len=n_species_table) + rc = nf90_inquire_dimension(fileid,dimid,len=bint(1)) if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inquire_dimension n_species_table') rc = nf90_inq_dimid(fileid,'NHen',dimid) if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_dimid NHen') - rc = nf90_inquire_dimension(fileid,dimid,len=nHen) + rc = nf90_inquire_dimension(fileid,dimid,len=bint(2)) if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inquire_dimension nHen') endif - call shr_mpi_bcast( n_species_table, mpicom ) - call shr_mpi_bcast( nHen, mpicom ) - - allocate( mol_wgts(n_species_table) ) - allocate( dfoxd(n_species_table) ) - allocate( species_name_table(n_species_table) ) - allocate( dheff(nhen,n_species_table)) - + write(msg,*) subname//' bcast n_species_table', localPet, bint + call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, bint, 2, 0, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + n_species_table = bint(1) + nHen = bint(2) + write(msg,*) subname//' after bcast n_species_table', n_species_table, nhen + call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO) + if(.not. allocated(mol_wgts)) allocate( mol_wgts(n_species_table) ) + if(.not. allocated(dfoxd)) allocate( dfoxd(n_species_table) ) + if(.not. allocated(species_name_table)) allocate( species_name_table(n_species_table) ) + if(.not. allocated(dheff)) allocate( dheff(nhen,n_species_table)) + ! This pointer is needed for ESMF_VMBroadcast + dptr => dheff(:,1) if (localPet==0) then rc = nf90_inq_varid(fileid,'mol_wghts',varid) if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid mol_wghts') @@ -413,141 +424,147 @@ subroutine shr_drydep_init( ) rc = nf90_close(fileid) if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_close') end if - call shr_mpi_bcast( mol_wgts, mpicom ) - call shr_mpi_bcast( dfoxd, mpicom ) - call shr_mpi_bcast( species_name_table, mpicom ) - call shr_mpi_bcast( dheff, mpicom ) + call ESMF_LogWrite(subname//' bcast mol_wgts', ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, mol_wgts, n_species_table, 0, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//' bcast dfoxd', ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, dfoxd, n_species_table, 0, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//' bcast species_name_table', ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, species_name_table, 16*n_species_table, 0, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//' bcast dheff', ESMF_LOGMSG_INFO) + call ESMF_VMBroadcast(vm, dptr, nhen*n_species_table, 0, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return !----------------------------------------------------------------------------- ! Allocate and fill foxd, drat and mapping as well as species indices !----------------------------------------------------------------------------- - if ( n_drydep > 0 ) then - - allocate( foxd(n_drydep) ) - allocate( drat(n_drydep) ) - allocate( mapping(n_drydep) ) - - ! This initializes these variables to infinity. - foxd = shr_infnan_posinf - drat = shr_infnan_posinf - - mapping(:) = 0 - - end if - - h2_ndx=-1; ch4_ndx=-1; co_ndx=-1; mpan_ndx = -1; pan_ndx = -1; so2_ndx=-1; o3_ndx=-1; xpan_ndx=-1 - - !--- Loop over drydep species that need to be worked with --- - do i=1,n_drydep - if ( len_trim(drydep_list(i))==0 ) exit - - test_name = drydep_list(i) - - if( trim(test_name) == 'O3' ) then - test_name = 'OX' - end if + if ( .not. drydep_initialized ) then + if (n_drydep > 0) then + allocate( foxd(n_drydep) ) + allocate( drat(n_drydep) ) + allocate( mapping(n_drydep) ) + + ! This initializes these variables to infinity. + foxd = shr_infnan_posinf + drat = shr_infnan_posinf + + mapping(:) = 0 + endif - !--- Figure out if species maps to a species in the species table --- - do l = 1,n_species_table - if( trim( test_name ) == trim( species_name_table(l) ) ) then - mapping(i) = l - exit - end if - end do + h2_ndx=-1; ch4_ndx=-1; co_ndx=-1; mpan_ndx = -1; pan_ndx = -1; so2_ndx=-1; o3_ndx=-1; xpan_ndx=-1 - !--- If it doesn't map to a species in the species table find species close enough --- - if( mapping(i) < 1 ) then - select case( trim(test_name) ) - case( 'O3S', 'O3INERT' ) + !--- Loop over drydep species that need to be worked with --- + do i=1,n_drydep + if ( len_trim(drydep_list(i))==0 ) exit + + test_name = drydep_list(i) + + if( trim(test_name) == 'O3' ) then test_name = 'OX' - case( 'Pb' ) - test_name = 'HNO3' - case( 'SOGM','SOGI','SOGT','SOGB','SOGX' ) - test_name = 'CH3OOH' - case( 'SOA', 'SO4', 'CB1', 'CB2', 'OC1', 'OC2', 'NH4', 'SA1', 'SA2', 'SA3', 'SA4' ) - test_name = 'OX' ! this is just a place holder. values are explicitly set below - case( 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) - test_name = 'OX' ! this is just a place holder. values are explicitly set below - case( 'SOAGbb0' ) - test_name = 'SOAGff0' - case( 'SOAGbb1' ) - test_name = 'SOAGff1' - case( 'SOAGbb2' ) - test_name = 'SOAGff2' - case( 'SOAGbb3' ) - test_name = 'SOAGff3' - case( 'SOAGbb4' ) - test_name = 'SOAGff4' - case( 'O3A' ) - test_name = 'OX' - case( 'XMPAN' ) - test_name = 'MPAN' - case( 'XPAN' ) - test_name = 'PAN' - case( 'XNO' ) - test_name = 'NO' - case( 'XNO2' ) - test_name = 'NO2' - case( 'XHNO3' ) - test_name = 'HNO3' - case( 'XONIT' ) - test_name = 'ONIT' - case( 'XONITR' ) - test_name = 'ONITR' - case( 'XHO2NO2') - test_name = 'HO2NO2' - case( 'XNH4NO3' ) - test_name = 'HNO3' - case( 'NH4NO3' ) - test_name = 'HNO3' - case default - test_name = 'blank' - end select - - !--- If found a match check the species table again --- - if( trim(test_name) /= 'blank' ) then - do l = 1,n_species_table - if( trim( test_name ) == trim( species_name_table(l) ) ) then - mapping(i) = l - exit - end if - end do - else - write(s_logunit,F00) trim(drydep_list(i)),' not in tables; will have dep vel = 0' - call shr_sys_abort( subName//': '//trim(drydep_list(i))//' is not in tables' ) end if - end if - - !--- Figure out the specific species indices --- - if ( trim(drydep_list(i)) == 'H2' ) h2_ndx = i - if ( trim(drydep_list(i)) == 'CO' ) co_ndx = i - if ( trim(drydep_list(i)) == 'CH4' ) ch4_ndx = i - if ( trim(drydep_list(i)) == 'MPAN' ) mpan_ndx = i - if ( trim(drydep_list(i)) == 'PAN' ) pan_ndx = i - if ( trim(drydep_list(i)) == 'SO2' ) so2_ndx = i - if ( trim(drydep_list(i)) == 'OX' .or. trim(drydep_list(i)) == 'O3' ) o3_ndx = i - if ( trim(drydep_list(i)) == 'O3A' ) o3a_ndx = i - if ( trim(drydep_list(i)) == 'XPAN' ) xpan_ndx = i - - if( mapping(i) > 0) then - l = mapping(i) - foxd(i) = dfoxd(l) - drat(i) = sqrt(mol_wgts(l)/wh2o) - endif - - enddo + + !--- Figure out if species maps to a species in the species table --- + do l = 1,n_species_table + if( trim( test_name ) == trim( species_name_table(l) ) ) then + mapping(i) = l + exit + end if + end do + + !--- If it doesn't map to a species in the species table find species close enough --- + if( mapping(i) < 1 ) then + select case( trim(test_name) ) + case( 'O3S', 'O3INERT' ) + test_name = 'OX' + case( 'Pb' ) + test_name = 'HNO3' + case( 'SOGM','SOGI','SOGT','SOGB','SOGX' ) + test_name = 'CH3OOH' + case( 'SOA', 'SO4', 'CB1', 'CB2', 'OC1', 'OC2', 'NH4', 'SA1', 'SA2', 'SA3', 'SA4' ) + test_name = 'OX' ! this is just a place holder. values are explicitly set below + case( 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) + test_name = 'OX' ! this is just a place holder. values are explicitly set below + case( 'SOAGbb0' ) + test_name = 'SOAGff0' + case( 'SOAGbb1' ) + test_name = 'SOAGff1' + case( 'SOAGbb2' ) + test_name = 'SOAGff2' + case( 'SOAGbb3' ) + test_name = 'SOAGff3' + case( 'SOAGbb4' ) + test_name = 'SOAGff4' + case( 'O3A' ) + test_name = 'OX' + case( 'XMPAN' ) + test_name = 'MPAN' + case( 'XPAN' ) + test_name = 'PAN' + case( 'XNO' ) + test_name = 'NO' + case( 'XNO2' ) + test_name = 'NO2' + case( 'XHNO3' ) + test_name = 'HNO3' + case( 'XONIT' ) + test_name = 'ONIT' + case( 'XONITR' ) + test_name = 'ONITR' + case( 'XHO2NO2') + test_name = 'HO2NO2' + case( 'XNH4NO3' ) + test_name = 'HNO3' + case( 'NH4NO3' ) + test_name = 'HNO3' + case default + test_name = 'blank' + end select + + !--- If found a match check the species table again --- + if( trim(test_name) /= 'blank' ) then + do l = 1,n_species_table + if( trim( test_name ) == trim( species_name_table(l) ) ) then + mapping(i) = l + exit + end if + end do + else + write(s_logunit,F00) trim(drydep_list(i)),' not in tables; will have dep vel = 0' + call shr_sys_abort( subName//': '//trim(drydep_list(i))//' is not in tables' ) + end if + end if - where( rgss < 1._r8 ) - rgss = 1._r8 - endwhere + !--- Figure out the specific species indices --- + if ( trim(drydep_list(i)) == 'H2' ) h2_ndx = i + if ( trim(drydep_list(i)) == 'CO' ) co_ndx = i + if ( trim(drydep_list(i)) == 'CH4' ) ch4_ndx = i + if ( trim(drydep_list(i)) == 'MPAN' ) mpan_ndx = i + if ( trim(drydep_list(i)) == 'PAN' ) pan_ndx = i + if ( trim(drydep_list(i)) == 'SO2' ) so2_ndx = i + if ( trim(drydep_list(i)) == 'OX' .or. trim(drydep_list(i)) == 'O3' ) o3_ndx = i + if ( trim(drydep_list(i)) == 'O3A' ) o3a_ndx = i + if ( trim(drydep_list(i)) == 'XPAN' ) xpan_ndx = i + + if( mapping(i) > 0) then + l = mapping(i) + foxd(i) = dfoxd(l) + drat(i) = sqrt(mol_wgts(l)/wh2o) + endif + + enddo - where( rac < small_value) - rac = small_value - endwhere + where( rgss < 1._r8 ) + rgss = 1._r8 + endwhere + where( rac < small_value) + rac = small_value + endwhere + end if drydep_initialized = .true. - end subroutine shr_drydep_init !==================================================================================== diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index a2a2dbdac..5c04c7e3d 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -706,6 +706,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) +<<<<<<< HEAD ! to wav: sea ice fraction, thickness and floe diameter allocate(flds(3)) flds = (/'Si_ifrac ', 'Si_floediam', 'Si_thick '/) @@ -725,6 +726,21 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end if end do deallocate(flds) +======= + ! to wav: sea ice fraction + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then + call addfld(fldListFr(compice)%flds, 'Si_ifrac') + call addfld(fldListTo(compwav)%flds, 'Si_ifrac') + end if + else + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_ifrac', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_ifrac', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_ifrac', compwav, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + end if + end if +>>>>>>> escomp/master ! to wav: zonal sea water velocity from ocn ! to wav: meridional sea water velocity from ocn @@ -741,7 +757,11 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then +<<<<<<< HEAD call addmap(fldListFr(compocn)%flds, trim(fldname), compwav, mapbilnr_nstod , 'one', 'unset') +======= + call addmap(fldListFr(compocn)%flds, trim(fldname), compwav, mapfcopy , 'unset', 'unset') +>>>>>>> escomp/master call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') end if end if @@ -758,7 +778,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) flds = (/'Sa_z ', 'Sa_topo ', 'Sa_tbot ', 'Sa_pbot ', & 'Sa_shum ', 'Sa_u ', 'Sa_v ', 'Faxa_lwdn ', & 'Sa_ptem ', 'Sa_dens ', 'Faxa_swdn ', 'Sa_pslv ', & - 'Faxa_snowc', 'Faxa_snowl', 'Faxa_rainc', 'Faxa_rainl', & + 'Faxa_snowc', 'Faxa_snowl', 'Faxa_rainc', 'Faxa_rainl', & 'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swvdf', & 'Faxa_swnet'/) else diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index f25b024cd..203b1923d 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -102,10 +102,8 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r integer :: lrank integer :: fieldCount integer :: ungriddedCount - integer :: gridToFieldMapCount integer :: ungriddedLBound(1) integer :: ungriddedUBound(1) - integer :: gridToFieldMap(1) real(R8), pointer :: dataptr1d(:) real(R8), pointer :: dataptr2d(:,:) character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) @@ -165,16 +163,13 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r return end if - ! set ungridded dimensions and GridToFieldMap for field + ! set ungridded dimensions 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 ! get 2d pointer for field call ESMF_FieldGet(lfield, farrayptr=dataptr2d, rc=rc) @@ -183,7 +178,7 @@ subroutine med_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, r ! create new field with an ungridded dimension newfield = ESMF_FieldCreate(lmesh, dataptr2d, ESMF_INDEX_DELOCAL, & meshloc=meshloc, name=lfieldNameList(n), & - ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=gridtoFieldMap, rc=rc) + ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=(/2/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else if (lrank == 1) then @@ -256,10 +251,9 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S type(ESMF_StaggerLoc) :: staggerloc type(ESMF_MeshLoc) :: meshloc integer :: ungriddedCount + integer :: ungriddedCount_in integer, allocatable :: ungriddedLBound(:) integer, allocatable :: ungriddedUBound(:) - integer :: gridToFieldMapCount - integer, allocatable :: gridToFieldMap(:) logical :: isPresent character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) character(len=*), parameter :: subname='(med_methods_FB_init)' @@ -359,7 +353,7 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S call ESMF_StateGet(STgeom, itemNameList=lfieldNameList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STflds", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STgeom", ESMF_LOGMSG_INFO) end if else call ESMF_LogWrite(trim(subname)//": ERROR fieldNameList, FBflds, STflds, FBgeom, or STgeom must be passed", & @@ -376,7 +370,7 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S if (trim(lfieldnamelist(n)) == trim(flds_scalar_name) .or. & trim(lfieldnamelist(n)) == '') then do n1 = n, fieldCount-1 - lfieldnamelist(n1) = lfieldnamelist(n1+1) + lfieldnamelist(n1) = lfieldnamelist(n1+1) enddo fieldCount = fieldCount - 1 endif @@ -445,7 +439,7 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S ! ungridded dimensions might be present in the input states or field bundles if (present(FBflds)) then - call med_methods_FB_getFieldN(FBflds, n, lfield, rc=rc) + call ESMF_FieldBundleGet(FBflds, fieldName=lfieldnamelist(n), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return elseif (present(STflds)) then call med_methods_State_getNameN(STflds, n, lname, rc) @@ -455,10 +449,14 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S end if ! Determine ungridded lower and upper bounds for lfield - ungriddedCount=0 ! initialize in case it was not set - call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & - purpose="Instance", itemCount=ungriddedCount, isPresent=isPresent, rc=rc) + call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", itemCount=ungriddedCount_in, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + ungriddedCount = ungriddedCount_in + else + ungriddedCount=0 ! initialize in case it was not set + end if ! Create the field on a lmesh if (ungriddedCount > 0) then @@ -471,20 +469,11 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S 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) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(gridToFieldMap(gridToFieldMapCount)) - call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & - purpose="Instance", valueList=gridToFieldMap, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), & - ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, & - gridToFieldMap=gridToFieldMap) + ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=(/2/)) if (chkerr(rc,__LINE__,u_FILE_u)) return - deallocate( ungriddedLbound, ungriddedUbound, gridToFieldMap) + deallocate( ungriddedLbound, ungriddedUbound) else ! No ungridded dimensions in field field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7cfc6fc89..f98ece233 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -896,7 +896,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid)) .and. .not. & ESMF_FieldBundleIsCreated(avgfile%FBaccum_import)) then call med_methods_FB_init(avgfile%FBaccum_import, scalar_name, & - FBgeom=is_local%wrap%FBImp(compid,compid), FBflds=is_local%wrap%FBimp(compid,compid), rc=rc) + STgeom=is_local%wrap%NStateImp(compid), STflds=is_local%wrap%NStateImp(compid), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(avgfile%FBaccum_import, czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -905,7 +905,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid)) .and. .not. & ESMF_FieldBundleIsCreated(avgfile%FBaccum_export)) then call med_methods_FB_init(avgfile%FBaccum_export, scalar_name, & - FBgeom=is_local%wrap%FBExp(compid), FBflds=is_local%wrap%FBexp(compid), rc=rc) + STgeom=is_local%wrap%NStateExp(compid), STflds=is_local%wrap%NStateExp(compid), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(avgfile%FBaccum_export, czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1021,6 +1021,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! ----------------------------- use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleRemove + use ESMF , only : ESMF_Field, ESMF_FieldGet !DEBUG use med_constants_mod, only : czero => med_constants_czero use med_io_mod , only : med_io_write_time, med_io_define_time use med_methods_mod , only : med_methods_FB_init @@ -1166,7 +1167,8 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compid,compid)) .and. .not. & ESMF_FieldBundleIsCreated(auxcomp%files(nfcnt)%FBaccum)) then call med_methods_FB_init(auxcomp%files(nfcnt)%FBaccum, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(compid,compid), FBflds=is_local%wrap%FBImp(compid,compid), rc=rc) + STgeom=is_local%wrap%NStateImp(compid), STflds=is_local%wrap%NStateImp(compid), & + rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(auxcomp%files(nfcnt)%FBaccum, czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1257,12 +1259,6 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! Write time sample to file if ( write_now ) then - ! Determine time_val and tbnds data for history as well as history file name - call med_phases_history_set_timeinfo(gcomp, auxcomp%files(nf)%clock, auxcomp%files(nf)%alarmname, & - time_val, time_bnds, time_units, auxcomp%files(nf)%histfile, auxcomp%files(nf)%doavg, & - auxname=auxcomp%files(nf)%auxname, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Set shorthand variables nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) @@ -1270,8 +1266,21 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! Increment number of time samples on file auxcomp%files(nf)%nt = auxcomp%files(nf)%nt + 1 + ! Determine time_val and tbnds data for history as well as history file name + if (auxcomp%files(nf)%nt == 1) then + call med_phases_history_set_timeinfo(gcomp, auxcomp%files(nf)%clock, auxcomp%files(nf)%alarmname, & + time_val, time_bnds, time_units, auxcomp%files(nf)%histfile, auxcomp%files(nf)%doavg, & + auxname=auxcomp%files(nf)%auxname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_phases_history_set_timeinfo(gcomp, auxcomp%files(nf)%clock, auxcomp%files(nf)%alarmname, & + time_val, time_bnds, time_units, auxcomp%files(nf)%histfile, auxcomp%files(nf)%doavg, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + ! Write header if (auxcomp%files(nf)%nt == 1) then + ! open file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1313,6 +1322,8 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! Close file if (auxcomp%files(nf)%nt == auxcomp%files(nf)%ntperfile) then + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_close(auxcomp%files(nf)%histfile, vm, file_ind=nf, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return auxcomp%files(nf)%nt = 0 @@ -1406,30 +1417,48 @@ subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) integer :: n type(ESMF_Field) :: lfield type(ESMF_Field) :: lfield_accum + integer :: fieldCount_accum + character(CL), pointer :: fieldnames_accum(:) integer :: fieldCount character(CL), pointer :: fieldnames(:) real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) real(r8), pointer :: dataptr1d_accum(:) real(r8), pointer :: dataptr2d_accum(:,:) + integer :: ungriddedUBound_accum(1) integer :: ungriddedUBound(1) + character(len=64) :: msg !--------------------------------------- rc = ESMF_SUCCESS - ! Accumulate field - call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount, rc=rc) + ! Loop over field names in fldbun_accum + + call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount_accum, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(fieldnames(fieldCount)) - call ESMF_FieldBundleGet(fldbun_accum, fieldNameList=fieldnames, rc=rc) + allocate(fieldnames_accum(fieldCount_accum)) + call ESMF_FieldBundleGet(fldbun_accum, fieldCount=fieldCount_accum, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, fieldcount - call ESMF_FieldBundleGet(fldbun, fieldName=trim(fieldnames(n)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldBundleGet(fldbun_accum, fieldName=trim(fieldnames(n)), field=lfield_accum, rc=rc) + call ESMF_FieldBundleGet(fldbun_accum, fieldNameList=fieldnames_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldcount_accum + call ESMF_FieldBundleGet(fldbun, fieldName=trim(fieldnames_accum(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(fldbun_accum, fieldName=trim(fieldnames_accum(n)), field=lfield_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield_accum, ungriddedUBound=ungriddedUBound_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (ungriddedUBound(1) /= ungriddedUBound_accum(1)) then + call ESMF_LogWrite(" upper bounds for field and field_accum do not match", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + end if + if (ungriddedUBound(1) > 0) then call ESMF_FieldGet(lfield, farrayptr=dataptr2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1444,7 +1473,7 @@ subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) dataptr1d_accum(:) = dataptr1d_accum(:) + dataptr1d(:) end if end do - deallocate(fieldnames) + deallocate(fieldnames_accum) ! Accumulate counter count = count + 1 diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 14cd7464b..5ba7f30a7 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -28,13 +28,13 @@ module med_time_mod character(len=*), private, parameter :: & optNONE = "none" , & optNever = "never" , & - optNSteps = "nsteps" , & - optNSeconds = "nseconds" , & - optNMinutes = "nminutes" , & - optNHours = "nhours" , & - optNDays = "ndays" , & - optNMonths = "nmonths" , & - optNYears = "nyears" , & + optNSteps = "nstep" , & + optNSeconds = "nsecond" , & + optNMinutes = "nminute" , & + optNHours = "nhour" , & + optNDays = "nday" , & + optNMonths = "nmonth" , & + optNYears = "nyear" , & optMonthly = "monthly" , & optYearly = "yearly" , & optDate = "date" , & @@ -127,13 +127,14 @@ subroutine med_time_alarmInit( clock, alarm, option, & rc = ESMF_FAILURE return end if - else if (trim(option) == optNSteps .or. & - trim(option) == optNSeconds .or. & - trim(option) == optNMinutes .or. & - trim(option) == optNHours .or. & - trim(option) == optNDays .or. & - trim(option) == optNMonths .or. & - trim(option) == optNYears) then + else if (& + trim(option) == optNSteps .or. trim(option) == trim(optNSteps)//'s' .or. & + trim(option) == optNSeconds .or. trim(option) == trim(optNSeconds)//'s' .or. & + trim(option) == optNMinutes .or. trim(option) == trim(optNMinutes)//'s' .or. & + trim(option) == optNHours .or. trim(option) == trim(optNHours)//'s' .or. & + trim(option) == optNDays .or. trim(option) == trim(optNDays)//'s' .or. & + trim(option) == optNMonths .or. trim(option) == trim(optNMonths)//'s' .or. & + trim(option) == optNYears .or. trim(option) == trim(optNYears)//'s' ) then if (.not.present(opt_n)) then call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE @@ -179,40 +180,40 @@ subroutine med_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .false. - case (optNSteps) - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + case (optNSteps,trim(optNSteps)//'s') + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. - case (optNSeconds) - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + case (optNSeconds,trim(optNSeconds)//'s') + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. - case (optNMinutes) - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + case (optNMinutes,trim(optNMinutes)//'s') + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. - case (optNHours) - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + case (optNHours,trim(optNHours)//'s') + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. - case (optNDays) - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + case (optNDays,trim(optNDays)//'s') + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. - case (optNMonths) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. + case (optNMonths,trim(optNMonths)//'s') + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. case (optMonthly) call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) @@ -221,7 +222,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .true. - case (optNYears) + case (optNYears, trim(optNYears)//'s') call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index d83aeb29b..8177ae5ca 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -772,7 +772,7 @@ [use_med_flux] standard_name = do_mediator_atmosphere_ocean_fluxes long_name = flag for using atmosphere-ocean fluxes form mediator (default false) - units = flag + units = flag dimensions = () type = logical [ivegsrc]