From 04b9bbac4908064a66c6c153046d9806686f9cbc Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 26 Jul 2018 15:17:48 -0600 Subject: [PATCH 01/77] unification with EMC addflds, etc --- config_src/nuopc_driver/mom_cap.F90 | 374 ++++++++++++-------- config_src/nuopc_driver/mom_cap_methods.F90 | 136 +------ 2 files changed, 249 insertions(+), 261 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index b14c947fca..402d51b5a5 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -400,16 +400,8 @@ module mom_cap_mod #ifdef CESMCOUPLED use mom_cap_methods, only: mom_import, mom_export use esmFlds, only: flds_scalar_name, flds_scalar_num - use esmFlds, only: fldListFr, fldListTo, compocn, compname use esmFlds, only: flds_scalar_index_nx, flds_scalar_index_ny - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Realize - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Concat - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Getnumflds - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Getfldinfo - use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_SetScalar - use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_GetScalar - use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_Diagnose - use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit, shr_file_setIO + use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_getLogUnit, shr_file_getLogLevel use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel #endif @@ -689,7 +681,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(80) :: stdname, shortname #ifdef CESMCOUPLED integer :: nflds - logical :: activefld character(len=32) :: starttype ! model start type character(len=512) :: diro character(len=512) :: logfile @@ -894,31 +885,121 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) #ifdef CESMCOUPLED - ! create import and export field list needed by data models - ! call shr_nuopc_fldList_Concat(fldListFr(compocn), fldListTo(compocn), flds_o2x, flds_x2o, flds_scalar_name) - - ! advertise import and export fields - nflds = shr_nuopc_fldList_Getnumflds(fldListFr(compocn)) - do n = 1,nflds - call shr_nuopc_fldList_Getfldinfo(fldListFr(compocn), n, activefld, stdname, shortname) - if (activefld) then - call NUOPC_Advertise(exportState, standardName=stdname, shortname=shortname, name=shortname, & - TransferOfferGeomObject='will provide', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if - call ESMF_LogWrite(subname//':Fr_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) - end do + !--------- import fields ------------- + call fld_list_add(fldsToOcn_num, fldsToOcn, trim(flds_scalar_name), "will_provide") ! not in EMC + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface + + ! EMC fields not used + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not in CESM + + ! CESM currently not used + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphidry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphodry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphiwet" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet1" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet2" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet3" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet4" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry1" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry2" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry3" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry4" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcphi" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcpho" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_flxdst" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "So_duu10n" , "will provide") + + ! Optional CESM fields currently not used + ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) flds_co2a + ! call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) flds_co2c + ! call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! if (flds_co2a .or. flds_co2c) then + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2prog" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2diag" , "will provide") + ! end if + ! call NUOPC_CompAttributeGet(gcomp, name='ice_ncat', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) ice_ncat + ! call ESMF_LogWrite('ice_ncat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) flds_i2o_per_cat + ! call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! if (flds_i2o_per_cat) then + ! do num = 1, ice_ncat + ! name = 'Si_ifrac_' // cnum + ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") + ! name = 'PFioi_swpen_ifrac_' // cnum + ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") + ! end do + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afrac" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afracr" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_afracr", "will provide") + ! end if + ! do n = 1,shr_string_listGetNum(ndep_fields) + ! call shr_string_listGetName(ndep_fields, n, name) + ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") + ! end do + + !--------- export fields ------------- + call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(flds_scalar_name), "will_provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC + + ! EMC fields not used + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") ! not in CESM + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") ! not in CESM + + ! Optional CESM fields currently not used + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC + ! if (flds_co2c) then + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! end if - nflds = shr_nuopc_fldList_Getnumflds(fldListTo(compocn)) - do n = 1,nflds - call shr_nuopc_fldList_Getfldinfo(fldListTo(compocn), n, activefld, stdname, shortname) - if (activefld) then - call NUOPC_Advertise(importState, standardName=stdname, shortname=shortname, name=shortname, & - TransferOfferGeomObject='will provide', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_file_u)) return - end if - call ESMF_LogWrite(subname//':To_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) - end do #else @@ -981,8 +1062,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& data=ocean_public%frazil) +#endif + + write(6,*)'DEBUG: fldstoocn_num= ',fldstoocn_num + write(6,*)'DEBUG: fldsfrocn_num= ',fldsfrocn_num do n = 1,fldsToOcn_num - call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)(i)%shortname, rc=rc) + write(6,*)'DEBUG: n, stdname',n,trim(fldsToOcn(n)%stdname) + call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -990,24 +1076,21 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) enddo do n = 1,fldsFrOcn_num - call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, name=fldsFrOcn(n)(i)%shortname, rc=rc) + call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, name=fldsFrOcn(n)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out enddo -#endif - -! When running mom6 solo, the rotation angles are not computed internally -! in MOM6. We need to calculate cos and sin of rotational angle for MOM6; -! the values are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot -! The rotation angles are retrieved during run time to rotate incoming -! and outgoing vectors -! -! call calculate_rot_angle(ocean_state, ocean_public) -! tcraig, this is handled fine internally and if not, then later call this -! call initialize_grid_rotation_angle(ocean_grid, PF) + ! When running mom6 solo, the rotation angles are not computed internally + ! in MOM6. We need to calculate cos and sin of rotational angle for MOM6; + ! the values are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot + ! The rotation angles are retrieved during run time to rotate incoming + ! and outgoing vectors + ! call calculate_rot_angle(ocean_state, ocean_public) + ! tcraig, this is handled fine internally and if not, then later call this + ! call initialize_grid_rotation_angle(ocean_grid, PF) write(*,*) '----- MOM initialization phase Advertise completed' @@ -1074,8 +1157,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(len=16) :: inst_suffix = "" ! char string associated with instance ! (ie. "_0001" or "") character(len=64) :: cvalue - character(len=512) :: diro - character(len=512) :: logfile logical :: isPresent #endif character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' @@ -1508,45 +1589,33 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! realize fields on grid !--------------------------------- -#ifdef CESMCOUPLED - call shr_nuopc_fldList_Realize(importState, fldListTo(compocn), flds_scalar_name, flds_scalar_num, & - grid=gridIn, tag=subname//':MOM6Import', rc=rc) + + call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call shr_nuopc_fldList_Realize(exportState, fldListFr(compocn), flds_scalar_name, flds_scalar_num, & - grid=gridOut, tag=subname//':MOM6Export', rc=rc) + call MOM_RealizeFields(exportState, gridOut, fldsFrOcn_num, fldsFrOcn, "Ocn export", rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, mpicom, & +#ifdef CESMCOUPLED + call State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, localPet, & flds_scalar_name, flds_scalar_num, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, mpicom, & + call State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, localPet, & flds_scalar_name, flds_scalar_num, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out -#else - call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call MOM_RealizeFields(exportState, gridOut, fldsFrOcn_num, fldsFrOcn, "Ocn export", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out #endif call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) @@ -1557,6 +1626,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Do sst initialization if it's part of export state if(icount /= 0) then + call ESMF_StateGet(exportState, itemName='sea_surface_temperature', field=field_t_surf, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2110,54 +2180,6 @@ subroutine ModelAdvance(gcomp, rc) !call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) !write(*,*) 'MOM: --- run phase called ---' - !--------- import fields ------------- - - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx" , "will provide",& - ! Ice_ocean_boundary%u_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx" , "will provide",& - ! Ice_ocean_boundary%v_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide",& - ! Ice_ocean_boundary%t_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide",& - ! Ice_ocean_boundary%q_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide",& - ! Ice_ocean_boundary%salt_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide",& - ! Ice_ocean_boundary%lw_flux ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx" , "will provide",& - ! Ice_ocean_boundary%sw_flux_vis_dir) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx" , "will provide",& - ! Ice_ocean_boundary%sw_flux_vis_dif) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide",& - ! Ice_ocean_boundary%sw_flux_nir_dir) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide",& - ! Ice_ocean_boundary%sw_flux_nir_dif) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide",& - ! Ice_ocean_boundary%lprec ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide",& - ! Ice_ocean_boundary%fprec ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide",& - ! Ice_ocean_boundary%runoff ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide",& - ! Ice_ocean_boundary%calving) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide",& - ! Ice_ocean_boundary%runoff_hflx ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx" , "will provide",& - ! Ice_ocean_boundary%calving_hflx) - ! call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide",& - ! Ice_ocean_boundary%p ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice" , "will provide",& - ! Ice_ocean_boundary%mi) - - !--------- export fields ------------- - - ! call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask" , "will provide", dataPtr_mask) - ! call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature" , "will provide", ocean_public%t_surf) - ! call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", ocean_public%s_surf ) - ! call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal" , "will provide", ocean_public%u_surf ) - ! call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid" , "will provide", ocean_public%v_surf ) - ! call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", ocean_public%sea_lev) - if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") end subroutine ModelAdvance @@ -2522,14 +2544,14 @@ end subroutine writeSliceFields !----------------------------------------------------------------------------- subroutine State_GetFldPtr(ST, fldname, fldptr, rc) - type(ESMF_State), intent(in) :: ST - character(len=*), intent(in) :: fldname - real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) - integer, intent(out), optional :: rc + type(ESMF_State) , intent(in) :: ST + character(len=*) , intent(in) :: fldname + real(ESMF_KIND_R8) , pointer, intent(in) :: fldptr(:,:) + integer , intent(out), optional :: rc ! local variables type(ESMF_Field) :: lfield - integer :: lrc + integer :: lrc character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) @@ -2547,23 +2569,63 @@ subroutine State_GetFldPtr(ST, fldname, fldptr, rc) end subroutine State_GetFldPtr -#ifndef CESMCOUPLED + !----------------------------------------------------------------------------- + + subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_num, rc) + ! ---------------------------------------------- + ! Set scalar data from State for a particular name + ! ---------------------------------------------- + real(ESMF_KIND_R8),intent(in) :: value + integer, intent(in) :: scalar_id + type(ESMF_State), intent(inout) :: State + integer, intent(in) :: mytask + character(len=*), intent(in) :: scalar_name + integer, intent(in) :: scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: ierr, len + type(ESMF_Field) :: field + real(ESMF_KIND_R8), pointer :: farrayptr(:,:) + character(len=*), parameter :: subname='(mom_cap:State_SetScalar)' + + rc = ESMF_SUCCESS + + call ESMF_StateGet(State, itemName=trim(scalar_name), field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr=farrayptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + if (scalar_id < 0 .or. scalar_id > scalar_num) then + call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", & + ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + endif + + farrayptr(1,scalar_id) = value + endif + + end subroutine State_SetScalar !----------------------------------------------------------------------------- subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) - type(ESMF_State), intent(inout) :: state - type(ESMF_Grid), intent(in) :: grid - integer, intent(in) :: nfields - type(fld_list_type), intent(inout) :: field_defs(:) - character(len=*), intent(in) :: tag - integer, intent(inout) :: rc - - integer :: i - type(ESMF_Field) :: field - integer :: npet, nx, ny, pet, elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) - type(ESMF_VM) :: vm + type(ESMF_State) , intent(inout) :: state + type(ESMF_Grid) , intent(in) :: grid + integer , intent(in) :: nfields + type(fld_list_type) , intent(inout) :: field_defs(:) + character(len=*) , intent(in) :: tag + integer , intent(inout) :: rc + + integer :: i + type(ESMF_Field) :: field + integer :: npet, nx, ny, pet + integer :: elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) + type(ESMF_VM) :: vm character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' rc = ESMF_SUCCESS @@ -2578,7 +2640,7 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__, & rc=dbrc) - call shr_nuopc_fldList_SetScalarField(field, rc=rc) + call SetScalarField(field, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -2648,6 +2710,38 @@ end subroutine MOM_RealizeFields !----------------------------------------------------------------------------- + subroutine SetScalarField(field, rc) + ! ---------------------------------------------- + ! create a field with scalar data on the root pe + ! ---------------------------------------------- + type(ESMF_Field), intent(inout) :: field + integer, intent(inout) :: rc + + ! local variables + type(ESMF_Distgrid) :: distgrid + type(ESMF_Grid) :: grid + character(len=*), parameter :: subname='(mom_cap:SetScalarField)' + + rc = ESMF_SUCCESS + + ! create a DistGrid with a single index space element, which gets mapped onto DE 0. + distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + grid = ESMF_GridCreate(distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + field = ESMF_FieldCreate(name=trim(flds_scalar_name), grid=grid, & + typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/flds_scalar_num/), & ! num of scalar values + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine SetScalarField + + !----------------------------------------------------------------------------- + subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) ! ---------------------------------------------- ! Set up a list of field information @@ -2689,8 +2783,6 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) end subroutine fld_list_add -#endif - !----------------------------------------------------------------------------- #if (1 == 0) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index af8013efda..f40e0e0177 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,13 +1,8 @@ module mom_cap_methods - ! This is the main driver for MOM6 in CIME - ! This file is part of MOM6. See LICENSE.md for the license. - - ! mct modules use ESMF, only: ESMF_time, ESMF_ClockGet, ESMF_TimeGet, ESMF_State, ESMF_Clock use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_StateGet, ESMF_FieldGet - use perf_mod, only: t_startf, t_stopf use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type @@ -23,10 +18,8 @@ module mom_cap_methods public :: mom_export public :: mom_import - integer :: rc,dbrc - integer :: import_cnt = 0 - character(len=1024) :: tmpstr - + integer :: rc,dbrc + integer :: import_cnt = 0 logical, parameter :: debug=.false. !----------------------------------------------------------------------- @@ -47,7 +40,7 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) ! Local variables real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices - integer :: lbnd1, lbnd2, ubnd1, ubnd2 + integer :: lbnd1, lbnd2 real :: slp_L, slp_R, slp_C, slope, u_min, u_max integer :: day, secs type(ESMF_time) :: currTime @@ -60,11 +53,6 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fswpen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_roce_16O(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_roce_HDO(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fco2_ocn(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fdms_ocn(:,:) character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*), parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- @@ -117,42 +105,15 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(exportState,"So_fswpen", dataPtr_fswpen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! call State_getFldPtr(exportState,"So_roce_16O", dataPtr_roce_16O, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(exportState,"So_roce_HDO", dataPtr_roce_HDO, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(exportState,"Faoo_fco2_ocn", dataPtr_fco2_ocn, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(exportState,"Faoo_fdms_ocn", dataPtr_fdms_ocn, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out lbnd1 = lbound(dataPtr_t,1) - ubnd1 = ubound(dataPtr_t,1) lbnd2 = lbound(dataPtr_t,2) - ubnd2 = ubound(dataPtr_t,2) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - !Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. - !The mask comes from "grid" that uses the usual MOM domain that has halos - !and does not use global indexing. + ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. + ! The mask comes from "grid" that uses the usual MOM domain that has halos + ! and does not use global indexing. do j = jsc, jec j1 = j + lbnd2 - jsc jg = j + grid%jsc - jsc @@ -294,17 +255,9 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & ! Local Variables integer :: i, j, i1, j1, ig, jg ! Grid indices integer :: isc, iec, jsc, jec ! Grid indices - integer :: isc_bnd, jsc_bnd, ise_bnd, jse_bnd - integer :: lbnd1, lbnd2, ubnd1, ubnd2 integer :: i0, j0, is, js, ie, je + integer :: lbnd1, lbnd2 real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ifrac(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_duu10n(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_co2prog(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_co2diag(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_taux(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_sen(:,:) @@ -317,15 +270,14 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swnet(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_meltw(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_melth(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_iosalt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_prec(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:,:) integer :: day, secs type(ESMF_time) :: currTime logical :: do_import @@ -335,45 +287,7 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & rc = ESMF_SUCCESS - ! import_cnt is used to skip using the import state at the first count - import_cnt = import_cnt + 1 - call State_getFldPtr(importState,'Sa_pslv', dataPtr_p,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'Si_ifrac', dataPtr_ifrac,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"So_duu10n", dataPtr_duu10n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! call State_getFldPtr(importState,"Sa_co2prog", dataPtr_co2prog, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(importState,"Sa_co2diag", dataPtr_co2diag, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - call State_getFldPtr(importState,"Sw_lamult", dataPtr_lamult, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Sw_ustokes", dataPtr_ustokes, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Sw_vstokes", dataPtr_vstokes, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -434,11 +348,6 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & file=__FILE__)) & return ! bail out call State_getFldPtr(importState,"Foxx_lwup" , dataPtr_lwup, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_swnet", dataPtr_swnet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -449,26 +358,11 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & file=__FILE__)) & return ! bail out call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Fioi_meltw", dataPtr_meltw, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Fioi_melth", dataPtr_melth, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out call State_getFldPtr(importState,"Fioi_salt" , dataPtr_iosalt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Faxa_prec" , dataPtr_prec, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -485,12 +379,13 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & return ! bail out lbnd1 = lbound(dataPtr_p,1) - ubnd1 = ubound(dataPtr_p,1) lbnd2 = lbound(dataPtr_p,2) - ubnd2 = ubound(dataPtr_p,2) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + ! import_cnt is used to skip using the import state at the first count + import_cnt = import_cnt + 1 + if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then ! This will skip the first time import information is given do_import = .false. @@ -522,9 +417,10 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) - !ice_ocean_boundary%u_flux(i,j) =& + + !ice_ocean_boundary%u_flux(i,j) = & ! GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) - !ice_ocean_boundary%v_flux(i,j) =& + !ice_ocean_boundary%v_flux(i,j) = & ! GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) enddo enddo From 8fd077b35cc3e5fbc652a876feab81e351437899 Mon Sep 17 00:00:00 2001 From: mvertens Date: Sat, 28 Jul 2018 13:19:53 -0600 Subject: [PATCH 02/77] steps to unify the ncar and emc nuopc caps --- config_src/nuopc_driver/mom_cap.F90 | 100 ++++---- config_src/nuopc_driver/mom_cap_methods.F90 | 253 +++++++++++++++++--- config_src/nuopc_driver/ocn_comp_nuopc.F90 | 3 + 3 files changed, 271 insertions(+), 85 deletions(-) create mode 100644 config_src/nuopc_driver/ocn_comp_nuopc.F90 diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 402d51b5a5..1ec7d0062f 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -404,6 +404,7 @@ module mom_cap_mod use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_getLogUnit, shr_file_getLogLevel use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel + use shr_nuopc_time_mod, only: shr_nuopc_time_alarmInit #endif use ESMF ! TODO: only: ... @@ -1064,10 +1065,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) #endif - write(6,*)'DEBUG: fldstoocn_num= ',fldstoocn_num - write(6,*)'DEBUG: fldsfrocn_num= ',fldsfrocn_num do n = 1,fldsToOcn_num - write(6,*)'DEBUG: n, stdname',n,trim(fldsToOcn(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2004,7 +2002,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out ! If restart alarm is ringing - write restart file - call ESMF_ClockGetAlarm(clock, alarmname='seq_timemgr_alarm_restart', alarm=alarm, rc=rc) + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -2196,9 +2194,12 @@ subroutine ModelSetRunClock(gcomp, rc) type(ESMF_Time) :: mstoptime type(ESMF_TimeInterval) :: mtimestep, dtimestep character(len=128) :: mtimestring, dtimestring - type(ESMF_Alarm),pointer :: alarmList(:) - type(ESMF_Alarm) :: dalarm - integer :: alarmcount, n + character(len=256) :: cvalue + character(len=256) :: restart_option ! Restart option units + integer :: restart_n ! Number until restart interval + integer :: restart_ymd ! Restart date (YYYYMMDD) + type(ESMF_ALARM) :: restart_alarm + logical :: first_time = .true. character(len=*),parameter :: subname='mom_cap:(ModelSetRunClock) ' !-------------------------------- @@ -2242,11 +2243,8 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_LogWrite(subname//" ERROR in time consistency; "//trim(dtimestring)//" ne "//trim(mtimestring), & ESMF_LOGMSG_ERROR, rc=dbrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - rc=ESMF_Failure + rc = ESMF_FAILURE + return endif !-------------------------------- @@ -2261,47 +2259,49 @@ subroutine ModelSetRunClock(gcomp, rc) file=__FILE__)) & return ! bail out - !-------------------------------- - ! copy alarms from driver to model clock if model clock has no alarms (do this only once!) - !-------------------------------- - - call ESMF_ClockGetAlarmList(mclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (alarmCount == 0) then - call ESMF_ClockGetAlarmList(dclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (first_time) then + !-------------------------------- + ! set restart alarm + !-------------------------------- + call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - allocate(alarmList(alarmCount)) - call ESMF_ClockGetAlarmList(dclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmList=alarmList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + read(cvalue,*) restart_n - do n = 1, alarmCount - ! call ESMF_AlarmPrint(alarmList(n), rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dalarm = ESMF_AlarmCreate(alarmList(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_AlarmSet(dalarm, clock=mclock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - enddo + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + read(cvalue,*) restart_ymd + + call shr_nuopc_time_alarmInit(mclock, & + alarm = restart_alarm, & + option = trim(restart_option), & + opt_n = restart_n, & + opt_ymd = restart_ymd, & + RefTime = mcurrTime, & + alarmname = 'alarm_restart', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - deallocate(alarmList) - endif + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + first_time = .false. + end if !-------------------------------- ! Advance model clock to trigger alarms then reset model clock back to currtime diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index f40e0e0177..a826aadae4 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -17,6 +17,7 @@ module mom_cap_methods ! Public member functions public :: mom_export public :: mom_import + public :: mom_import_nems integer :: rc,dbrc integer :: import_cnt = 0 @@ -333,11 +334,6 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & file=__FILE__)) & return ! bail out call State_getFldPtr(importState,"Foxx_evap" , dataPtr_evap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Fioi_salt" , dataPtr_osalt, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -394,36 +390,40 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & end if if (do_import) then - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + grid%jsc - isc - - ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) - ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) - ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) - ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) - ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1) - ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) - ice_ocean_boundary%salt_flux(i,j) = dataPtr_iosalt(i1,j1) - ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) - !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) - !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) - - !ice_ocean_boundary%u_flux(i,j) = & - ! GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) - !ice_ocean_boundary%v_flux(i,j) = & - ! GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) - enddo - enddo + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + + ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) + ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) + ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) + ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) + ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) + ice_ocean_boundary%salt_flux(i,j) = dataPtr_iosalt(i1,j1) + ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) + !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) + !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) + enddo + enddo + + ! do j = jsc, jec + ! jg = j + grid%jsc - jsc + ! do i = isc, iec + ! ig = i + grid%jsc - isc + ! ice_ocean_boundary%u_flux(i,j) = & + ! GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) + ! ice_ocean_boundary%v_flux(i,j) = & + ! GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) + ! end do + ! end do end if ! debug output @@ -471,6 +471,189 @@ end subroutine mom_import !----------------------------------------------------------------------------- + subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, rc) + + type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid + type(ESMF_State) , intent(inout) :: importState !< incoming data + type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing + integer , intent(inout) :: rc + + ! Local Variables + integer :: i, j, i1, j1, ig, jg ! Grid indices + integer :: isc, iec, jsc, jec ! Grid indices + integer :: i0, j0, is, js, ie, je + integer :: lbnd1, lbnd2 + integer :: ubnd1, ubnd2 + real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_salt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwflux(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_runoff(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_calving(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_runoff_hflx(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_calving_hflx(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mi(:,:) + + real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) + real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) + integer :: day, secs + type(ESMF_time) :: currTime + logical :: do_import + character(len=*), parameter :: subname = '(mom_import_nems)' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call State_getFldPtr(importState,"mean_zonal_moment_flx", dataPtr_mzmf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_merid_moment_flx", dataPtr_mmmf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_sensi_heat_flx", dataPtr_sensi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_evap_rate" , dataPtr_evap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_salt_rate" , dataPtr_salt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_net_sw_vis_dir_flx" , dataPtr_swvdr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_net_sw_vis_dif_flx" , dataPtr_swvdf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_prec_rate" , dataPtr_rain, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_fprec_rate" , dataPtr_snow, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_runoff_rate" , dataPtr_runoff, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_calving_rate" , dataPtr_calving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_runoff_heat_flux" , dataPtr_runoff_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_calving_heat_flux" , dataPtr_calving_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'inst_pres_height_surface', dataPtr_p,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mass_of_overlying_ice" , dataPtr_mi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr_p,1) + ubnd1 = ubound(dataPtr_p,1) + lbnd2 = lbound(dataPtr_p,2) + ubnd2 = ubound(dataPtr_p,2) + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + + allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) + allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc ! work around local vs global indexing + i1 = i - lbnd1 + isc + mzmf(i,j) = grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & + + grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) + mmmf(i,j) = grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & + - grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + enddo + enddo + dataPtr_mzmf = mzmf + dataPtr_mmmf = mmmf + deallocate(mzmf, mmmf) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + + ice_ocean_boundary%u_flux(i,j) = dataPtr_mzmf(i1,j1) + ice_ocean_boundary%v_flux(i,j) = dataPtr_mmmf(i1,j1) + ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) + ice_ocean_boundary%t_flux(i,j) = -dataPtr_sensi(i1,j1) + ice_ocean_boundary%salt_flux(i,j) = dataPtr_salt(i1,j1) + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwflux(i1,j1) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) + ice_ocean_boundary%runoff(i,j) = dataPtr_runoff(i1,j1) + ice_ocean_boundary%calving(i,j) = dataPtr_calving(i1,j1) + ice_ocean_boundary%runoff_hflx(i,j) = dataPtr_runoff_hflx(i1,j1) + ice_ocean_boundary%calving_hflx(i,j) = dataPtr_calving_hflx(i1,j1) + ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) + ice_ocean_boundary%mi(i,j) = dataPtr_mi(i1,j1) + enddo + enddo + + end subroutine mom_import_nems + + !----------------------------------------------------------------------------- + subroutine State_GetFldPtr(ST, fldname, fldptr, rc) type(ESMF_State) , intent(in) :: ST character(len=*) , intent(in) :: fldname diff --git a/config_src/nuopc_driver/ocn_comp_nuopc.F90 b/config_src/nuopc_driver/ocn_comp_nuopc.F90 new file mode 100644 index 0000000000..51b8a85c26 --- /dev/null +++ b/config_src/nuopc_driver/ocn_comp_nuopc.F90 @@ -0,0 +1,3 @@ +module ocn_comp_nuopc + use mom_cap_mod +end module ocn_comp_nuopc From 64665e07c54ba8bad08b6c1014c662cb800297b3 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 26 Aug 2018 11:22:22 -0600 Subject: [PATCH 03/77] minor fixes for generalization --- config_src/nuopc_driver/mom_cap.F90 | 22 ++++++++++----------- config_src/nuopc_driver/mom_cap_methods.F90 | 2 +- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 1ec7d0062f..0088eac6e7 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -399,8 +399,8 @@ module mom_cap_mod use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid #ifdef CESMCOUPLED use mom_cap_methods, only: mom_import, mom_export - use esmFlds, only: flds_scalar_name, flds_scalar_num - use esmFlds, only: flds_scalar_index_nx, flds_scalar_index_ny + use shr_nuopc_scalars_mod, only: flds_scalar_name, flds_scalar_num + use shr_nuopc_scalars_mod, only: flds_scalar_index_nx, flds_scalar_index_ny use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_getLogUnit, shr_file_getLogLevel use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel @@ -893,7 +893,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -905,7 +905,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -922,7 +922,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -988,7 +988,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC ! EMC fields not used @@ -998,7 +998,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Optional CESM fields currently not used ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -2260,9 +2260,9 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- + !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2579,8 +2579,8 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name - integer, intent(in) :: scalar_num + character(len=*), intent(in) :: scalar_name + integer, intent(in) :: scalar_num integer, intent(inout) :: rc ! local variables diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index a826aadae4..be9cd4e966 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -634,7 +634,7 @@ subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) ice_ocean_boundary%t_flux(i,j) = -dataPtr_sensi(i1,j1) ice_ocean_boundary%salt_flux(i,j) = dataPtr_salt(i1,j1) - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwflux(i1,j1) + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwflux(i1,j1) ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) From c37b9da80767d9ec48fc83a5ccb53ac2094e7e06 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 5 Sep 2018 14:47:51 -0600 Subject: [PATCH 04/77] remove shr logging --- config_src/nuopc_driver/mom_cap.F90 | 94 +++++++++-------------------- 1 file changed, 28 insertions(+), 66 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 0088eac6e7..9aa394bce3 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -402,9 +402,9 @@ module mom_cap_mod use shr_nuopc_scalars_mod, only: flds_scalar_name, flds_scalar_num use shr_nuopc_scalars_mod, only: flds_scalar_index_nx, flds_scalar_index_ny use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit - use shr_file_mod, only: shr_file_getLogUnit, shr_file_getLogLevel use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel use shr_nuopc_time_mod, only: shr_nuopc_time_alarmInit + use, intrinsic :: iso_fortran_env, only: output_unit #endif use ESMF ! TODO: only: ... @@ -656,6 +656,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) !! @param clock an ESMF_Clock object !! @param rc return code subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance, shr_nuopc_utils_ChkErr type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -686,8 +687,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=512) :: diro character(len=512) :: logfile character(len=64) :: cvalue - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") character(len=16) :: inst_suffix = "" ! char string associated with instance @@ -698,6 +697,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=384) :: restartname ! The restart file name (no dir) integer :: nu ! i/o unit to read pointer file #endif + character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' !-------------------------------- @@ -755,58 +755,20 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) #ifdef CESMCOUPLED ! determine instance information - call NUOPC_CompAttributeGet(gcomp, name="inst_name", value=inst_name, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_CompAttributeGet(gcomp, name="inst_index", value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) inst_index - - call ESMF_AttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent) then - call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - inst_suffix = '' - end if + call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) + inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file - if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - logunit = shr_file_getUnit() - open(logunit,file=trim(diro)//"/"//trim(logfile)) + if(is_root_pe()) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else - logunit = 6 + logunit = output_unit endif - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) - call shr_file_setLogUnit (logunit) - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1091,7 +1053,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call initialize_grid_rotation_angle(ocean_grid, PF) write(*,*) '----- MOM initialization phase Advertise completed' - +#ifdef CESMCOUPLED + call shr_file_setLogUnit (output_unit) +#endif end subroutine InitializeAdvertise !=============================================================================== @@ -1148,8 +1112,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: mpicom integer :: localPet #ifdef CESMCOUPLED - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") character(len=16) :: inst_suffix = "" ! char string associated with instance @@ -1161,7 +1123,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- rc = ESMF_SUCCESS - +#ifdef CESMCOUPLED + call shr_file_setLogUnit (logunit) +#endif !---------------------------------------------------------------------------- ! Get pointers to ocean internal state !---------------------------------------------------------------------------- @@ -1663,7 +1627,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! return ! bail out write(*,*) '----- MOM initialization phase Realize completed' - +#ifdef CESMCOUPLED + call shr_file_setLogUnit (output_unit) +#endif end subroutine InitializeRealize !=============================================================================== @@ -1794,9 +1760,6 @@ subroutine ModelAdvance(gcomp, rc) #ifdef CESMCOUPLED type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - integer :: logunit ! i/o unit for stdout integer :: nu ! i/o unit to write pointer file character(ESMF_MAXSTR) :: cvalue character(ESMF_MAXSTR) :: runid ! Run ID @@ -1821,7 +1784,9 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") - +#ifdef CESMCOUPLED + call shr_file_setLogUnit (logunit) +#endif ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & exportState=exportState, rc=rc) @@ -1906,9 +1871,6 @@ subroutine ModelAdvance(gcomp, rc) #ifdef CESMCOUPLED ! Reset shr logging to my log file - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) @@ -2062,9 +2024,7 @@ subroutine ModelAdvance(gcomp, rc) endif ! reset shr logging to my original values - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - + call shr_file_setLogUnit (output_unit) #else allocate(ofld(isc:iec,jsc:jec)) @@ -2179,7 +2139,9 @@ subroutine ModelAdvance(gcomp, rc) !write(*,*) 'MOM: --- run phase called ---' if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - +#ifdef CESMCOUPLED + call shr_file_setLogUnit (output_unit) +#endif end subroutine ModelAdvance !=============================================================================== From 9733d7d50c3a9cae498a1a15f756cc20bd5c57e0 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 12 Sep 2018 14:58:12 -0600 Subject: [PATCH 05/77] write hist at end of run --- config_src/nuopc_driver/MOM_ocean_model.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 94dd64efed..9d40dc6638 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -773,7 +773,7 @@ subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time, write_restart) if (write_restart) then call ocean_model_save_restart(Ocean_state, Time) end if - call diag_mediator_end(Time, Ocean_state%diag) + call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.true.) call MOM_end(Ocean_state%MOM_CSp) if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp) From 0b8f544aebc566fad1a0e9c53cda2510e79da633 Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Thu, 18 Oct 2018 12:46:55 -0600 Subject: [PATCH 06/77] Move in updates to MOM6 cap to unify with EMC --- config_src/nuopc_driver/MOM_ocean_model.F90 | 552 +++---- .../nuopc_driver/MOM_surface_forcing.F90 | 209 +-- config_src/nuopc_driver/mom_cap.F90 | 1340 ++++++++--------- config_src/nuopc_driver/mom_cap_methods.F90 | 6 +- config_src/nuopc_driver/mom_cap_time.F90 | 425 ++++++ 5 files changed, 1394 insertions(+), 1138 deletions(-) create mode 100644 config_src/nuopc_driver/mom_cap_time.F90 diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 9d40dc6638..17d66789b5 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -1,72 +1,66 @@ +!> Top-level module for the MOM6 ocean model in coupled mode. module MOM_ocean_model ! This file is part of MOM6. See LICENSE.md for the license. -!----------------------------------------------------------------------- -! ! This is the top level module for the MOM6 ocean model. It contains routines ! for initialization, termination and update of ocean model state. This ! particular version wraps all of the calls for MOM6 in the calls that had ! been used for MOM4. ! -! Robert Hallberg -! -! -! ! This code is a stop-gap wrapper of the MOM6 code to enable it to be called ! in the same way as MOM4. -! - -use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end -use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization -use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized -use MOM, only : get_ocean_stocks, step_offline -use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf -use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging -use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end -use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE -use MOM_domains, only : TO_ALL, Omit_Corners -use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe -use MOM_error_handler, only : callTree_enter, callTree_leave -use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type -use MOM_forcing_type, only : allocate_forcing_type -use MOM_forcing_type, only : forcing, mech_forcing -use MOM_forcing_type, only : forcing_accumulate, copy_common_forcing_fields -use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing -use MOM_forcing_type, only : set_derived_forcing_fields -use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags -use MOM_get_input, only : Get_MOM_Input, directories -use MOM_grid, only : ocean_grid_type -use MOM_io, only : close_file, file_exists, read_data, write_version_number -use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS -use MOM_restart, only : MOM_restart_CS, save_restart -use MOM_string_functions, only : uppercase -use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes -use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum -use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS -use MOM_surface_forcing, only : forcing_save_restart -use MOM_time_manager, only : time_type, get_time, set_time, operator(>) -use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) -use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) -use MOM_time_manager, only : operator(<), real_to_time_type, time_type_to_real + +use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end +use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization +use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized +use MOM, only : get_ocean_stocks, step_offline +use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf +use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end +use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE +use MOM_domains, only : TO_ALL, Omit_Corners +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : callTree_enter, callTree_leave +use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type +use MOM_forcing_type, only : allocate_forcing_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : forcing_accumulate, copy_common_forcing_fields +use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing +use MOM_forcing_type, only : set_derived_forcing_fields +use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags +use MOM_get_input, only : Get_MOM_Input, directories +use MOM_grid, only : ocean_grid_type +use MOM_io, only : close_file, file_exists, read_data, write_version_number +use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS +use MOM_restart, only : MOM_restart_CS, save_restart +use MOM_string_functions, only : uppercase +use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes +use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum +use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS +use MOM_surface_forcing, only : forcing_save_restart +use MOM_time_manager, only : time_type, get_time, set_time, operator(>) +use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) +use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) +use MOM_time_manager, only : operator(<), real_to_time_type, time_type_to_real use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init -use MOM_variables, only : surface -use MOM_verticalGrid, only : verticalGrid_type -use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS -use MOM_ice_shelf, only : ice_shelf_end, ice_shelf_save_restart -use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type -use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums -use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data -use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data -use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain -use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux -use fms_mod, only : stdout -use mpp_mod, only : mpp_chksum -use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct -use MOM_wave_interface, only : wave_parameters_CS, MOM_wave_interface_init -use MOM_wave_interface, only : MOM_wave_interface_init_lite, Update_Surface_Waves +use MOM_variables, only : surface +use MOM_verticalGrid, only : verticalGrid_type +use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS +use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart +use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type +use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums +use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data +use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain +use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain +use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux +use fms_mod, only : stdout +use mpp_mod, only : mpp_chksum +use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct +use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init +use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves #include @@ -77,7 +71,6 @@ module MOM_ocean_model implicit none ; private public ocean_model_init, ocean_model_end, update_ocean_model -public get_ocean_grid ! add by Jiande public ocean_model_save_restart, Ocean_stock_pe public ice_ocean_boundary_type public ocean_model_init_sfc, ocean_model_flux_init @@ -85,12 +78,15 @@ module MOM_ocean_model public ice_ocn_bnd_type_chksum public ocean_public_type_chksum public ocean_model_data_get +public get_ocean_grid +!> This interface extracts a named scalar field or array from the ocean surface or public type interface ocean_model_data_get module procedure ocean_model_data1D_get module procedure ocean_model_data2D_get end interface + !> This type is used for communication with other components via the FMS coupler. !! The element names and types can be changed only with great deliberation, hence !! the persistnce of things like the cutsy element name "avg_kount". @@ -98,15 +94,14 @@ module MOM_ocean_model type(domain2d) :: Domain !< The domain for the surface fields. logical :: is_ocean_pe !< .true. on processors that run the ocean model. character(len=32) :: instance_name = '' !< A name that can be used to identify - !! this instance of an ocean model, for example - !! in ensembles when writing messages. + !! this instance of an ocean model, for example + !! in ensembles when writing messages. integer, pointer, dimension(:) :: pelist => NULL() !< The list of ocean PEs. logical, pointer, dimension(:,:) :: maskmap =>NULL() !< A pointer to an array - !! indicating which logical processors are actually - !! used for the ocean code. The other logical - !! processors would be all land points and are not - !! assigned to actual processors. This need not be - !! assigned if all logical processors are used. + !! indicating which logical processors are actually used for + !! the ocean code. The other logical processors would be all + !! land points and are not assigned to actual processors. + !! This need not be assigned if all logical processors are used. integer :: stagger = -999 !< The staggering relative to the tracer points !! points of the two velocity components. Valid entries @@ -221,20 +216,17 @@ module MOM_ocean_model contains -!======================================================================= -! -! -! -! Initialize the ocean model. -! - !> ocean_model_init initializes the ocean model, including registering fields !! for restarts and reading restart files if appropriate. +!! +!! This subroutine initializes both the ocean state and the ocean surface type. +!! Because of the way that indicies and domains are handled, Ocean_sfc must have +!! been used in a previous call to initialize_ocean_type. subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, input_restart_file) type(ocean_public_type), target, & - intent(inout) :: Ocean_sfc !< A structure containing various - !! publicly visible ocean surface properties after initialization, - !! the data in this type is intent(out). + intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface properties after initialization, + !! the data in this type is intent out. type(ocean_state_type), pointer :: OS !< A structure whose internal !! contents are private to ocean_model_mod that may be used to !! contain all information about the ocean's interior state. @@ -247,14 +239,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i !! tracer fluxes, and can be used to spawn related !! internal variables in the ice model. character(len=*), optional, intent(in) :: input_restart_file !< If present, name of restart file to read - -! This subroutine initializes both the ocean state and the ocean surface type. -! Because of the way that indicies and domains are handled, Ocean_sfc must have -! been used in a previous call to initialize_ocean_type. - + ! Local variables real :: Rho0 ! The Boussinesq ocean density, in kg m-3. real :: G_Earth ! The gravitational acceleration in m s-2. - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "ocean_model_init" ! This module's name. @@ -411,17 +398,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call callTree_leave("ocean_model_init(") end subroutine ocean_model_init -! NAME="ocean_model_init" - - -!======================================================================= -! -! -! -! Update in time the ocean model fields. This code wraps the call to step_MOM -! with MOM4's call. -! -! !> update_ocean_model uses the forcing in Ice_ocean_boundary to advance the !! ocean model's state from the input value of Ocean_state (which must be for @@ -452,33 +428,32 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & logical, optional, intent(in) :: Ocn_fluxes_used !< If present, this indicates whether the !! cumulative thermodynamic fluxes from the ocean, !! like frazil, have been used and should be reset. - - ! local variables - type(time_type) :: Master_time !< This allows step_MOM to temporarily change - !! the time that is seen by internal modules. - type(time_type) :: Time1 !< The value of the ocean model's time at the - !! start of a call to step_MOM. - integer :: index_bnds(4) ! The computational domain index bounds in the ice-ocn boundary type - real :: weight !< Flux accumulation weight - real :: dt_coupling !< The coupling time step in seconds. - - integer :: nts ! The number of baroclinic dynamics time steps - ! within dt_coupling. - real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) - real :: dt_dyn ! The dynamics time step in sec. - real :: dtdia ! The diabatic time step in sec. - real :: t_elapsed_seg ! The elapsed time in this update segment, in s. + ! Local variables + type(time_type) :: Master_time ! This allows step_MOM to temporarily change + ! the time that is seen by internal modules. + type(time_type) :: Time1 ! The value of the ocean model's time at the + ! start of a call to step_MOM. + integer :: index_bnds(4) ! The computational domain index bounds in the + ! ice-ocean boundary type. + real :: weight ! Flux accumulation weight + real :: dt_coupling ! The coupling time step in seconds. + integer :: nts ! The number of baroclinic dynamics time steps + ! within dt_coupling. + real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) + real :: dt_dyn ! The dynamics time step in sec. + real :: dtdia ! The diabatic time step in sec. + real :: t_elapsed_seg ! The elapsed time in this update segment, in s. integer :: n, n_max, n_last_thermo - type(time_type) :: Time2 ! A temporary time. + type(time_type) :: Time2 ! A temporary time. logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans ! multiple dynamic timesteps. - logical :: do_dyn ! If true, step the ocean dynamics and transport. - logical :: do_thermo ! If true, step the ocean thermodynamics. - logical :: step_thermo ! If true, take a thermodynamic step. + logical :: do_dyn ! If true, step the ocean dynamics and transport. + logical :: do_thermo ! If true, step the ocean thermodynamics. + logical :: step_thermo ! If true, take a thermodynamic step. integer :: secs, days integer :: is, ie, js, je - call callTree_enter("update_ocean_model(), MOM_ocean_model.F90") + call callTree_enter("update_ocean_model(), ocean_model_MOM.F90") call get_time(Ocean_coupling_time_step, secs, days) dt_coupling = 86400.0*real(days) + real(secs) @@ -512,19 +487,24 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%grid, OS%forcing_CSp) if (OS%fluxes%fluxes_used) then - - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & + if (do_thermo) & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & OS%grid, OS%forcing_CSp, OS%sfc_state, & OS%restore_salinity, OS%restore_temp) ! Add ice shelf fluxes if (OS%use_ice_shelf) then + if (do_thermo) & call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + if (do_dyn) & + call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & + if (do_dyn) & + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + if (do_thermo) & + call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif @@ -538,34 +518,36 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Indicate that there are new unused fluxes. OS%fluxes%fluxes_used = .false. OS%fluxes%dt_buoy_accum = dt_coupling - else - OS%flux_tmp%C_p = OS%fluxes%C_p - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & + if (do_thermo) & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + if (do_thermo) & + call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + if (do_dyn) & + call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & + if (do_dyn) & + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + if (do_thermo) & + call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, dt_coupling, OS%grid, weight) ! Some of the fields that exist in both the forcing and mech_forcing types - ! are time-averages must be copied back to the forces type. + ! (e.g., ustar) are time-averages must be copied back to the forces type. call copy_back_forcing_fields(OS%fluxes, OS%forces, OS%grid) #ifdef _USE_GENERIC_TRACER call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average #endif - endif - call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%GV%Rho0) call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) @@ -673,130 +655,85 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call callTree_leave("update_ocean_model()") end subroutine update_ocean_model -! NAME="update_ocean_model" - -!======================================================================= -! -! -! -! write out restart file. -! Arguments: -! timestamp (optional, intent(in)) : A character string that represents the model time, -! used for writing restart. timestamp will prepend to -! the any restart file name as a prefix. -! +!> This subroutine writes out the ocean model restart file. subroutine ocean_model_restart(OS, timestamp, restartname) - type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the - !! internal ocean state being saved to a restart file - character(len=*), optional, intent(in) :: timestamp !< An optional timestamp string that should be - !! prepended to the file name. (Currently this is unused.) + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state being saved to a restart file + character(len=*), optional, intent(in) :: timestamp !< An optional timestamp string that should be + !! prepended to the file name. (Currently this is unused.) character(len=*), optional, intent(in) :: restartname !< Name of restart file to use - !! This option distinguishes the cesm interface from the - !! non-cesm interface + !! This option distinguishes the cesm interface from the + !! non-cesm interface if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & call MOM_error(WARNING, "End of MOM_main reached with inconsistent "//& "dynamics and advective times. Additional restart fields "//& "that have not been coded yet would be required for reproducibility.") - if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_restart "//& "was called with unused buoyancy fluxes. For conservation, the ocean "//& "restart files can only be created after the buoyancy forcing is applied.") if (present(restartname)) then - - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV, filename=restartname) - - call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & - OS%dirs%restart_output_dir) ! Is this needed? - - if (OS%use_ice_shelf) then - call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) - endif - + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + OS%restart_CSp, GV=OS%GV, filename=restartname) + call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & + OS%dirs%restart_output_dir) ! Is this needed? + if (OS%use_ice_shelf) then + call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, & + OS%dirs%restart_output_dir) + endif else - - if (BTEST(OS%Restart_control,1)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, .true., GV=OS%GV) - - call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & - OS%dirs%restart_output_dir, .true.) - - if (OS%use_ice_shelf) then - call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir, .true.) - endif - endif - - if (BTEST(OS%Restart_control,0)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV) - - call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & - OS%dirs%restart_output_dir) - if (OS%use_ice_shelf) then - call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) - endif - endif - - end if + if (BTEST(OS%Restart_control,1)) then + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + OS%restart_CSp, .true., GV=OS%GV) + call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & + OS%dirs%restart_output_dir, .true.) + if (OS%use_ice_shelf) then + call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir, .true.) + endif + endif + if (BTEST(OS%Restart_control,0)) then + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + OS%restart_CSp, GV=OS%GV) + call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & + OS%dirs%restart_output_dir) + if (OS%use_ice_shelf) then + call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) + endif + endif + endif end subroutine ocean_model_restart ! NAME="ocean_model_restart" -!======================================================================= -! -! -! -! Close down the ocean model. Terminate the model run, optionally -! saving the ocean state in a restart file and deallocating any data -! associated with the ocean. - -! Arguments: Ocean_sfc - An ocean_public_type structure that is to be -! deallocated upon termination. -! (inout) Ocean_state - A pointer to the structure containing the internal -! ocean state to be deallocated upon termination. -! (in) Time - The model time, used for writing restarts. -! (in) write_restart - Write restart file if true -! +!> ocean_model_end terminates the model run, saving the ocean state in a restart +!! and deallocating any data associated with the ocean. subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time, write_restart) - type(ocean_public_type), intent(inout) :: Ocean_sfc !< An ocean_public_type structure that is - !! to be deallocated upon termination. - type(ocean_state_type), pointer :: Ocean_state !< A pointer to the structure containing - !! the internal ocean state to be deallocated - !! upon termination. - type(time_type), intent(in) :: Time !< The model time, used for writing restarts. + type(ocean_public_type), intent(inout) :: Ocean_sfc !< An ocean_public_type structure that is + !! to be deallocated upon termination. + type(ocean_state_type), pointer :: Ocean_state !< A pointer to the structure containing + !! the internal ocean state to be deallocated + !! upon termination. + type(time_type), intent(in) :: Time !< The model time, used for writing restarts. logical, intent(in) :: write_restart !< true => write restart file - if (write_restart) then - call ocean_model_save_restart(Ocean_state, Time) - end if + call ocean_model_save_restart(Ocean_state, Time) call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.true.) call MOM_end(Ocean_state%MOM_CSp) if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp) - end subroutine ocean_model_end -! NAME="ocean_model_end" -!======================================================================= !> ocean_model_save_restart causes restart files associated with the ocean to be !! written out. subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) - type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the - !! internal ocean state (in). - type(time_type), intent(in) :: Time !< The model time at this call, needed for mpp_write calls. - character(len=*), optional, intent(in) :: directory !< An optional directory into which to - !! write these restart files. + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (in). + type(time_type), intent(in) :: Time !< The model time at this call, needed for mpp_write calls. + character(len=*), optional, intent(in) :: directory !< An optional directory into which to + !! write these restart files. character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a time-stamp) - !! to append to the restart file names. -! Arguments: Ocean_state - A structure containing the internal ocean state (in). -! (in) Time - The model time at this call. This is needed for mpp_write calls. -! (in, opt) directory - An optional directory into which to write these restart files. -! (in, opt) filename_suffix - An optional suffix (e.g., a time-stamp) to append -! to the restart file names. - + !! to append to the restart file names. ! Note: This is a new routine - it will need to exist for the new incremental ! checkpointing. It will also be called by ocean_model_end, giving the same ! restart behavior as now in FMS. @@ -806,16 +743,12 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) call MOM_error(WARNING, "ocean_model_save_restart called with inconsistent "//& "dynamics and advective times. Additional restart fields "//& "that have not been coded yet would be required for reproducibility.") - if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_save_restart "//& "was called with unused buoyancy fluxes. For conservation, the ocean "//& "restart files can only be created after the buoyancy forcing is applied.") - if (present(directory)) then - restart_dir = directory - else - restart_dir = OS%dirs%restart_output_dir - endif + if (present(directory)) then ; restart_dir = directory + else ; restart_dir = OS%dirs%restart_output_dir ; endif call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV) @@ -827,15 +760,17 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) end subroutine ocean_model_save_restart -!======================================================================= - +!> Initialize the public ocean type subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, & gas_fields_ocn) - type(domain2D), intent(in) :: input_domain - type(ocean_public_type), intent(inout) :: Ocean_sfc - type(diag_ctrl), intent(in) :: diag + type(domain2D), intent(in) :: input_domain !< The ocean model domain description + type(ocean_public_type), intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface properties after initialization, whose + !! elements are allocated here. + type(diag_ctrl), intent(in) :: diag !< A structure that regulates diagnsotic output logical, dimension(:,:), & - optional, intent(in) :: maskmap + optional, intent(in) :: maskmap !< A mask indicating which virtual processors + !! are actually in use. If missing, all are used. type(coupler_1d_bc_type), & optional, intent(in) :: gas_fields_ocn !< If present, this type describes the !! ocean and surface-ice fields that will participate @@ -850,9 +785,9 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, call mpp_get_layout(input_domain,layout) call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz) if (PRESENT(maskmap)) then - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) else - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) endif call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec) @@ -880,22 +815,23 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, end subroutine initialize_ocean_public_type -!======================================================================= -! This subroutine translates the coupler's ocean_data_type into MOM's -! surface state variable. This may eventually be folded into the MOM -! code that calculates the surface state in the first place. -! Note the offset in the arrays because the ocean_data_type has no -! halo points in its arrays and always uses absolute indicies. -subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, & - patm, press_to_z) - type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. +!> This subroutine translates the coupler's ocean_data_type into MOM's +!! surface state variable. This may eventually be folded into the MOM +!! code that calculates the surface state in the first place. +!! Note the offset in the arrays because the ocean_data_type has no +!! halo points in its arrays and always uses absolute indicies. +subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. type(ocean_public_type), & - target, intent(inout) :: Ocean_sfc - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, optional, intent(in) :: patm(:,:) - real, optional, intent(in) :: press_to_z - + target, intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface fields, whose elements + !! have their data set here. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface, in Pa. + real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and + !! ocean depth in m, usually 1/(rho_0*g), in m Pa-1. + ! Local variables real :: IgR0 character(len=48) :: val_str integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd @@ -955,13 +891,17 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, & if (Ocean_sfc%stagger == AGRID) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%u_surf(i,j) = G%mask2dT(i+i0,j+j0) * 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I-1+i0,j+j0)) - Ocean_sfc%v_surf(i,j) = G%mask2dT(i+i0,j+j0) * 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0,J-1+j0)) + Ocean_sfc%u_surf(i,j) = G%mask2dT(i+i0,j+j0) * & + 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I-1+i0,j+j0)) + Ocean_sfc%v_surf(i,j) = G%mask2dT(i+i0,j+j0) * & + 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0,J-1+j0)) enddo ; enddo elseif (Ocean_sfc%stagger == BGRID_NE) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%u_surf(i,j) = G%mask2dBu(I+i0,J+j0) * 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I+i0,j+j0+1)) - Ocean_sfc%v_surf(i,j) = G%mask2dBu(I+i0,J+j0) * 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0+1,J+j0)) + Ocean_sfc%u_surf(i,j) = G%mask2dBu(I+i0,J+j0) * & + 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I+i0,j+j0+1)) + Ocean_sfc%v_surf(i,j) = G%mask2dBu(I+i0,J+j0) * & + 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0+1,J+j0)) enddo ; enddo elseif (Ocean_sfc%stagger == CGRID_NE) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd @@ -984,20 +924,15 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, & end subroutine convert_state_to_ocean_type -!======================================================================= -! -! -! -! This subroutine extracts the surface properties from the ocean's internal -! state and stores them in the ocean type returned to the calling ice model. -! It has to be separate from the ocean_initialization call because the coupler -! module allocates the space for some of these variables. -! - +!> This subroutine extracts the surface properties from the ocean's internal +!! state and stores them in the ocean type returned to the calling ice model. +!! It has to be separate from the ocean_initialization call because the coupler +!! module allocates the space for some of these variables. subroutine ocean_model_init_sfc(OS, Ocean_sfc) - type(ocean_state_type), pointer :: OS - type(ocean_public_type), intent(inout) :: Ocean_sfc - + type(ocean_state_type), pointer :: OS !< The structure with the complete ocean state + type(ocean_public_type), intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface properties after initialization, whose + !! elements have their data set here. integer :: is, ie, js, je is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec @@ -1009,9 +944,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) end subroutine ocean_model_init_sfc -! -!======================================================================= !> ocean_model_flux_init is used to initialize properties of the air-sea fluxes !! as determined by various run-time parameters. It can be called from !! non-ocean PEs, or PEs that have not yet been initialzed, and it can safely @@ -1035,17 +968,13 @@ subroutine ocean_model_flux_init(OS, verbosity) end subroutine ocean_model_flux_init -!======================================================================= -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! Ocean_stock_pe - returns stocks of heat, water, etc. for conservation checks.! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Ocean_stock_pe - returns the integrated stocks of heat, water, etc. for conservation checks. !! Because of the way FMS is coded, only the root PE has the integrated amount, !! while all other PEs get 0. subroutine Ocean_stock_pe(OS, index, value, time_index) use stock_constants_mod, only : ISTOCK_WATER, ISTOCK_HEAT,ISTOCK_SALT type(ocean_state_type), pointer :: OS !< A structure containing the internal ocean state. - !! The data in OS is intent(in). + !! The data in OS is intent in. integer, intent(in) :: index !< The stock index for the quantity of interest. real, intent(out) :: value !< Sum returned for the conservation quantity of interest. integer, optional, intent(in) :: time_index !< An unused optional argument, present only for @@ -1081,13 +1010,18 @@ subroutine Ocean_stock_pe(OS, index, value, time_index) end subroutine Ocean_stock_pe -subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) +!> This subroutine extracts a named 2-D field from the ocean surface or public type +subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) use MOM_constants, only : CELSIUS_KELVIN_OFFSET - type(ocean_state_type), pointer :: OS - type(ocean_public_type), intent(in) :: Ocean - character(len=*) , intent(in) :: name - real, dimension(isc:,jsc:), intent(out):: array2D - integer , intent(in) :: isc,jsc + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (intent in). + type(ocean_public_type), intent(in) :: Ocean !< A structure containing various publicly + !! visible ocean surface fields. + character(len=*) , intent(in) :: name !< The name of the field to extract + real, dimension(isc:,jsc:), intent(out):: array2D !< The values of the named field, it must + !! cover only the computational domain + integer , intent(in) :: isc !< The starting i-index of array2D + integer , intent(in) :: jsc !< The starting j-index of array2D integer :: g_isc, g_iec, g_jsc, g_jec,g_isd, g_ied, g_jsd, g_jed, i, j @@ -1105,23 +1039,23 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') - array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result ! do j=g_jsc,g_jec ; do i=g_isc,g_iec ! array2D(isc+i-g_isc,jsc+j-g_jsc) = OS%grid%mask2dT(i,j) ! enddo ; enddo case('t_surf') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_pme') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_runoff') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_calving') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('btfHeat') - array2D(isc:,jsc:) = 0 + array2D(isc:,jsc:) = 0 case('tlat') array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) case('tlon') @@ -1143,37 +1077,40 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) case('sin_rot') array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 case default - call MOM_error(FATAL,'ocean_model_data2D_get: unknown argument name='//name) + call MOM_error(FATAL,'get_ocean_grid_data2D: unknown argument name='//name) end select - end subroutine ocean_model_data2D_get -subroutine ocean_model_data1D_get(OS,Ocean, name, value) - type(ocean_state_type), pointer :: OS - type(ocean_public_type), intent(in) :: Ocean - character(len=*) , intent(in) :: name - real , intent(out):: value +!> This subroutine extracts a named scalar field from the ocean surface or public type +subroutine ocean_model_data1D_get(OS, Ocean, name, value) + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (intent in). + type(ocean_public_type), intent(in) :: Ocean !< A structure containing various publicly + !! visible ocean surface fields. + character(len=*) , intent(in) :: name !< The name of the field to extract + real , intent(out):: value !< The value of the named field if (.not.associated(OS)) return if (.not.OS%is_ocean_pe) return select case(name) case('c_p') - value = OS%C_p + value = OS%C_p case default - call MOM_error(FATAL,'ocean_model_data1D_get: unknown argument name='//name) + call MOM_error(FATAL,'get_ocean_grid_data1D: unknown argument name='//name) end select - end subroutine ocean_model_data1D_get +!> Write out FMS-format checsums on fields from the ocean surface state subroutine ocean_public_type_chksum(id, timestep, ocn) - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type(ocean_public_type), intent(in) :: ocn - integer :: n,m, outunit + character(len=*), intent(in) :: id !< An identifying string for this call + integer, intent(in) :: timestep !< The number of elapsed timesteps + type(ocean_public_type), intent(in) :: ocn !< A structure containing various publicly + !! visible ocean surface fields. + integer :: n, m, outunit outunit = stdout() @@ -1190,21 +1127,14 @@ subroutine ocean_public_type_chksum(id, timestep, ocn) end subroutine ocean_public_type_chksum -!####################################################################### -! -! -! -! Obtain the ocean grid. -! -! subroutine get_ocean_grid(OS, Gridp) + ! Obtain the ocean grid. type(ocean_state_type) :: OS - type(ocean_grid_type) , pointer :: Gridp + type(ocean_grid_type) , pointer :: Gridp Gridp => OS%grid return - end subroutine get_ocean_grid -! NAME="get_ocean_grid" end module MOM_ocean_model + diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index e601e83347..19a0ddbf86 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -45,9 +45,7 @@ module MOM_surface_forcing #include -public IOB_allocate -public convert_IOB_to_fluxes -public convert_IOB_to_forces +public convert_IOB_to_fluxes, convert_IOB_to_forces public surface_forcing_init public ice_ocn_bnd_type_chksum public forcing_save_restart @@ -63,9 +61,6 @@ module MOM_surface_forcing logical :: use_temperature ! If true, temp and saln used as state variables real :: wind_stress_multiplier !< A multiplier applied to incoming wind stress (nondim). - ! smg: remove when have A=B code reconciled - logical :: bulkmixedlayer ! If true, model based on bulk mixed layer code - real :: Rho0 ! Boussinesq reference density (kg/m^3) real :: area_surf = -1.0 ! total ocean surface area (m^2) real :: latent_heat_fusion ! latent heat of fusion (J/kg) @@ -116,7 +111,7 @@ module MOM_surface_forcing logical :: adjust_net_srestore_by_scaling ! adjust srestore w/o moving zero contour logical :: adjust_net_fresh_water_to_zero ! adjust net surface fresh-water (w/ restoring) to zero logical :: use_net_FW_adjustment_sign_bug ! use the wrong sign when adjusting net FW - logical :: adjust_net_fresh_water_by_scaling ! adjust net surface fresh-water w/o moving zero contour + logical :: adjust_net_fresh_water_by_scaling ! adjust net surface fresh-water w/o moving zero contour logical :: mask_srestore_under_ice ! If true, use an ice mask defined by frazil ! criteria for salinity restoring. real :: ice_salt_concentration ! salt concentration for sea ice (kg/kg) @@ -205,8 +200,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model - type(forcing), intent(inout) :: fluxes !< A structure containing pointers to - !! all possible mass, heat or salt flux forcing fields. + type(forcing), intent(inout) :: fluxes !< A structure containing pointers to all + !! possible mass, heat or salt flux forcing fields. !! Unused fields have NULL ptrs. integer, dimension(4), intent(in) :: index_bounds !< The i- and j- size of the arrays in IOB. type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the @@ -215,12 +210,11 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the - !! surface state of the ocean. + !! surface state of the ocean. logical, optional, intent(in) :: restore_salt !< If true, salinity is restored to a target value. logical, optional, intent(in) :: restore_temp !< If true, temperature is restored to a target value. - ! local variables real, dimension(SZI_(G),SZJ_(G)) :: & data_restore, & ! The surface value toward which to restore (g/kg or degC) SST_anom, & ! Instantaneous sea surface temperature anomalies from a target value (deg C) @@ -477,7 +471,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dir(i-i0,j-j0) if (associated(IOB%sw_flux_nir_dif)) & fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dif(i-i0,j-j0) - fluxes%sw(i,j) = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + & fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j) @@ -496,6 +489,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) enddo ; enddo endif + fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. endif ! more salt restoring logic @@ -649,6 +643,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) call safe_alloc_ptr(forces%rigidity_ice_v,isd,ied,JsdB,JedB) endif + forces%accumulate_rigidity = .true. ! Multiple components may contribute to rigidity. if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 @@ -665,7 +660,13 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) forces%p_surf(i,j) = forces%p_surf_full(i,j) enddo ; enddo endif + else + do j=js,je ; do i=is,ie + forces%p_surf_full(i,j) = 0.0 + forces%p_surf(i,j) = 0.0 + enddo ; enddo endif + forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. wind_stagger = CS%wind_stagger if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & @@ -843,58 +844,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) call cpu_clock_end(id_clock_forcing) end subroutine convert_IOB_to_forces -subroutine IOB_allocate(IOB, isc, iec, jsc, jec) - - type(ice_ocean_boundary_type), intent(inout) :: IOB !< An ice-ocean boundary type with fluxes to drive - integer, intent(in) :: isc, iec, jsc, jec !< The ocean's local grid size - - allocate ( IOB% u_flux (isc:iec,jsc:jec), & - IOB% v_flux (isc:iec,jsc:jec), & - IOB% t_flux (isc:iec,jsc:jec), & - IOB% q_flux (isc:iec,jsc:jec), & - IOB% salt_flux (isc:iec,jsc:jec), & - IOB% lw_flux (isc:iec,jsc:jec), & - IOB% sw_flux_vis_dir (isc:iec,jsc:jec), & - IOB% sw_flux_vis_dif (isc:iec,jsc:jec), & - IOB% sw_flux_nir_dir (isc:iec,jsc:jec), & - IOB% sw_flux_nir_dif (isc:iec,jsc:jec), & - IOB% lprec (isc:iec,jsc:jec), & - IOB% fprec (isc:iec,jsc:jec), & - IOB% runoff (isc:iec,jsc:jec), & - IOB% ustar_berg (isc:iec,jsc:jec), & - IOB% area_berg (isc:iec,jsc:jec), & - IOB% mass_berg (isc:iec,jsc:jec), & - IOB% calving (isc:iec,jsc:jec), & - IOB% runoff_hflx (isc:iec,jsc:jec), & - IOB% calving_hflx (isc:iec,jsc:jec), & - IOB% mi (isc:iec,jsc:jec), & - IOB% p (isc:iec,jsc:jec)) - - IOB%u_flux = 0.0 - IOB%v_flux = 0.0 - IOB%t_flux = 0.0 - IOB%q_flux = 0.0 - IOB%salt_flux = 0.0 - IOB%lw_flux = 0.0 - IOB%sw_flux_vis_dir = 0.0 - IOB%sw_flux_vis_dif = 0.0 - IOB%sw_flux_nir_dir = 0.0 - IOB%sw_flux_nir_dif = 0.0 - IOB%lprec = 0.0 - IOB%fprec = 0.0 - IOB%runoff = 0.0 - IOB%ustar_berg = 0.0 - IOB%area_berg = 0.0 - IOB%mass_berg = 0.0 - IOB%calving = 0.0 - IOB%runoff_hflx = 0.0 - IOB%calving_hflx = 0.0 - IOB%mi = 0.0 - IOB%p = 0.0 - -end subroutine IOB_allocate - - !> Adds thermodynamic flux adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: @@ -998,23 +947,19 @@ subroutine apply_force_adjustments(G, CS, Time, forces) end subroutine apply_force_adjustments +!> Save any restart files associated with the surface forcing. subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) - type(surface_forcing_CS), pointer :: CS + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned + !! by a previous call to surface_forcing_init type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(time_type), intent(in) :: Time - character(len=*), intent(in) :: directory - logical, optional, intent(in) :: time_stamped - character(len=*), optional, intent(in) :: filename_suffix -! Arguments: CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init. -! (in) G - The ocean's grid structure. -! (in) Time - The model time at this call. This is needed for mpp_write calls. -! (in, opt) directory - An optional directory into which to write these restart files. -! (in, opt) time_stamped - If true, the restart file names include -! a unique time stamp. The default is false. -! (in, opt) filename_suffix - An optional suffix (e.g., a time-stamp) to append -! to the restart file names. + type(time_type), intent(in) :: Time !< The current model time + character(len=*), intent(in) :: directory !< The directory into which to write the + !! restart files + logical, optional, intent(in) :: time_stamped !< If true, the restart file names include + !! a unique time stamp. The default is false. + character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a time- + !! stamp) to append to the restart file names. if (.not.associated(CS)) return if (.not.associated(CS%restart_CSp)) return @@ -1022,22 +967,21 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart +!> Initialize the surface forcing, including setting parameters and allocating permanent memory. subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) - type(time_type), intent(in) :: Time + type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(surface_forcing_CS), pointer :: CS - logical, optional, intent(in) :: restore_salt, restore_temp -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! (in) restore_salt - If present and true, salinity restoring will be -! applied in this model. + type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate + !! diagnostic output + type(surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module + logical, optional, intent(in) :: restore_salt !< If present and true surface salinity + !! restoring will be applied in this model. + logical, optional, intent(in) :: restore_temp !< If present and true surface temperature + !! restoring will be applied in this model. + + ! Local variables real :: utide ! The RMS tidal velocity, in m s-1. type(directories) :: dirs logical :: new_sim, iceberg_flux_diags @@ -1129,11 +1073,6 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "limited by max_p_surf instead of the full atmospheric \n"//& "pressure.", default=.true.) -! smg: should get_param call should be removed when have A=B code reconciled. -! this param is used to distinguish how to diagnose surface heat content from water. - call get_param(param_file, mdl, "BULKMIXEDLAYER", CS%bulkmixedlayer, & - default=CS%use_temperature,do_not_log=.true.) - call get_param(param_file, mdl, "WIND_STAGGER", stagger, & "A case-insensitive character string to indicate the \n"//& "staggering of the input wind stress field. Valid \n"//& @@ -1209,7 +1148,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "The name of the surface temperature variable to read from "//& "SST_RESTORE_FILE for restoring sst.", & default="temp") -! Convert CS%Flux_const from m day-1 to m s-1. + ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 call get_param(param_file, mdl, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, & @@ -1360,13 +1299,14 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res call cpu_clock_end(id_clock_forcing) end subroutine surface_forcing_init +!> Clean up and deallocate any memory associated with this module and its children. subroutine surface_forcing_end(CS, fluxes) - type(surface_forcing_CS), pointer :: CS - type(forcing), optional, intent(inout) :: fluxes -! Arguments: CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init, it will be deallocated here. -! (inout) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by + !! a previous call to surface_forcing_init, it will + !! be deallocated here. + type(forcing), optional, intent(inout) :: fluxes !< A structure containing pointers to all + !! possible mass, heat or salt flux forcing fields. + !! If present, it will be deallocated here. if (present(fluxes)) call deallocate_forcing_type(fluxes) @@ -1377,40 +1317,43 @@ subroutine surface_forcing_end(CS, fluxes) end subroutine surface_forcing_end +!> Write out a set of messages with checksums of the fields in an ice_ocen_boundary type subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type(ice_ocean_boundary_type), intent(in) :: iobt - integer :: n,m, outunit - - outunit = stdout() - - write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep - write(outunit,100) 'iobt%u_flux ', mpp_chksum( iobt%u_flux ) - write(outunit,100) 'iobt%v_flux ', mpp_chksum( iobt%v_flux ) - write(outunit,100) 'iobt%t_flux ', mpp_chksum( iobt%t_flux ) - write(outunit,100) 'iobt%q_flux ', mpp_chksum( iobt%q_flux ) - write(outunit,100) 'iobt%salt_flux ', mpp_chksum( iobt%salt_flux ) - write(outunit,100) 'iobt%lw_flux ', mpp_chksum( iobt%lw_flux ) - write(outunit,100) 'iobt%sw_flux_vis_dir', mpp_chksum( iobt%sw_flux_vis_dir) - write(outunit,100) 'iobt%sw_flux_vis_dif', mpp_chksum( iobt%sw_flux_vis_dif) - write(outunit,100) 'iobt%sw_flux_nir_dir', mpp_chksum( iobt%sw_flux_nir_dir) - write(outunit,100) 'iobt%sw_flux_nir_dif', mpp_chksum( iobt%sw_flux_nir_dif) - write(outunit,100) 'iobt%lprec ', mpp_chksum( iobt%lprec ) - write(outunit,100) 'iobt%fprec ', mpp_chksum( iobt%fprec ) - write(outunit,100) 'iobt%runoff ', mpp_chksum( iobt%runoff ) - write(outunit,100) 'iobt%calving ', mpp_chksum( iobt%calving ) - write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p ) - if (associated(iobt%ustar_berg)) & - write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg ) - if (associated(iobt%area_berg)) & - write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg ) - if (associated(iobt%mass_berg)) & - write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg ) + character(len=*), intent(in) :: id !< An identifying string for this call + integer, intent(in) :: timestep !< The number of elapsed timesteps + type(ice_ocean_boundary_type), & + intent(in) :: iobt !< An ice-ocean boundary type with fluxes to drive the + !! ocean in a coupled model whose checksums are reported + integer :: n,m, outunit + + outunit = stdout() + + write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep + write(outunit,100) 'iobt%u_flux ', mpp_chksum( iobt%u_flux ) + write(outunit,100) 'iobt%v_flux ', mpp_chksum( iobt%v_flux ) + write(outunit,100) 'iobt%t_flux ', mpp_chksum( iobt%t_flux ) + write(outunit,100) 'iobt%q_flux ', mpp_chksum( iobt%q_flux ) + write(outunit,100) 'iobt%salt_flux ', mpp_chksum( iobt%salt_flux ) + write(outunit,100) 'iobt%lw_flux ', mpp_chksum( iobt%lw_flux ) + write(outunit,100) 'iobt%sw_flux_vis_dir', mpp_chksum( iobt%sw_flux_vis_dir) + write(outunit,100) 'iobt%sw_flux_vis_dif', mpp_chksum( iobt%sw_flux_vis_dif) + write(outunit,100) 'iobt%sw_flux_nir_dir', mpp_chksum( iobt%sw_flux_nir_dir) + write(outunit,100) 'iobt%sw_flux_nir_dif', mpp_chksum( iobt%sw_flux_nir_dif) + write(outunit,100) 'iobt%lprec ', mpp_chksum( iobt%lprec ) + write(outunit,100) 'iobt%fprec ', mpp_chksum( iobt%fprec ) + write(outunit,100) 'iobt%runoff ', mpp_chksum( iobt%runoff ) + write(outunit,100) 'iobt%calving ', mpp_chksum( iobt%calving ) + write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p ) + if (associated(iobt%ustar_berg)) & + write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg ) + if (associated(iobt%area_berg)) & + write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg ) + if (associated(iobt%mass_berg)) & + write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg ) 100 FORMAT(" CHECKSUM::",A20," = ",Z20) - call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') + call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') end subroutine ice_ocn_bnd_type_chksum diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 9aa394bce3..d638b82b94 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -363,7 +363,6 @@ !! module mom_cap_mod use constants_mod, only: constants_init - use data_override_mod, only: data_override_init, data_override use diag_manager_mod, only: diag_manager_init, diag_manager_end use field_manager_mod, only: field_manager_init, field_manager_end use fms_mod, only: fms_init, fms_end, open_namelist_file, check_nml_error @@ -387,7 +386,6 @@ module mom_cap_mod use time_manager_mod, only: date_to_string use time_manager_mod, only: fms_get_calendar_type => get_calendar_type use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here - use MOM_surface_forcing, only: IOB_allocate use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file use MOM_get_input, only: Get_MOM_Input, directories use MOM_domains, only: pass_var @@ -397,25 +395,22 @@ module mom_cap_mod use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid + use mom_cap_time, only: AlarmInit #ifdef CESMCOUPLED use mom_cap_methods, only: mom_import, mom_export - use shr_nuopc_scalars_mod, only: flds_scalar_name, flds_scalar_num - use shr_nuopc_scalars_mod, only: flds_scalar_index_nx, flds_scalar_index_ny use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel - use shr_nuopc_time_mod, only: shr_nuopc_time_alarmInit - use, intrinsic :: iso_fortran_env, only: output_unit #endif - use ESMF ! TODO: only: ... - use NUOPC ! TODO: only: ... - use NUOPC_Model, & ! TODO: only: ... + use, intrinsic :: iso_fortran_env, only: output_unit + + use ESMF + use NUOPC + use NUOPC_Model, & model_routine_SS => SetServices, & - model_label_DataInitialize => label_DataInitialize, & model_label_Advance => label_Advance, & -#ifdef CESMCOUPLED + model_label_DataInitialize => label_DataInitialize, & model_label_SetRunClock => label_SetRunClock, & -#endif model_label_Finalize => label_Finalize use time_utils_mod, only: esmf2fms_time @@ -453,20 +448,16 @@ module mom_cap_mod integer :: import_slice = 1 integer :: export_slice = 1 character(len=256) :: tmpstr - integer :: dbrc type(ESMF_Grid) :: mom_grid_i - -#ifdef CESMCOUPLED - logical :: write_diagnostics = .false. - integer :: logunit ! stdout logging unit number - character(len=32) :: runtype ! run type -#else - logical :: write_diagnostics = .true. -#endif - logical :: profile_memory = .true. - logical :: grid_attach_area = .false. - integer(ESMF_KIND_I8) :: restart_interval - logical :: sw_decomp + logical :: write_diagnostics = .false. + character(len=32) :: runtype ! run type + integer :: logunit ! stdout logging unit number + logical :: profile_memory = .true. + logical :: grid_attach_area = .false. + character(len=128) :: scalar_field_name + integer :: scalar_field_count + integer :: scalar_field_idx_grid_nx + integer :: scalar_field_idx_grid_ny character(len=*),parameter :: u_file_u = & __FILE__ @@ -504,13 +495,13 @@ subroutine SetServices(gcomp, rc) ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc) + phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeAdvertise, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc) + phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeRealize, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -534,7 +525,6 @@ subroutine SetServices(gcomp, rc) file=__FILE__)) & return ! bail out -#ifdef CESMCOUPLED call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -546,7 +536,6 @@ subroutine SetServices(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out -#endif call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & specRoutine=ocean_model_finalize, rc=rc) @@ -576,71 +565,159 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) type(ESMF_Clock) :: clock integer, intent(out) :: rc - character(len=10) :: value + logical :: isPresent, isSet + integer :: iostat + character(len=64) :: value, logmsg character(len=*),parameter :: subname='(mom_cap:InitializeP0)' rc = ESMF_SUCCESS - ! Switch to IPDv01 by filtering all other phaseMap entries + ! Switch to IPDv03 by filtering all other phaseMap entries call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & - acceptStringList=(/"IPDv01p"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! write_diagnostics=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:DumpFields = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + acceptStringList=(/"IPDv03p"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + write_diagnostics = .false. + call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") + + write(logmsg,*) write_diagnostics + call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + profile_memory = .false. + call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) profile_memory=(trim(value)=="true") + write(logmsg,*) profile_memory + call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + grid_attach_area = .false. + call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") + write(logmsg,*) grid_attach_area + call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + scalar_field_name = "" + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + scalar_field_name = trim(value) + call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif - call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="true", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - profile_memory=(trim(value)/="false") - call ESMF_LogWrite('MOM_CAP:ProfileMemory = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + scalar_field_count = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_count + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldCount not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_count + call ESMF_LogWrite('mom_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif -#ifndef CESMCOUPLED - ! Retrieve restart_interval in (seconds) - ! A restart_interval value of 0 means no restart will be written. - call ESMF_AttributeGet(gcomp, name="restart_interval", value=value, defaultValue="0", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - restart_interval = ESMF_UtilString2Int(value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + scalar_field_idx_grid_nx = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldIdxGridNX not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_idx_grid_nx + call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif - if(restart_interval < 0) then - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg="MOM_CAP: OCN attribute: restart_interval cannot be negative.", & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return + scalar_field_idx_grid_ny = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldIdxGridNY not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_idx_grid_ny + call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return endif - call ESMF_LogWrite('MOM_CAP:restart_interval = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) -#endif - call ESMF_AttributeGet(gcomp, name="GridAttachArea", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) + call NUOPC_CompAttributeAdd(gcomp, & + attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - grid_attach_area=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:GridAttachArea = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - + line=__LINE__, & + file=__FILE__)) & + return + end subroutine !=============================================================================== @@ -656,7 +733,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) !! @param clock an ESMF_Clock object !! @param rc return code subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance, shr_nuopc_utils_ChkErr type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -680,29 +756,26 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 integer :: mpi_comm_mom integer :: i,n - character(80) :: stdname, shortname -#ifdef CESMCOUPLED - integer :: nflds + character(len=256) :: stdname, shortname character(len=32) :: starttype ! model start type character(len=512) :: diro character(len=512) :: logfile - character(len=64) :: cvalue - integer :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance - ! (ie. "_0001" or "") - logical :: isPresent - character(len=384) :: restart_pointer_file ! File name for restart pointer file - character(len=384) :: restartfile ! Path/Name of restart file - character(len=384) :: restartname ! The restart file name (no dir) - integer :: nu ! i/o unit to read pointer file -#endif - - character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' + character(ESMF_MAXSTR) :: cvalue + logical :: isPresent, isPresentDiro, isPresentLogfile, isSet + logical :: existflag + integer :: userRc + character(len=512) :: restartfile ! Path/Name of restart file + character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' !-------------------------------- rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' enter', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer allocate(ocean_public) @@ -752,92 +825,170 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) DT = set_time (DT_OCEAN, 0) Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) -#ifdef CESMCOUPLED - - ! determine instance information - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - inst_name = "OCN"//trim(inst_suffix) + ! rsd need to figure out how to get this without share code + !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) + !inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file - if(is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + if (is_root_pe()) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + isPresent=isPresentDiro, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, & + isPresent=isPresentLogfile, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresentDiro .and. isPresentLogfile) then + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + else + logunit = output_unit + endif else logunit = output_unit endif - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) + starttype = "" + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) starttype + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(cvalue,*) starttype + else + call ESMF_LogWrite('mom_cap:start_type unset - using input.nml for restart option', & + ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + runtype = "" if (trim(starttype) == trim('startup')) then - runtype = "initial" + runtype = "initial" else if (trim(starttype) == trim('continue') ) then - runtype = "continue" + runtype = "continue" else if (trim(starttype) == trim('branch')) then - runtype = "continue" - else - call ESMF_LogWrite(subname//' ERROR: unknown starttype '//trim(starttype), ESMF_LOGMSG_ERROR, rc=dbrc) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + runtype = "continue" + else if (len_trim(starttype) > 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": unknown starttype - "//trim(starttype), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + if (len_trim(runtype) > 0) then + call ESMF_LogWrite('mom_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + restartfile = "" if (runtype == "initial") then - - ! startup (new run) - 'n' is needed below since we don't specify input_filename in input.nml - ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file = 'n') - - - else ! hybrid or branch or continuos runs - - ! read name of restart file in the pointer file - nu = shr_file_getUnit() - restart_pointer_file = 'rpointer.ocn' - if (is_root_pe()) then - write(logunit,*) 'Reading ocn pointer file: ',restart_pointer_file - end if - open(nu, file=restart_pointer_file, form='formatted', status='unknown') - read(nu,'(a)') restartfile - close(nu) - - ! initialize from restart file - if (is_root_pe()) then - write(logunit,*) 'Reading restart file: ',trim(restartfile) - end if - call shr_file_freeUnit(nu) - - ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file=trim(restartfile)) + ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml + restartfile = "n" + else if (runtype == "continue") then ! hybrid or branch or continuos runs + + ! optionally call into system-specific implementation to get restart file name + call ESMF_MethodExecute(gcomp, label="GetRestartFileToRead", & + existflag=existflag, userRc=userRc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (existflag) then + call ESMF_LogWrite('mom_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & + value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + restartfile = trim(cvalue) + call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + else + call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + ESMF_LOGMSG_WARNING, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif end if - call ocean_model_init_sfc(ocean_state, ocean_public) - -#else - + ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time) - -#endif + if (len_trim(restartfile) > 0) then + call ocean_model_init(ocean_public, ocean_state, Time, Time, & + input_restart_file=trim(restartfile)) + else + call ocean_model_init(ocean_public, ocean_state, Time, Time) + endif - !tcx tcraig This results in errors in CESM with help from Alper - ! FATAL error "MPP_OPEN: error in OPEN for data_table" - ! The subroutine data_override_init shouldn't be called because ALLOW_FLUX_ADJUSTMENTS is set to FALSE - !tcx call data_override_init(ocean_domain_in = ocean_public%domain) + call ocean_model_init_sfc(ocean_state, ocean_public) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - call IOB_allocate(ice_ocean_boundary, isc, iec, jsc, jec) - - call external_coupler_sbc_init(ocean_public%domain, dt_cpld, Run_len) + allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% mi (isc:iec,jsc:jec), & + Ice_ocean_boundary% p (isc:iec,jsc:jec)) + + Ice_ocean_boundary%u_flux = 0.0 + Ice_ocean_boundary%v_flux = 0.0 + Ice_ocean_boundary%t_flux = 0.0 + Ice_ocean_boundary%q_flux = 0.0 + Ice_ocean_boundary%salt_flux = 0.0 + Ice_ocean_boundary%lw_flux = 0.0 + Ice_ocean_boundary%sw_flux_vis_dir = 0.0 + Ice_ocean_boundary%sw_flux_vis_dif = 0.0 + Ice_ocean_boundary%sw_flux_nir_dir = 0.0 + Ice_ocean_boundary%sw_flux_nir_dif = 0.0 + Ice_ocean_boundary%lprec = 0.0 + Ice_ocean_boundary%fprec = 0.0 + Ice_ocean_boundary%runoff = 0.0 + Ice_ocean_boundary%calving = 0.0 + Ice_ocean_boundary%runoff_hflx = 0.0 + Ice_ocean_boundary%calving_hflx = 0.0 + Ice_ocean_boundary%mi = 0.0 + Ice_ocean_boundary%p = 0.0 ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) @@ -849,13 +1000,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) #ifdef CESMCOUPLED !--------- import fields ------------- - call fld_list_add(fldsToOcn_num, fldsToOcn, trim(flds_scalar_name), "will_provide") ! not in EMC + if (len_trim(scalar_field_name) > 0) then + call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC + endif call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -867,7 +1020,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -884,7 +1037,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -908,11 +1061,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! read(cvalue,*) flds_co2a - ! call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! read(cvalue,*) flds_co2c - ! call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) ! if (flds_co2a .or. flds_co2c) then ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2prog" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2diag" , "will provide") @@ -920,11 +1073,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call NUOPC_CompAttributeGet(gcomp, name='ice_ncat', value=cvalue, rc=rc) ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! read(cvalue,*) ice_ncat - ! call ESMF_LogWrite('ice_ncat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite('ice_ncat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) ! call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! read(cvalue,*) flds_i2o_per_cat - ! call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) ! if (flds_i2o_per_cat) then ! do num = 1, ice_ncat ! name = 'Si_ifrac_' // cnum @@ -942,7 +1095,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! end do !--------- export fields ------------- - call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(flds_scalar_name), "will_provide") ! not in EMC + if (len_trim(scalar_field_name) > 0) then + call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") ! not in EMC + endif call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf @@ -950,7 +1105,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC ! EMC fields not used @@ -960,7 +1115,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Optional CESM fields currently not used ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -1043,19 +1198,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) return ! bail out enddo - ! When running mom6 solo, the rotation angles are not computed internally - ! in MOM6. We need to calculate cos and sin of rotational angle for MOM6; - ! the values are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot - ! The rotation angles are retrieved during run time to rotate incoming - ! and outgoing vectors - ! call calculate_rot_angle(ocean_state, ocean_public) - ! tcraig, this is handled fine internally and if not, then later call this - ! call initialize_grid_rotation_angle(ocean_grid, PF) - - write(*,*) '----- MOM initialization phase Advertise completed' -#ifdef CESMCOUPLED - call shr_file_setLogUnit (output_unit) -#endif end subroutine InitializeAdvertise !=============================================================================== @@ -1111,21 +1253,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_Field) :: field_t_surf integer :: mpicom integer :: localPet -#ifdef CESMCOUPLED - integer :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance - ! (ie. "_0001" or "") - character(len=64) :: cvalue - logical :: isPresent -#endif - character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' + character(len=*), parameter :: subname='(mom_cap:InitializeRealize)' !-------------------------------- rc = ESMF_SUCCESS + #ifdef CESMCOUPLED call shr_file_setLogUnit (logunit) #endif + !---------------------------------------------------------------------------- ! Get pointers to ocean internal state !---------------------------------------------------------------------------- @@ -1162,8 +1298,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call mpp_get_global_domain(ocean_public%domain, xsize=nxg, ysize=nyg) write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- @@ -1171,16 +1311,20 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ntiles=mpp_get_ntile_count(ocean_public%domain) ! this is tiles on this pe if (ntiles /= 1) then rc = ESMF_FAILURE - call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=dbrc) + call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return endif ntiles=mpp_get_domain_npes(ocean_public%domain) write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + !--------------------------------- ! get start and end indices of each tile and their PET !--------------------------------- @@ -1189,11 +1333,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call mpp_get_compute_domains(ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) call mpp_get_pelist(ocean_public%domain, pe) if (debug > 0) then - do n = 1,ntiles - write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - enddo + do n = 1,ntiles + write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + enddo end if + !--------------------------------- ! create delayout and distgrid @@ -1211,11 +1360,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) deBlockList(2,2,n) = ye(n) petMap(n) = pe(n) ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side enddo @@ -1225,6 +1374,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out + ! rsd this assumes tripole grid, but sometimes in CESM a bipole + ! grid is used -- need to introduce conditional logic here + allocate(connectionList(2)) ! bipolar boundary condition at top row: nyg @@ -1269,17 +1421,25 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out allocate(indexList(cnt)) write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& indexList(1),indexList(cnt),minval(indexList), maxval(indexList) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return deallocate(IndexList) - + !--------------------------------- ! create grid !--------------------------------- @@ -1389,20 +1549,19 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ubnd4 = ubound(dataPtr_xcor,2) write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": fld and grid do not have the same size.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": fld and grid do not have the same size.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif allocate(ofld(isc:iec,jsc:jec)) @@ -1410,10 +1569,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1425,10 +1584,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if(grid_attach_area) then call ocean_model_data_get(ocean_state, ocean_public, 'area', ofld, isc, jsc) write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1440,10 +1599,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ocean_model_data_get(ocean_state, ocean_public, 'tlon', ofld, isc, jsc) write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1455,10 +1614,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ocean_model_data_get(ocean_state, ocean_public, 'tlat', ofld, isc, jsc) write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1469,10 +1628,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ocean_model_data_get(ocean_state, ocean_public, 'geoLonBu', ofld, isc, jsc) write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd4, ubnd4 do i = lbnd3, ubnd3 j1 = j - lbnd4 + jsc - 1 @@ -1492,17 +1651,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) endif dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) enddo enddo ! MOM6 runs on C-Grid. call ocean_model_data_get(ocean_state, ocean_public, 'geoLatBu', ofld, isc, jsc) write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd4, ubnd4 do i = lbnd3, ubnd3 j1 = j - lbnd4 + jsc - 1 @@ -1519,29 +1678,29 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out endif ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) enddo enddo write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if(grid_attach_area) then write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) endif write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) deallocate(gfld) @@ -1564,21 +1723,21 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out -#ifdef CESMCOUPLED - call State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, localPet, & - flds_scalar_name, flds_scalar_num, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, localPet, & - flds_scalar_name, flds_scalar_num, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#endif + if (len_trim(scalar_field_name) > 0) then + call State_SetScalar(dble(nxg),scalar_field_idx_grid_nx, exportState, localPet, & + scalar_field_name, scalar_field_count, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & + scalar_field_name, scalar_field_count, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1618,18 +1777,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) deallocate(ofld) endif -! tcraig, turn this off for now, have issues with overwriting failures -! call NUOPC_Write(exportState, fileNamePrefix='init_field_ocn_export_', & -! timeslice=1, relaxedFlag=.true., rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out - - write(*,*) '----- MOM initialization phase Realize completed' -#ifdef CESMCOUPLED - call shr_file_setLogUnit (output_unit) -#endif + !call NUOPC_Write(exportState, fileNamePrefix='post_realize_field_ocn_export_', & + ! timeslice=1, relaxedFlag=.true., rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + end subroutine InitializeRealize !=============================================================================== @@ -1670,11 +1824,13 @@ subroutine DataInitialize(gcomp, rc) ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call get_ocean_grid(ocean_state, ocean_grid) +#ifdef CESMCOUPLED call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out +#endif call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1737,6 +1893,8 @@ subroutine ModelAdvance(gcomp, rc) integer, intent(out) :: rc ! local variables + integer :: userRc + logical :: existflag, isPresent, isSet type(ESMF_Clock) :: clock type(ESMF_Alarm) :: alarm type(ESMF_State) :: importState, exportState @@ -1757,15 +1915,10 @@ subroutine ModelAdvance(gcomp, rc) integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 integer :: i,j,i1,j1 integer :: nc -#ifdef CESMCOUPLED type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute - integer :: nu ! i/o unit to write pointer file - character(ESMF_MAXSTR) :: cvalue - character(ESMF_MAXSTR) :: runid ! Run ID - character(len=384) :: restartname ! restart file name (no dir) - character(len=384) :: restart_pointer_file ! file name for restart pointer file -#else + character(ESMF_MAXSTR) :: restartname, cvalue +#ifndef CESMCOUPLED real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) @@ -1784,9 +1937,11 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") + #ifdef CESMCOUPLED call shr_file_setLogUnit (logunit) #endif + ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & exportState=exportState, rc=rc) @@ -1849,10 +2004,6 @@ subroutine ModelAdvance(gcomp, rc) Time_step_coupled = esmf2fms_time(timeStep) dt_cpld = dth*3600+dtm*60+dts - call ice_ocn_bnd_from_data(Ice_ocean_boundary, Time, Time_step_coupled) - - call external_coupler_sbc_before(Ice_ocean_boundary, ocean_public, nc, dt_cpld ) - if(write_diagnostics) then call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & timeslice=import_slice, relaxedFlag=.true., rc=rc) @@ -1870,7 +2021,6 @@ subroutine ModelAdvance(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) #ifdef CESMCOUPLED - ! Reset shr logging to my log file call shr_file_setLogUnit (logunit) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) @@ -1914,16 +2064,24 @@ subroutine ModelAdvance(gcomp, rc) dataPtr_evap = - dataPtr_evap dataPtr_sensi = - dataPtr_sensi + print *, 'lbnd1,ubnd1,lbnd2,ubnd2', lbnd1, ubnd1, lbnd2, ubnd2 + allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc +! j1 = j - lbnd2 + jsc ! work around local vs global indexing +! i1 = i - lbnd1 + isc + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 +! mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & +! + ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) +! mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & +! - ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) + - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - - ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -1931,22 +2089,22 @@ subroutine ModelAdvance(gcomp, rc) deallocate(mzmf, mmmf) !Optionally write restart files when currTime-startTime is integer multiples of restart_interval - if (restart_interval > 0 ) then - time_elapsed = currTime - startTime - call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - n_interval = time_elapsed_sec / restart_interval - if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then - time_restart_current = esmf2fms_time(currTime) - timestamp = date_to_string(time_restart_current) - call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=dbrc) - write(*,*) 'calling ocean_model_restart' - call ocean_model_restart(ocean_state, timestamp) - endif - endif +! if (restart_interval > 0 ) then +! time_elapsed = currTime - startTime +! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! n_interval = time_elapsed_sec / restart_interval +! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then +! time_restart_current = esmf2fms_time(currTime) +! timestamp = date_to_string(time_restart_current) +! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) +! write(*,*) 'calling ocean_model_restart' +! call ocean_model_restart(ocean_state, timestamp) +! endif +! endif #endif ! Update MOM6 @@ -1956,75 +2114,15 @@ subroutine ModelAdvance(gcomp, rc) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") #ifdef CESMCOUPLED - call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - ! If restart alarm is ringing - write restart file - call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! determine restart filename - ! Need to use next time step since clock is not advanced until the end of the time interval - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) runid - - call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, s=seconds, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') trim(runid), year, month, day, seconds - - ! write name of restart file in the rpointer file - nu = shr_file_getUnit() - if (is_root_pe()) then - restart_pointer_file = 'rpointer.ocn' - open(nu, file=restart_pointer_file, form='formatted', status='unknown') - write(nu,'(a)') trim(restartname) //'.nc' - close(nu) - write(logunit,*) 'ocn restart pointer file written: ',trim(restartname) - endif - call shr_file_freeUnit(nu) - - ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname) - - if (is_root_pe()) then - write(logunit,*) subname//' writing restart file ',trim(restartname) - end if - endif - ! reset shr logging to my original values call shr_file_setLogUnit (output_unit) + #else allocate(ofld(isc:iec,jsc:jec)) @@ -2065,83 +2163,116 @@ subroutine ModelAdvance(gcomp, rc) ocm = dataPtr_ocm do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - - ocean_grid%sin_rot(i1,j1)*ocm(i,j) + + ocean_grid%sin_rot(i1,j1)*ocm(i,j) dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - + ocean_grid%sin_rot(i1,j1)*ocz(i,j) - enddo - enddo - deallocate(ocz, ocm) - - !call ESMF_LogWrite("B4 writing diags", dataPtr_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc)) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - deallocate(ofld) - - ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) - allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) - - call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - - ocz = dataPtr_ocz - ocm = dataPtr_ocm - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc - dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - - ocean_grid%sin_rot(i1,j1)*ocm(i,j) - dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - + ocean_grid%sin_rot(i1,j1)*ocz(i,j) + - ocean_grid%sin_rot(i1,j1)*ocz(i,j) + ! multiply by mask to zero out non-ocean points + dataPtr_ocz(i,j) = dataPtr_ocz(i,j) * dataPtr_mask(i,j) + dataPtr_ocm(i,j) = dataPtr_ocm(i,j) * dataPtr_mask(i,j) enddo enddo deallocate(ocz, ocm) #endif - + + ! If restart alarm is ringing - write restart file + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_AlarmRingerOff(alarm, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! call into system specific method to get desired restart filename + restartname = "" + call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & + existflag=existflag, userRc=userRc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (existflag) then + call ESMF_LogWrite("mom_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToWrite', & + isPresent=isPresent, isSet=isSet, value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + restartname = trim(cvalue) + call ESMF_LogWrite("mom_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + endif + + if (len_trim(restartname) == 0) then + ! none provided, so use a default restart filename + call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, & + h=hour, m=minute, s=seconds, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + "ocn", year, month, day, hour, minute, seconds + call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + ! write restart file(s) + call ocean_model_restart(ocean_state, restartname=restartname) + + if (is_root_pe()) then + write(logunit,*) subname//' writing restart file ',trim(restartname) + end if + endif + if (write_diagnostics) then - call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & - timeslice=export_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - export_slice = export_slice + 1 + call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & + timeslice=export_slice, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + export_slice = export_slice + 1 endif - - !call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) - call external_coupler_sbc_after(Ice_ocean_boundary, ocean_public, nc, dt_cpld ) - !call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) - !write(*,*) 'MOM: --- run phase called ---' - + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") -#ifdef CESMCOUPLED - call shr_file_setLogUnit (output_unit) -#endif + end subroutine ModelAdvance !=============================================================================== @@ -2161,6 +2292,7 @@ subroutine ModelSetRunClock(gcomp, rc) integer :: restart_n ! Number until restart interval integer :: restart_ymd ! Restart date (YYYYMMDD) type(ESMF_ALARM) :: restart_alarm + logical :: isPresent, isSet logical :: first_time = .true. character(len=*),parameter :: subname='mom_cap:(ModelSetRunClock) ' !-------------------------------- @@ -2203,9 +2335,9 @@ subroutine ModelSetRunClock(gcomp, rc) file=__FILE__)) & return ! bail out - call ESMF_LogWrite(subname//" ERROR in time consistency; "//trim(dtimestring)//" ne "//trim(mtimestring), & - ESMF_LOGMSG_ERROR, rc=dbrc) - rc = ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & + msg=subname//": ERROR in time consistency: "//trim(dtimestring)//" != "//trim(mtimestring), & + line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -2222,30 +2354,44 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- - call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !-------------------------------- - call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) restart_n + ! defaults + restart_n = 0 + restart_ymd = 0 - call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="restart_option", isPresent=isPresent, & + isSet=isSet, value=restart_option, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - read(cvalue,*) restart_ymd - - call shr_nuopc_time_alarmInit(mclock, & + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) restart_n + endif + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) restart_ymd + endif + else + restart_option = "none" + endif + + call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & opt_n = restart_n, & @@ -2256,13 +2402,21 @@ subroutine ModelSetRunClock(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out first_time = .false. + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if !-------------------------------- @@ -2283,6 +2437,7 @@ subroutine ModelSetRunClock(gcomp, rc) end subroutine ModelSetRunClock + !=============================================================================== !> Called by NUOPC at the end of the run to clean up. @@ -2331,14 +2486,14 @@ subroutine ocean_model_finalize(gcomp, rc) Time = esmf2fms_time(currTime) #ifdef CESMCOUPLED - call ocean_model_end (ocean_public, ocean_State, Time, write_restart=.false.) + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) #else - call ocean_model_end (ocean_public, ocean_State, Time, write_restart=.true.) + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) #endif - call field_manager_end + call field_manager_end() - call fms_io_exit - call fms_end + call fms_io_exit() + call fms_end() write(*,*) 'MOM: --- completed ---' @@ -2346,165 +2501,6 @@ end subroutine ocean_model_finalize !==================================================================== - ! get forcing data from data_overide - subroutine ice_ocn_bnd_from_data(x, Time, Time_step_coupled) - - type (ice_ocean_boundary_type) :: x - type(Time_type), intent(in) :: Time, Time_step_coupled - - type(Time_type) :: Time_next - character(len=*),parameter :: subname='(mom_cap:ice_ocn_bnd_from_data)' - - Time_next = Time + Time_step_coupled - - !call data_override('OCN', 't_flux', x%t_flux , Time_next) - !call data_override('OCN', 'u_flux', x%u_flux , Time_next) - !call data_override('OCN', 'v_flux', x%v_flux , Time_next) - !call data_override('OCN', 'q_flux', x%q_flux , Time_next) - !call data_override('OCN', 'salt_flux', x%salt_flux , Time_next) - !call data_override('OCN', 'lw_flux', x%lw_flux , Time_next) - !call data_override('OCN', 'sw_flux_vis_dir', x%sw_flux_vis_dir, Time_next) - !call data_override('OCN', 'sw_flux_vis_dif', x%sw_flux_vis_dif, Time_next) - !call data_override('OCN', 'sw_flux_nir_dir', x%sw_flux_nir_dir, Time_next) - !call data_override('OCN', 'sw_flux_nir_dif', x%sw_flux_nir_dif, Time_next) - !call data_override('OCN', 'lprec', x%lprec , Time_next) - !call data_override('OCN', 'fprec', x%fprec , Time_next) - !call data_override('OCN', 'runoff', x%runoff , Time_next) - !call data_override('OCN', 'calving', x%calving , Time_next) - !call data_override('OCN', 'p', x%p , Time_next) - - end subroutine ice_ocn_bnd_from_data - -!----------------------------------------------------------------------------------------- -! -! Subroutines for enabling coupling to external programs through a third party coupler -! such as OASIS/PRISM. -! If no external coupler then these will mostly be dummy routines. -! These routines can also serve as spots to call other user defined routines -!----------------------------------------------------------------------------------------- - -!----------------------------------------------------------------------------------------- - -! Dummy subroutines. - - subroutine external_coupler_mpi_init(mom_local_communicator, external_initialization) - implicit none - integer, intent(out) :: mom_local_communicator - logical, intent(out) :: external_initialization - external_initialization = .false. - mom_local_communicator = -100 ! Is there mpp_undefined parameter corresponding to MPI_UNDEFINED? - ! probably wouldn't need logical flag. - return - end subroutine external_coupler_mpi_init - -!----------------------------------------------------------------------------------------- - subroutine external_coupler_sbc_init(Dom, dt_cpld, Run_len) - implicit none - type(domain2d) :: Dom - integer :: dt_cpld - type(time_type) :: Run_len - return - end subroutine external_coupler_sbc_init - - subroutine external_coupler_sbc_before(Ice_ocean_boundary, ocean_public, nsteps, dt_cpld ) - implicit none - type (ice_ocean_boundary_type), intent(INOUT) :: Ice_ocean_boundary - type (ocean_public_type) , intent(INOUT) :: ocean_public - integer , intent(IN) :: nsteps, dt_cpld - return - end subroutine external_coupler_sbc_before - - - subroutine external_coupler_sbc_after(Ice_ocean_boundary, ocean_public, nsteps, dt_cpld ) - type (ice_ocean_boundary_type) :: Ice_ocean_boundary - type (ocean_public_type) :: ocean_public - integer :: nsteps, dt_cpld - return - end subroutine external_coupler_sbc_after - - subroutine external_coupler_restart( dt_cpld, num_cpld_calls ) - implicit none - integer, intent(in) :: dt_cpld, num_cpld_calls - return - end subroutine external_coupler_restart - - subroutine external_coupler_exit - return - end subroutine external_coupler_exit - -!----------------------------------------------------------------------------------------- - subroutine external_coupler_mpi_exit(mom_local_communicator, external_initialization) - implicit none - integer, intent(in) :: mom_local_communicator - logical, intent(in) :: external_initialization - return - end subroutine external_coupler_mpi_exit -!----------------------------------------------------------------------------------------- - subroutine writeSliceFields(state, filename_prefix, slice, rc) - type(ESMF_State) :: state - character(len=*) :: filename_prefix - integer :: slice - integer, intent(out), optional :: rc - - integer :: n, nfields - type(ESMF_Field) :: field - type(ESMF_StateItem_Flag) :: itemType - character(len=40) :: fileName - character(len=64),allocatable :: fieldNameList(:) - character(len=*),parameter :: subname='(mom_cap:writeSliceFields)' - - if (present(rc)) rc = ESMF_SUCCESS - - if (ESMF_IO_PIO_PRESENT .and. & - (ESMF_IO_NETCDF_PRESENT .or. ESMF_IO_PNETCDF_PRESENT)) then - - call ESMF_StateGet(state, itemCount=nfields, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(fieldNameList(nfields)) - call ESMF_StateGet(state, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - do n=1, size(fieldNameList) - call ESMF_StateGet(state, itemName=fieldNameList(n), & - itemType=itemType, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemType /= ESMF_STATEITEM_NOTFOUND) then - ! field is available in the state - call ESMF_StateGet(state, itemName=fieldNameList(n), field=field, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! -> output to file - write (fileName,"(A)") & - filename_prefix//trim(fieldNameList(n))//".nc" - call ESMF_FieldWrite(field, fileName=trim(fileName), & - timeslice=slice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - enddo - - deallocate(fieldNameList) - - endif - - end subroutine writeSliceFields - - !----------------------------------------------------------------------------- - subroutine State_GetFldPtr(ST, fldname, fldptr, rc) type(ESMF_State) , intent(in) :: ST character(len=*) , intent(in) :: fldname @@ -2533,7 +2529,7 @@ end subroutine State_GetFldPtr !----------------------------------------------------------------------------- - subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_num, rc) + subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_count, rc) ! ---------------------------------------------- ! Set scalar data from State for a particular name ! ---------------------------------------------- @@ -2541,8 +2537,8 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name - integer, intent(in) :: scalar_num + character(len=*), intent(in) :: scalar_name + integer, intent(in) :: scalar_count integer, intent(inout) :: rc ! local variables @@ -2560,11 +2556,11 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ call ESMF_FieldGet(field, farrayPtr=farrayptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - if (scalar_id < 0 .or. scalar_id > scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", & - ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (scalar_id < 0 .or. scalar_id > scalar_count) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ERROR in scalar_id", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif farrayptr(1,scalar_id) = value @@ -2588,6 +2584,7 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) integer :: npet, nx, ny, pet integer :: elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) type(ESMF_VM) :: vm + real(ESMF_KIND_R8), pointer :: fldptr(:,:) character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' rc = ESMF_SUCCESS @@ -2596,12 +2593,12 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then - if (field_defs(i)%shortname == flds_scalar_name) then + if (field_defs(i)%shortname == scalar_field_name) then call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & - rc=dbrc) + rc=rc) call SetScalarField(field, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2613,11 +2610,11 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & - rc=dbrc) + rc=rc) write(tmpstr,'(a,4i12)') subname//trim(tag)//' Field '//trim(field_defs(i)%shortname)//':', & lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) - call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=rc) field = ESMF_FieldCreate(grid=grid, & farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & !farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & @@ -2631,13 +2628,22 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & - rc=dbrc) + rc=rc) field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & name=field_defs(i)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + + ! initialize to zero + call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr = 0.0 + endif call NUOPC_Realize(state, field=field, rc=rc) @@ -2645,19 +2651,12 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - ! call ESMF_FieldPrint(field=field, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out else call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & - rc=dbrc) - ! TODO: Initialize the value in the pointer to 0 after proper restart is setup - ! if(associated(field_defs(i)%farrayPtr) ) field_defs(i)%farrayPtr = 0.0 + rc=rc) ! remove a not connected Field from State call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2693,10 +2692,10 @@ subroutine SetScalarField(field, rc) grid = ESMF_GridCreate(distgrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - field = ESMF_FieldCreate(name=trim(flds_scalar_name), grid=grid, & + field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, & typekind=ESMF_TYPEKIND_R8, & ungriddedLBound=(/1/), & - ungriddedUBound=(/flds_scalar_num/), & ! num of scalar values + ungriddedUBound=(/scalar_field_count/), & ! num of scalar values rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -2723,9 +2722,10 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) num = num + 1 if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num gt fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - return + call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & + msg=trim(subname)//": ERROR number of field exceeded fldsMax: "//trim(stdname), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif fldlist(num)%stdname = trim(stdname) @@ -2747,50 +2747,4 @@ end subroutine fld_list_add !----------------------------------------------------------------------------- -#if (1 == 0) - subroutine calculate_rot_angle(OS, OSFC) - type(ocean_state_type), intent(in) :: OS - type(ocean_public_type), intent(in) :: OSFC - - integer :: i,j,ishift,jshift,ilb,iub,jlb,jub - real :: angle, lon_scale - type(ocean_grid_type), pointer :: grid - - call get_ocean_grid(OS, grid) - - !print *, 'lbound: ', lbound(grid%geoLatT), lbound(grid%geoLonT), lbound(grid%sin_rot) - !print *, 'ubound: ', ubound(grid%geoLatT), ubound(grid%geoLonT), ubound(grid%sin_rot) - - !print *, minval(grid%geoLatT), maxval(grid%geoLatT) - !print *, minval(grid%geoLonT), maxval(grid%geoLonT) - !print *, grid%isc, grid%jsc, grid%iec, grid%jec - - ! - ! The bounds isc:iec goes from 5-104, isc-ishift:iec-ishift goes from 1:100 - ! - call mpp_get_compute_domain(OSFC%Domain, ilb, iub, jlb, jub) - ishift = ilb-grid%isc - jshift = jlb-grid%jsc - !print *, 'ilb, iub, jlb, jub', ilb, iub, jlb, jub, ishift, jshift - !print *, 'sizes', iub-ilb, jub-jlb, grid%iec-grid%isc, grid%jec-grid%jsc -! allocate(grid%sin_rot(ilb:iub, jlb:jub)) -! allocate(grid%cos_rot(ilb:iub, jlb:jub)) - - ! loop 5-104 - do j=grid%jsc,grid%jec ; do i=grid%isc,grid%iec - lon_scale = cos((grid%geoLatBu(I-1,J-1) + grid%geoLatBu(I,J-1 ) + & - grid%geoLatBu(I-1,J) + grid%geoLatBu(I,J)) * atan(1.0)/180) - angle = atan2((grid%geoLonBu(I-1,J) + grid%geoLonBu(I,J) - & - grid%geoLonBu(I-1,J-1) - grid%geoLonBu(I,J-1))*lon_scale, & - grid%geoLatBu(I-1,J) + grid%geoLatBu(I,J) - & - grid%geoLatBu(I-1,J-1) - grid%geoLatBu(I,J-1) ) - grid%sin_rot(i+ishift,j+jshift) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean - grid%cos_rot(i+ishift,j+jshift) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) - enddo ; enddo - !print *, minval(grid%sin_rot), maxval(grid%sin_rot) - !print *, minval(grid%cos_rot), maxval(grid%cos_rot) - - end subroutine -#endif - end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index be9cd4e966..6e3558efc5 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -3,6 +3,7 @@ module mom_cap_methods use ESMF, only: ESMF_time, ESMF_ClockGet, ESMF_TimeGet, ESMF_State, ESMF_Clock use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_StateGet, ESMF_FieldGet + use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type @@ -15,8 +16,10 @@ module mom_cap_methods private ! Public member functions +#ifdef CESMCOUPLED public :: mom_export public :: mom_import +#endif public :: mom_import_nems integer :: rc,dbrc @@ -27,6 +30,7 @@ module mom_cap_methods contains !----------------------------------------------------------------------- +#ifdef CESMCOUPLED !> Maps outgoing ocean data to ESMF State !! See \ref section_mom_export for a summary of the data !! that is transferred from MOM6 to MCT. @@ -468,7 +472,7 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & end if end subroutine mom_import - +#endif !----------------------------------------------------------------------------- subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, rc) diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 new file mode 100644 index 0000000000..c85d68b1ae --- /dev/null +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -0,0 +1,425 @@ +! +! This was originally share code in CIME, but required CIME as a +! dependency to build the MOM cap. The options here for setting +! a restart alarm are useful for all caps, so a second step is to +! determine if/how these could be offered more generally in a +! shared library. For now we really want the MOM cap to only +! depend on MOM and ESMF/NUOPC. +! +module mom_cap_time + + ! !USES: + use ESMF , only : ESMF_Time, ESMF_Clock, ESMF_Calendar, ESMF_Alarm + use ESMF , only : ESMF_TimeGet, ESMF_TimeSet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet + use ESMF , only : ESMF_ClockGet, ESMF_AlarmCreate + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_LogSetError, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_RC_ARG_BAD + use ESMF , only : operator(<), operator(/=), operator(+), operator(-), operator(*) , operator(>=) + use ESMF , only : operator(<=), operator(>), operator(==) + + implicit none + private ! default private + + public :: AlarmInit ! initialize an alarm + + private :: TimeInit + private :: date2ymd + + ! Clock and alarm options + character(len=*), private, parameter :: & + optNONE = "none" , & + optNever = "never" , & + optNSteps = "nsteps" , & + optNStep = "nstep" , & + optNSeconds = "nseconds" , & + optNSecond = "nsecond" , & + optNMinutes = "nminutes" , & + optNMinute = "nminute" , & + optNHours = "nhours" , & + optNHour = "nhour" , & + optNDays = "ndays" , & + optNDay = "nday" , & + optNMonths = "nmonths" , & + optNMonth = "nmonth" , & + optNYears = "nyears" , & + optNYear = "nyear" , & + optMonthly = "monthly" , & + optYearly = "yearly" , & + optDate = "date" , & + optIfdays0 = "ifdays0" , & + optGLCCouplingPeriod = "glc_coupling_period" + + ! Module data + integer, parameter :: SecPerDay = 86400 ! Seconds per day + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine AlarmInit( clock, alarm, option, & + opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + + ! !DESCRIPTION: Setup an alarm in a clock + ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm + ! time. If you send an arbitrary but proper ringtime from the + ! past and the ring interval, the alarm will always go off on the + ! next clock advance and this will cause serious problems. Even + ! if it makes sense to initialize an alarm with some reference + ! time and the alarm interval, that reference time has to be + ! advance forward to be >= the current time. In the logic below + ! we set an appropriate "NextAlarm" and then we make sure to + ! advance it properly based on the ring interval. + + ! input/output variables + type(ESMF_Clock) , intent(inout) :: clock ! clock + type(ESMF_Alarm) , intent(inout) :: alarm ! alarm + character(len=*) , intent(in) :: option ! alarm option + integer , optional , intent(in) :: opt_n ! alarm freq + integer , optional , intent(in) :: opt_ymd ! alarm ymd + integer , optional , intent(in) :: opt_tod ! alarm tod (sec) + type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time + character(len=*) , optional , intent(in) :: alarmname ! alarm name + integer , intent(inout) :: rc ! Return code + + ! local variables + type(ESMF_Calendar) :: cal ! calendar + integer :: lymd ! local ymd + integer :: ltod ! local tod + integer :: cyy,cmm,cdd,csec ! time info + integer :: nyy,nmm,ndd,nsec ! time info + character(len=64) :: lalarmname ! local alarm name + logical :: update_nextalarm ! update next alarm + type(ESMF_Time) :: CurrTime ! Current Time + type(ESMF_Time) :: NextAlarm ! Next restart alarm time + type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval + character(len=*), parameter :: subname = '(AlarmInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lalarmname = 'alarm_unknown' + if (present(alarmname)) lalarmname = trim(alarmname) + ltod = 0 + if (present(opt_tod)) ltod = opt_tod + lymd = -1 + if (present(opt_ymd)) lymd = opt_ymd + + ! verify parameters + if (trim(option) == optNSteps .or. trim(option) == optNStep .or. & + trim(option) == optNSeconds .or. trim(option) == optNSecond .or. & + trim(option) == optNMinutes .or. trim(option) == optNMinute .or. & + trim(option) == optNHours .or. trim(option) == optNHour .or. & + trim(option) == optNDays .or. trim(option) == optNDay .or. & + trim(option) == optNMonths .or. trim(option) == optNMonth .or. & + trim(option) == optNYears .or. trim(option) == optNYear .or. & + trim(option) == optIfdays0) then + if (.not. present(opt_n)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_n', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + if (opt_n <= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' invalid opt_n', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + endif + + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + call ESMF_TimeGet(CurrTime, yy=nyy, mm=nmm, dd=ndd, s=nsec, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + ! initial guess of next alarm, this will be updated below + if (present(RefTime)) then + NextAlarm = RefTime + else + NextAlarm = CurrTime + endif + + ! Determine calendar + call ESMF_ClockGet(clock, calendar=cal, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + ! Determine inputs for call to create alarm + selectcase (trim(option)) + + case (optNONE, optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .false. + + case (optDate) + if (.not. present(opt_ymd)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_ymd', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + if (lymd < 0 .or. ltod < 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call TimeInit(NextAlarm, lymd, cal, tod=ltod, desc="optDate", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .false. + + case (optIfdays0) + if (.not. present(opt_ymd)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_ymd', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case (optNSteps, optNStep) + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSeconds, optNSecond) + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes, optNMinute) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours, optNHour) + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDays, optNDay) + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths, optNMonth) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optMonthly) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case (optNYears, optNYear) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optYearly) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case default + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//' unknown option: '//trim(option), & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + + end select + + ! -------------------------------------------------------------------------------- + ! --- AlarmInterval and NextAlarm should be set --- + ! -------------------------------------------------------------------------------- + + ! --- advance Next Alarm so it won't ring on first timestep for + ! --- most options above. go back one alarminterval just to be careful + + if (update_nextalarm) then + NextAlarm = NextAlarm - AlarmInterval + do while (NextAlarm <= CurrTime) + NextAlarm = NextAlarm + AlarmInterval + enddo + endif + + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, ringInterval=AlarmInterval, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + end subroutine AlarmInit + + !=============================================================================== + + subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) + + ! Create the ESMF_Time object corresponding to the given input time, given in + ! YMD (Year Month Day) and TOD (Time-of-day) format. + ! Set the time by an integer as YYYYMMDD and integer seconds in the day + + ! input/output parameters: + type(ESMF_Time) , intent(inout) :: Time ! ESMF time + integer , intent(in) :: ymd ! year, month, day YYYYMMDD + type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar + integer , intent(in), optional :: tod ! time of day in seconds + character(len=*) , intent(in), optional :: desc ! description of time to set + integer , intent(in), optional :: logunit + integer , intent(out), optional :: rc + + ! local varaibles + integer :: yr, mon, day ! Year, month, day as integers + integer :: ltod ! local tod + character(len=256) :: ldesc ! local desc + character(len=*), parameter :: subname = '(TimeInit) ' + !------------------------------------------------------------------------------- + + ltod = 0 + if (present(tod)) ltod = tod + ldesc = '' + if (present(desc)) ldesc = desc + + if ( (ymd < 0) .or. (ltod < 0) .or. (ltod > SecPerDay) )then + if (present(logunit)) then + write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & + 'time-of-day out of bounds', ymd, ltod + end if + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//' yymmdd is negative or time-of-day out of bounds ', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + + call date2ymd (ymd,yr,mon,day) + + call ESMF_TimeSet( Time, yy=yr, mm=mon, dd=day, s=ltod, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + end subroutine TimeInit + + !=============================================================================== + + subroutine date2ymd (date, year, month, day) + + ! input/output variables + integer, intent(in) :: date ! coded-date (yyyymmdd) + integer, intent(out) :: year,month,day ! calendar year,month,day + + ! local variables + integer :: tdate ! temporary date + character(*),parameter :: subName = "(date2ymd)" + !------------------------------------------------------------------------------- + + tdate = abs(date) + year = int(tdate/10000) + if (date < 0) then + year = -year + end if + month = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) + + end subroutine date2ymd + +end module From e55e0c27c72f728f0ee8ec54acfad0963b8ddbb1 Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Thu, 18 Oct 2018 14:47:17 -0600 Subject: [PATCH 07/77] Remove trailing whitespace in two files --- config_src/nuopc_driver/mom_cap.F90 | 156 +++++++++++------------ config_src/nuopc_driver/mom_cap_time.F90 | 84 ++++++------ 2 files changed, 120 insertions(+), 120 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index d638b82b94..eb8c003945 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -404,9 +404,9 @@ module mom_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit - use ESMF - use NUOPC - use NUOPC_Model, & + use ESMF + use NUOPC + use NUOPC_Model, & model_routine_SS => SetServices, & model_label_Advance => label_Advance, & model_label_DataInitialize => label_DataInitialize, & @@ -456,7 +456,7 @@ module mom_cap_mod logical :: grid_attach_area = .false. character(len=128) :: scalar_field_name integer :: scalar_field_count - integer :: scalar_field_idx_grid_nx + integer :: scalar_field_idx_grid_nx integer :: scalar_field_idx_grid_ny character(len=*),parameter :: u_file_u = & __FILE__ @@ -578,23 +578,23 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + write_diagnostics = .false. call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") - + write(logmsg,*) write_diagnostics call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return profile_memory = .false. call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & @@ -602,14 +602,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) profile_memory=(trim(value)=="true") write(logmsg,*) profile_memory call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return grid_attach_area = .false. call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & @@ -617,14 +617,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") write(logmsg,*) grid_attach_area call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return scalar_field_name = "" call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & @@ -632,14 +632,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - if (isPresent .and. isSet) then + return + if (isPresent .and. isSet) then scalar_field_name = trim(value) call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_count = 0 @@ -648,7 +648,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then @@ -662,7 +662,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_nx = 0 @@ -671,7 +671,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then @@ -685,7 +685,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_ny = 0 @@ -694,7 +694,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then @@ -708,16 +708,16 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - call NUOPC_CompAttributeAdd(gcomp, & + call NUOPC_CompAttributeAdd(gcomp, & attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + end subroutine !=============================================================================== @@ -774,7 +774,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer @@ -827,11 +827,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! rsd need to figure out how to get this without share code !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - !inst_name = "OCN"//trim(inst_suffix) + !inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & isPresent=isPresentDiro, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -842,7 +842,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresentDiro .and. isPresentLogfile) then open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else @@ -853,7 +853,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif starttype = "" - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -867,7 +867,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif runtype = "" @@ -881,7 +881,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//": unknown starttype - "//trim(starttype), & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return endif if (len_trim(runtype) > 0) then @@ -889,9 +889,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + restartfile = "" if (runtype == "initial") then ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml @@ -914,36 +914,36 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then restartfile = trim(cvalue) call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return else - call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & ESMF_LOGMSG_WARNING, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif end if - + ocean_public%is_ocean_pe = .true. if (len_trim(restartfile) > 0) then - call ocean_model_init(ocean_public, ocean_state, Time, Time, & + call ocean_model_init(ocean_public, ocean_state, Time, Time, & input_restart_file=trim(restartfile)) else call ocean_model_init(ocean_public, ocean_state, Time, Time) @@ -1008,7 +1008,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -1020,7 +1020,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -1037,7 +1037,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -1105,7 +1105,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC ! EMC fields not used @@ -1115,7 +1115,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Optional CESM fields currently not used ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -1303,7 +1303,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- @@ -1324,7 +1324,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return - + !--------------------------------- ! get start and end indices of each tile and their PET !--------------------------------- @@ -1339,10 +1339,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return enddo end if - + !--------------------------------- ! create delayout and distgrid @@ -1425,7 +1425,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1437,9 +1437,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return deallocate(IndexList) - + !--------------------------------- ! create grid !--------------------------------- @@ -1730,7 +1730,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1783,7 +1783,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out - + end subroutine InitializeRealize !=============================================================================== @@ -2081,7 +2081,7 @@ subroutine ModelAdvance(gcomp, rc) mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -2177,26 +2177,26 @@ subroutine ModelAdvance(gcomp, rc) deallocate(ocz, ocm) #endif - + ! If restart alarm is ringing - write restart file call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + ! call into system specific method to get desired restart filename restartname = "" call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & @@ -2230,7 +2230,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out endif endif - + if (len_trim(restartname) == 0) then ! none provided, so use a default restart filename call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) @@ -2244,7 +2244,7 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & "ocn", year, month, day, hour, minute, seconds call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2252,15 +2252,15 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out endif - + ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) - + if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) end if endif - + if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -2270,9 +2270,9 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out export_slice = export_slice + 1 endif - + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - + end subroutine ModelAdvance !=============================================================================== @@ -2354,9 +2354,9 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- + !-------------------------------- ! defaults restart_n = 0 @@ -2390,7 +2390,7 @@ subroutine ModelSetRunClock(gcomp, rc) else restart_option = "none" endif - + call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & @@ -2402,21 +2402,21 @@ subroutine ModelSetRunClock(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out first_time = .false. - - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + end if !-------------------------------- @@ -2537,7 +2537,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name + character(len=*), intent(in) :: scalar_name integer, intent(in) :: scalar_count integer, intent(inout) :: rc @@ -2635,14 +2635,14 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + ! initialize to zero call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - fldptr = 0.0 + fldptr = 0.0 endif diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 index c85d68b1ae..7da3cf842d 100644 --- a/config_src/nuopc_driver/mom_cap_time.F90 +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -2,17 +2,17 @@ ! This was originally share code in CIME, but required CIME as a ! dependency to build the MOM cap. The options here for setting ! a restart alarm are useful for all caps, so a second step is to -! determine if/how these could be offered more generally in a -! shared library. For now we really want the MOM cap to only +! determine if/how these could be offered more generally in a +! shared library. For now we really want the MOM cap to only ! depend on MOM and ESMF/NUOPC. ! -module mom_cap_time +module mom_cap_time ! !USES: - use ESMF , only : ESMF_Time, ESMF_Clock, ESMF_Calendar, ESMF_Alarm + use ESMF , only : ESMF_Time, ESMF_Clock, ESMF_Calendar, ESMF_Alarm use ESMF , only : ESMF_TimeGet, ESMF_TimeSet use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet - use ESMF , only : ESMF_ClockGet, ESMF_AlarmCreate + use ESMF , only : ESMF_ClockGet, ESMF_AlarmCreate use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO use ESMF , only : ESMF_LogSetError, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU use ESMF , only : ESMF_RC_ARG_BAD @@ -122,14 +122,14 @@ subroutine AlarmInit( clock, alarm, option, & msg=subname//trim(option)//' requires opt_n', & line=__LINE__, & file=__FILE__, rcToReturn=rc) - return + return end if if (opt_n <= 0) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//trim(option)//' invalid opt_n', & line=__LINE__, & file=__FILE__, rcToReturn=rc) - return + return end if endif @@ -137,21 +137,21 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_TimeGet(CurrTime, yy=nyy, mm=nmm, dd=ndd, s=nsec, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return - ! initial guess of next alarm, this will be updated below + ! initial guess of next alarm, this will be updated below if (present(RefTime)) then NextAlarm = RefTime else @@ -163,8 +163,8 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + ! Determine inputs for call to create alarm selectcase (trim(option)) @@ -173,12 +173,12 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return update_nextalarm = .false. case (optDate) @@ -187,25 +187,25 @@ subroutine AlarmInit( clock, alarm, option, & msg=subname//trim(option)//' requires opt_ymd', & line=__LINE__, & file=__FILE__, rcToReturn=rc) - return + return end if if (lymd < 0 .or. ltod < 0) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & line=__LINE__, & file=__FILE__, rcToReturn=rc) - return + return end if call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call TimeInit(NextAlarm, lymd, cal, tod=ltod, desc="optDate", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return update_nextalarm = .false. case (optIfdays0) @@ -214,18 +214,18 @@ subroutine AlarmInit( clock, alarm, option, & msg=subname//trim(option)//' requires opt_ymd', & line=__LINE__, & file=__FILE__, rcToReturn=rc) - return + return end if call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return update_nextalarm = .true. case (optNSteps, optNStep) @@ -233,7 +233,7 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. @@ -242,7 +242,7 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. @@ -251,7 +251,7 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. @@ -260,7 +260,7 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. @@ -269,7 +269,7 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. @@ -278,7 +278,7 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. @@ -287,12 +287,12 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return update_nextalarm = .true. case (optNYears, optNYear) @@ -300,7 +300,7 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. @@ -309,20 +309,20 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return update_nextalarm = .true. - + case default call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//' unknown option: '//trim(option), & line=__LINE__, & file=__FILE__, rcToReturn=rc) - return + return end select @@ -344,8 +344,8 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + end subroutine AlarmInit !=============================================================================== @@ -390,15 +390,15 @@ subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) end if call date2ymd (ymd,yr,mon,day) - + call ESMF_TimeSet( Time, yy=yr, mm=mon, dd=day, s=ltod, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return end subroutine TimeInit - + !=============================================================================== subroutine date2ymd (date, year, month, day) @@ -421,5 +421,5 @@ subroutine date2ymd (date, year, month, day) day = mod(tdate, 100) end subroutine date2ymd - + end module From 0d4933178801028930b5d8c5d80232698189fa37 Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 3 Dec 2018 16:15:38 -0700 Subject: [PATCH 08/77] modifications to nuopc cap that are up to date with moa cap --- config_src/nuopc_driver/MOM_ocean_model.F90 | 50 ++- config_src/nuopc_driver/mom_cap.F90 | 364 +++++++++++++++----- config_src/nuopc_driver/mom_cap_methods.F90 | 44 ++- 3 files changed, 353 insertions(+), 105 deletions(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 17d66789b5..3ffa1e8d5f 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -121,6 +121,7 @@ module MOM_ocean_model !! i.e. dzt(1) + eta_t + patm/rho0/grav (m) frazil =>NULL(), & !< Accumulated heating (in Joules/m^2) from frazil !! formation in the ocean. + melt_potential => NULL(), & !< Instantaneous heat used to melt sea ice (in J/m^2) area => NULL() !< cell area of the ocean surface, in m2. type(coupler_2d_bc_type) :: fields !< A structure that may contain named !! arrays of tracer-related surface fields. @@ -242,6 +243,12 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! Local variables real :: Rho0 ! The Boussinesq ocean density, in kg m-3. real :: G_Earth ! The gravitational acceleration in m s-2. + real :: HFrz !< If HFrz > 0 (m), melt potential will be computed. + !! The actual depth over which melt potential is computed will + !! min(HFrz, OBLD), where OBLD is the boundary layer depth. + !! If HFrz <= 0 (default), melt potential will not be computed. + logical :: use_melt_pot!< If true, allocate melt_potential array + ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "ocean_model_init" ! This module's name. @@ -343,10 +350,22 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i OS%press_to_z = 1.0/(Rho0*G_Earth) + call get_param(param_file, mdl, "HFREEZE", HFrz, & + "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& + "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//& + "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//& + "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) + + if (HFrz .gt. 0.0) then + use_melt_pot=.true. + else + use_melt_pot=.false. + endif + ! Consider using a run-time flag to determine whether to do the diagnostic ! vertical integrals, since the related 3-d sums are not negligible in cost. call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, & - do_integrals=.true., gas_fields_ocn=gas_fields_ocn) + do_integrals=.true., gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot) call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) @@ -797,6 +816,7 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf (isc:iec,jsc:jec), & Ocean_sfc%sea_lev(isc:iec,jsc:jec), & Ocean_sfc%area (isc:iec,jsc:jec), & + Ocean_sfc%melt_potential(isc:iec,jsc:jec), & Ocean_sfc%frazil (isc:iec,jsc:jec)) Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model @@ -805,6 +825,7 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model + Ocean_sfc%melt_potential = 0.0 ! time accumulated melt potential (J/m^2) passed to ice model Ocean_sfc%area = 0.0 Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics @@ -889,6 +910,12 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z enddo ; enddo endif + if (allocated(sfc_state%melt_potential)) then + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%melt_potential(i,j) = sfc_state%melt_potential(i+i0,j+j0) + enddo ; enddo + endif + if (Ocean_sfc%stagger == AGRID) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%u_surf(i,j) = G%mask2dT(i+i0,j+j0) * & @@ -1057,25 +1084,25 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) case('btfHeat') array2D(isc:,jsc:) = 0 case('tlat') - array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) case('tlon') - array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) case('ulat') - array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) case('ulon') - array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) case('vlat') - array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) case('vlon') - array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) case('geoLatBu') - array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) case('geoLonBu') - array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) case('cos_rot') - array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 case('sin_rot') - array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 + array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 case default call MOM_error(FATAL,'get_ocean_grid_data2D: unknown argument name='//name) end select @@ -1121,6 +1148,7 @@ subroutine ocean_public_type_chksum(id, timestep, ocn) write(outunit,100) 'ocean%v_surf ',mpp_chksum(ocn%v_surf ) write(outunit,100) 'ocean%sea_lev ',mpp_chksum(ocn%sea_lev) write(outunit,100) 'ocean%frazil ',mpp_chksum(ocn%frazil ) + write(outunit,100) 'ocean%melt_potential ',mpp_chksum(ocn%melt_potential) call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%') 100 FORMAT(" CHECKSUM::",A20," = ",Z20) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index eb8c003945..8e083fbe55 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -404,9 +404,9 @@ module mom_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit - use ESMF - use NUOPC - use NUOPC_Model, & + use ESMF + use NUOPC + use NUOPC_Model, & model_routine_SS => SetServices, & model_label_Advance => label_Advance, & model_label_DataInitialize => label_DataInitialize, & @@ -456,7 +456,7 @@ module mom_cap_mod logical :: grid_attach_area = .false. character(len=128) :: scalar_field_name integer :: scalar_field_count - integer :: scalar_field_idx_grid_nx + integer :: scalar_field_idx_grid_nx integer :: scalar_field_idx_grid_ny character(len=*),parameter :: u_file_u = & __FILE__ @@ -578,23 +578,23 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + write_diagnostics = .false. call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") - + write(logmsg,*) write_diagnostics call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return profile_memory = .false. call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & @@ -602,14 +602,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) profile_memory=(trim(value)=="true") write(logmsg,*) profile_memory call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return grid_attach_area = .false. call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & @@ -617,14 +617,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") write(logmsg,*) grid_attach_area call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return scalar_field_name = "" call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & @@ -632,14 +632,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - if (isPresent .and. isSet) then + return + if (isPresent .and. isSet) then scalar_field_name = trim(value) call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_count = 0 @@ -648,7 +648,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then @@ -662,7 +662,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_nx = 0 @@ -671,7 +671,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then @@ -685,7 +685,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_ny = 0 @@ -694,7 +694,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then @@ -708,16 +708,16 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - call NUOPC_CompAttributeAdd(gcomp, & + call NUOPC_CompAttributeAdd(gcomp, & attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + end subroutine !=============================================================================== @@ -766,7 +766,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: userRc character(len=512) :: restartfile ! Path/Name of restart file character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' - !-------------------------------- + real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_frzmlt + real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdx + real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdy +!-------------------------------- rc = ESMF_SUCCESS @@ -774,7 +777,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer @@ -827,11 +830,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! rsd need to figure out how to get this without share code !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - !inst_name = "OCN"//trim(inst_suffix) + !inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & isPresent=isPresentDiro, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -842,7 +845,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresentDiro .and. isPresentLogfile) then open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else @@ -853,7 +856,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif starttype = "" - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -867,7 +870,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif runtype = "" @@ -881,7 +884,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//": unknown starttype - "//trim(starttype), & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return endif if (len_trim(runtype) > 0) then @@ -889,9 +892,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + restartfile = "" if (runtype == "initial") then ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml @@ -914,36 +917,36 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then restartfile = trim(cvalue) call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return else - call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & ESMF_LOGMSG_WARNING, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif end if - + ocean_public%is_ocean_pe = .true. if (len_trim(restartfile) > 0) then - call ocean_model_init(ocean_public, ocean_state, Time, Time, & + call ocean_model_init(ocean_public, ocean_state, Time, Time, & input_restart_file=trim(restartfile)) else call ocean_model_init(ocean_public, ocean_state, Time, Time) @@ -1008,7 +1011,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -1020,7 +1023,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -1037,7 +1040,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -1103,19 +1106,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential ! EMC fields not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") ! not in CESM - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") ! not in CESM + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") ! not in CESM ! Optional CESM fields currently not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -1177,8 +1179,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide",& data=ocean_public%sea_lev) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& - data=ocean_public%frazil) + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& + ! data=ocean_public%frazil) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide",& + data=Ocean_public%frazil) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide",& + data=Ocean_public%melt_potential) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential", "will provide", & + data=dataPtr_frzmlt) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide",& + data=ocean_public%frazil) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide",& + data=ocean_public%frazil) !JW #endif @@ -1303,7 +1315,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- @@ -1324,7 +1336,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return - + !--------------------------------- ! get start and end indices of each tile and their PET !--------------------------------- @@ -1339,10 +1351,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return enddo end if - + !--------------------------------- ! create delayout and distgrid @@ -1425,7 +1437,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1437,9 +1449,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return deallocate(IndexList) - + !--------------------------------- ! create grid !--------------------------------- @@ -1730,7 +1742,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1783,7 +1795,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out - + end subroutine InitializeRealize !=============================================================================== @@ -1914,6 +1926,7 @@ subroutine ModelAdvance(gcomp, rc) integer :: dth, dtm, dts, dt_cpld = 86400 integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 integer :: i,j,i1,j1 + real :: slp_L, slp_R, slp_C, slope, u_min, u_max !JW integer :: nc type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute @@ -1927,12 +1940,22 @@ subroutine ModelAdvance(gcomp, rc) real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_melt_potential(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_frzmlt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) !JW + real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) !JW real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) + real(ESMF_KIND_R8), allocatable :: ssh(:,:) + real(ESMF_KIND_R8), allocatable :: sshx(:,:) + real(ESMF_KIND_R8), allocatable :: sshy(:,:) #endif type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' + ! helper flag for debugging bounds + logical :: BoundsDebug = .false. + integer :: ijloc(2) !-------------------------------- rc = ESMF_SUCCESS @@ -2021,6 +2044,7 @@ subroutine ModelAdvance(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) #ifdef CESMCOUPLED + call shr_file_setLogUnit (logunit) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) @@ -2028,7 +2052,9 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out + #else + call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2081,7 +2107,7 @@ subroutine ModelAdvance(gcomp, rc) mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -2114,6 +2140,7 @@ subroutine ModelAdvance(gcomp, rc) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") #ifdef CESMCOUPLED + call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2151,14 +2178,175 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + !call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! fixfrzmlt !JW + call State_getFldPtr(exportState,'accum_heat_frazil',dataPtr_frazil,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'inst_melt_potential',dataPtr_melt_potential,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frzmlt,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_zonal',dataPtr_dhdx,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_merid',dataPtr_dhdy,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !JW + + allocate( ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + allocate(sshx(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + allocate(sshy(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + ssh = 0.0_ESMF_KIND_R8 !JW + sshx = 0.0_ESMF_KIND_R8 !JW + sshy = 0.0_ESMF_KIND_R8 !JW + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! note: the following code is modified from NCAR nuopc driver mom_cap_methods + ! where is the rotation in that system? + ! + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ! + ! here, isc,iec,jsc,jec are global indices on cap domain (no halos) + + do j=jsc,jec + do i=isc,iec + j1 = j - ocean_grid%jdg_offset + i1 = i - ocean_grid%idg_offset + ssh(i1,j1) = Ocean_public%sea_lev(i,j) + end do + end do + + ! Update halo of ssh so we can calculate gradients + call pass_var(ssh, ocean_grid%domain) + + ! calculation of slope on native mom domains (local indexing, halos) + ! stay inside of halos (ie 2:79,2:97) + ! d/dx ssh + do j = ocean_grid%jsd+1,ocean_grid%jed-1 + do i = ocean_grid%isd+1,ocean_grid%ied-1 + ! This is a simple second-order difference + !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) + if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(i,j) + if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + sshx(i,j) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 + end do + end do + + ! d/dy ssh + do j = ocean_grid%jsd+1,ocean_grid%jed-1 + do i = ocean_grid%isd+1,ocean_grid%ied-1 + ! This is a simple second-order difference + !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) + if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) + if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + sshy(i,j) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 + end do + end do + ! rotate slopes from tripolar grid back to lat/lon grid (CCW) + ! "grid" uses the usual MOM domain that has halos + ! and does not use global indexing. + ! x,y => latlon + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 + dataPtr_dhdx(i,j) = ocean_grid%cos_rot(i1,j1)*sshx(i1,j1) & + + ocean_grid%sin_rot(i1,j1)*sshy(i1,j1) + dataPtr_dhdy(i,j) = ocean_grid%cos_rot(i1,j1)*sshy(i1,j1) & + - ocean_grid%sin_rot(i1,j1)*sshx(i1,j1) + enddo + enddo + deallocate(ssh); deallocate(sshx); deallocate(sshy) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + dataPtr_melt_potential = -dataPtr_melt_potential/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + !melt_potential, defined positive for T>Tfreeze + !so change sign + !testing + ijloc = maxloc(dataPtr_frazil) + if((sum(ijloc) .gt. 2) .and. & + (dataPtr_frazil(ijloc(1),ijloc(2)) .gt. 0.0))then + i1 = ijloc(1) - lbnd1 + isc + j1 = ijloc(2) - lbnd2 + jsc ! work around local vs global indexing + write (msgString,*)' MOM6 dataPtr_frazil at maxloc ',i1,j1,& + real(dataPtr_frazil(ijloc(1),ijloc(2)),4) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + + write (msgString,*)' MOM6 dataPtr_melt_potential at maxloc ',i1,j1,& + real(dataPtr_melt_potential(ijloc(1),ijloc(2)),4) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + endif + !testing + + dataPtr_melt_potential = min(dataPtr_melt_potential,0.0) + + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + if(dataPtr_frazil(i,j) .eq. 0.0)then + dataPtr_frzmlt(i,j) = dataPtr_melt_potential(i,j) + else + dataPtr_frzmlt(i,j) = dataPtr_frazil(i,j) + endif + enddo + enddo + dataPtr_frzmlt = max(-1000.0,min(1000.0,dataPtr_frzmlt)) + ! rotate ocn current from tripolar grid back to lat/lon grid (CCW) + ! "grid" uses the usual MOM domain that has halos + ! and does not use global indexing. + ! x,y => latlon ocz = dataPtr_ocz ocm = dataPtr_ocm do j = lbnd2, ubnd2 @@ -2177,26 +2365,26 @@ subroutine ModelAdvance(gcomp, rc) deallocate(ocz, ocm) #endif - + ! If restart alarm is ringing - write restart file call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + ! call into system specific method to get desired restart filename restartname = "" call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & @@ -2230,7 +2418,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out endif endif - + if (len_trim(restartname) == 0) then ! none provided, so use a default restart filename call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) @@ -2244,7 +2432,7 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & "ocn", year, month, day, hour, minute, seconds call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2252,15 +2440,15 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out endif - + ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) - + if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) end if endif - + if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -2270,9 +2458,9 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out export_slice = export_slice + 1 endif - + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - + end subroutine ModelAdvance !=============================================================================== @@ -2354,9 +2542,9 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- + !-------------------------------- ! defaults restart_n = 0 @@ -2390,7 +2578,7 @@ subroutine ModelSetRunClock(gcomp, rc) else restart_option = "none" endif - + call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & @@ -2402,21 +2590,21 @@ subroutine ModelSetRunClock(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out first_time = .false. - - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + end if !-------------------------------- @@ -2537,7 +2725,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name + character(len=*), intent(in) :: scalar_name integer, intent(in) :: scalar_count integer, intent(inout) :: rc @@ -2635,14 +2823,14 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + ! initialize to zero call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - fldptr = 0.0 + fldptr = 0.0 endif diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 6e3558efc5..34946cefdb 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,8 +1,10 @@ module mom_cap_methods - use ESMF, only: ESMF_time, ESMF_ClockGet, ESMF_TimeGet, ESMF_State, ESMF_Clock + use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet + use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalTeg + use ESMF, only: ESMF_State, ESMF_StateGet use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError - use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_StateGet, ESMF_FieldGet + use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_FieldGet use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type @@ -47,6 +49,7 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices integer :: lbnd1, lbnd2 real :: slp_L, slp_R, slp_C, slope, u_min, u_max + real :: I_time_int !< The inverse of coupling time interval in s-1. integer :: day, secs type(ESMF_time) :: currTime real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) @@ -58,6 +61,8 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) + type(ESMF_TimeInterval) :: timeStep + integer :: dt_int !< time over which to advance the ocean (ocean_coupling_time_step), in sec character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*), parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- @@ -116,6 +121,23 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + ! Use Adcroft's rule of reciprocals; it does the right thing here. + call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (real(dt_int) > 0.0) then + I_time_int = 1.0 / real(dt_int) + else + I_time_int = 0.0 + end if + ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. ! The mask comes from "grid" that uses the usual MOM domain that has halos ! and does not use global indexing. @@ -132,10 +154,20 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) dataPtr_q(i1,j1) = 0. dataPtr_bldepth(i1,j1) = 0. ! TODO: this needs to be generalized - !dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & - ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) - !dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & - ! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) + + ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 + if (ocn_public%frazil(ig,jg) > 0.0) then + ! Frazil: change from J/m^2 to W/m^2 + dataPtr_Fioo_q(i1,j1) = ocn_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int + else + ! Melt_potential: change from J/m^2 to W/m^2 + dataPtr_Fioo_q(i1,j1) = -ocn_public%melt_potential(i,j) * grid%mask2dT(ig,jg) * I_time_int !* ncouple_per_day + + ! make sure Melt_potential is always <= 0 + if (dataPtr_Fioo_q(i1,j1) > 0.0) then + dataPtr_Fioo_q(i1,j1) = 0.0 + endif + end if end do end do From f9a3a8122d5cbc59c740b47b65d7510069998e9b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 3 Dec 2018 22:54:12 -0700 Subject: [PATCH 09/77] latest updates to get cap up to date with dev/ncar and working --- config_src/nuopc_driver/MOM_ocean_model.F90 | 50 +-- config_src/nuopc_driver/mom_cap.F90 | 364 +++++--------------- config_src/nuopc_driver/mom_cap_methods.F90 | 44 +-- config_src/nuopc_driver/time_utils.F90 | 161 +++++++++ 4 files changed, 266 insertions(+), 353 deletions(-) create mode 100644 config_src/nuopc_driver/time_utils.F90 diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 3ffa1e8d5f..17d66789b5 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -121,7 +121,6 @@ module MOM_ocean_model !! i.e. dzt(1) + eta_t + patm/rho0/grav (m) frazil =>NULL(), & !< Accumulated heating (in Joules/m^2) from frazil !! formation in the ocean. - melt_potential => NULL(), & !< Instantaneous heat used to melt sea ice (in J/m^2) area => NULL() !< cell area of the ocean surface, in m2. type(coupler_2d_bc_type) :: fields !< A structure that may contain named !! arrays of tracer-related surface fields. @@ -243,12 +242,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! Local variables real :: Rho0 ! The Boussinesq ocean density, in kg m-3. real :: G_Earth ! The gravitational acceleration in m s-2. - real :: HFrz !< If HFrz > 0 (m), melt potential will be computed. - !! The actual depth over which melt potential is computed will - !! min(HFrz, OBLD), where OBLD is the boundary layer depth. - !! If HFrz <= 0 (default), melt potential will not be computed. - logical :: use_melt_pot!< If true, allocate melt_potential array - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "ocean_model_init" ! This module's name. @@ -350,22 +343,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i OS%press_to_z = 1.0/(Rho0*G_Earth) - call get_param(param_file, mdl, "HFREEZE", HFrz, & - "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& - "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//& - "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//& - "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) - - if (HFrz .gt. 0.0) then - use_melt_pot=.true. - else - use_melt_pot=.false. - endif - ! Consider using a run-time flag to determine whether to do the diagnostic ! vertical integrals, since the related 3-d sums are not negligible in cost. call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, & - do_integrals=.true., gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot) + do_integrals=.true., gas_fields_ocn=gas_fields_ocn) call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) @@ -816,7 +797,6 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf (isc:iec,jsc:jec), & Ocean_sfc%sea_lev(isc:iec,jsc:jec), & Ocean_sfc%area (isc:iec,jsc:jec), & - Ocean_sfc%melt_potential(isc:iec,jsc:jec), & Ocean_sfc%frazil (isc:iec,jsc:jec)) Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model @@ -825,7 +805,6 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model - Ocean_sfc%melt_potential = 0.0 ! time accumulated melt potential (J/m^2) passed to ice model Ocean_sfc%area = 0.0 Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics @@ -910,12 +889,6 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z enddo ; enddo endif - if (allocated(sfc_state%melt_potential)) then - do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%melt_potential(i,j) = sfc_state%melt_potential(i+i0,j+j0) - enddo ; enddo - endif - if (Ocean_sfc%stagger == AGRID) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%u_surf(i,j) = G%mask2dT(i+i0,j+j0) * & @@ -1084,25 +1057,25 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) case('btfHeat') array2D(isc:,jsc:) = 0 case('tlat') - array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) case('tlon') - array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) case('ulat') - array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) case('ulon') - array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) case('vlat') - array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) case('vlon') - array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) case('geoLatBu') - array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) case('geoLonBu') - array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) case('cos_rot') - array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 case('sin_rot') - array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 + array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 case default call MOM_error(FATAL,'get_ocean_grid_data2D: unknown argument name='//name) end select @@ -1148,7 +1121,6 @@ subroutine ocean_public_type_chksum(id, timestep, ocn) write(outunit,100) 'ocean%v_surf ',mpp_chksum(ocn%v_surf ) write(outunit,100) 'ocean%sea_lev ',mpp_chksum(ocn%sea_lev) write(outunit,100) 'ocean%frazil ',mpp_chksum(ocn%frazil ) - write(outunit,100) 'ocean%melt_potential ',mpp_chksum(ocn%melt_potential) call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%') 100 FORMAT(" CHECKSUM::",A20," = ",Z20) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 8e083fbe55..eb8c003945 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -404,9 +404,9 @@ module mom_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit - use ESMF - use NUOPC - use NUOPC_Model, & + use ESMF + use NUOPC + use NUOPC_Model, & model_routine_SS => SetServices, & model_label_Advance => label_Advance, & model_label_DataInitialize => label_DataInitialize, & @@ -456,7 +456,7 @@ module mom_cap_mod logical :: grid_attach_area = .false. character(len=128) :: scalar_field_name integer :: scalar_field_count - integer :: scalar_field_idx_grid_nx + integer :: scalar_field_idx_grid_nx integer :: scalar_field_idx_grid_ny character(len=*),parameter :: u_file_u = & __FILE__ @@ -578,23 +578,23 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + write_diagnostics = .false. call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") - + write(logmsg,*) write_diagnostics call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return profile_memory = .false. call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & @@ -602,14 +602,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) profile_memory=(trim(value)=="true") write(logmsg,*) profile_memory call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return grid_attach_area = .false. call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & @@ -617,14 +617,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") write(logmsg,*) grid_attach_area call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return scalar_field_name = "" call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & @@ -632,14 +632,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - if (isPresent .and. isSet) then + return + if (isPresent .and. isSet) then scalar_field_name = trim(value) call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_count = 0 @@ -648,7 +648,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then @@ -662,7 +662,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_nx = 0 @@ -671,7 +671,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then @@ -685,7 +685,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_ny = 0 @@ -694,7 +694,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then @@ -708,16 +708,16 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - call NUOPC_CompAttributeAdd(gcomp, & + call NUOPC_CompAttributeAdd(gcomp, & attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + end subroutine !=============================================================================== @@ -766,10 +766,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: userRc character(len=512) :: restartfile ! Path/Name of restart file character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' - real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_frzmlt - real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdx - real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdy -!-------------------------------- + !-------------------------------- rc = ESMF_SUCCESS @@ -777,7 +774,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer @@ -830,11 +827,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! rsd need to figure out how to get this without share code !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - !inst_name = "OCN"//trim(inst_suffix) + !inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & isPresent=isPresentDiro, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -845,7 +842,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresentDiro .and. isPresentLogfile) then open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else @@ -856,7 +853,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif starttype = "" - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -870,7 +867,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif runtype = "" @@ -884,7 +881,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//": unknown starttype - "//trim(starttype), & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return endif if (len_trim(runtype) > 0) then @@ -892,9 +889,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + restartfile = "" if (runtype == "initial") then ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml @@ -917,36 +914,36 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then restartfile = trim(cvalue) call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return else - call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & ESMF_LOGMSG_WARNING, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif end if - + ocean_public%is_ocean_pe = .true. if (len_trim(restartfile) > 0) then - call ocean_model_init(ocean_public, ocean_state, Time, Time, & + call ocean_model_init(ocean_public, ocean_state, Time, Time, & input_restart_file=trim(restartfile)) else call ocean_model_init(ocean_public, ocean_state, Time, Time) @@ -1011,7 +1008,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -1023,7 +1020,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -1040,7 +1037,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -1106,18 +1103,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC ! EMC fields not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") ! not in CESM + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") ! not in CESM + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") ! not in CESM ! Optional CESM fields currently not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") ! not in EMC + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -1179,18 +1177,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide",& data=ocean_public%sea_lev) - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& - ! data=ocean_public%frazil) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide",& - data=Ocean_public%frazil) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide",& - data=Ocean_public%melt_potential) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential", "will provide", & - data=dataPtr_frzmlt) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide",& - data=ocean_public%frazil) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide",& - data=ocean_public%frazil) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& + data=ocean_public%frazil) #endif @@ -1315,7 +1303,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- @@ -1336,7 +1324,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return - + !--------------------------------- ! get start and end indices of each tile and their PET !--------------------------------- @@ -1351,10 +1339,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return enddo end if - + !--------------------------------- ! create delayout and distgrid @@ -1437,7 +1425,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1449,9 +1437,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return deallocate(IndexList) - + !--------------------------------- ! create grid !--------------------------------- @@ -1742,7 +1730,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1795,7 +1783,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out - + end subroutine InitializeRealize !=============================================================================== @@ -1926,7 +1914,6 @@ subroutine ModelAdvance(gcomp, rc) integer :: dth, dtm, dts, dt_cpld = 86400 integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 integer :: i,j,i1,j1 - real :: slp_L, slp_R, slp_C, slope, u_min, u_max !JW integer :: nc type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute @@ -1940,22 +1927,12 @@ subroutine ModelAdvance(gcomp, rc) real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_melt_potential(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_frzmlt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) !JW - real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) !JW real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) - real(ESMF_KIND_R8), allocatable :: ssh(:,:) - real(ESMF_KIND_R8), allocatable :: sshx(:,:) - real(ESMF_KIND_R8), allocatable :: sshy(:,:) #endif type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' - ! helper flag for debugging bounds - logical :: BoundsDebug = .false. - integer :: ijloc(2) !-------------------------------- rc = ESMF_SUCCESS @@ -2044,7 +2021,6 @@ subroutine ModelAdvance(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) #ifdef CESMCOUPLED - call shr_file_setLogUnit (logunit) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) @@ -2052,9 +2028,7 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - #else - call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2107,7 +2081,7 @@ subroutine ModelAdvance(gcomp, rc) mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -2140,7 +2114,6 @@ subroutine ModelAdvance(gcomp, rc) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") #ifdef CESMCOUPLED - call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2178,175 +2151,14 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - !call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! fixfrzmlt !JW - call State_getFldPtr(exportState,'accum_heat_frazil',dataPtr_frazil,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'inst_melt_potential',dataPtr_melt_potential,rc=rc) + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frzmlt,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'sea_surface_slope_zonal',dataPtr_dhdx,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'sea_surface_slope_merid',dataPtr_dhdy,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out !JW - - allocate( ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - allocate(sshx(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - allocate(sshy(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - ssh = 0.0_ESMF_KIND_R8 !JW - sshx = 0.0_ESMF_KIND_R8 !JW - sshy = 0.0_ESMF_KIND_R8 !JW - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! note: the following code is modified from NCAR nuopc driver mom_cap_methods - ! where is the rotation in that system? - ! - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - ! - ! here, isc,iec,jsc,jec are global indices on cap domain (no halos) - - do j=jsc,jec - do i=isc,iec - j1 = j - ocean_grid%jdg_offset - i1 = i - ocean_grid%idg_offset - ssh(i1,j1) = Ocean_public%sea_lev(i,j) - end do - end do - - ! Update halo of ssh so we can calculate gradients - call pass_var(ssh, ocean_grid%domain) - - ! calculation of slope on native mom domains (local indexing, halos) - ! stay inside of halos (ie 2:79,2:97) - ! d/dx ssh - do j = ocean_grid%jsd+1,ocean_grid%jed-1 - do i = ocean_grid%isd+1,ocean_grid%ied-1 - ! This is a simple second-order difference - !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) - if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(i,j) - if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - sshx(i,j) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 - end do - end do - - ! d/dy ssh - do j = ocean_grid%jsd+1,ocean_grid%jed-1 - do i = ocean_grid%isd+1,ocean_grid%ied-1 - ! This is a simple second-order difference - !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) - if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) - if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - sshy(i,j) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 - end do - end do - ! rotate slopes from tripolar grid back to lat/lon grid (CCW) - ! "grid" uses the usual MOM domain that has halos - ! and does not use global indexing. - ! x,y => latlon - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j + ocean_grid%jsc - lbnd2 - i1 = i + ocean_grid%isc - lbnd1 - dataPtr_dhdx(i,j) = ocean_grid%cos_rot(i1,j1)*sshx(i1,j1) & - + ocean_grid%sin_rot(i1,j1)*sshy(i1,j1) - dataPtr_dhdy(i,j) = ocean_grid%cos_rot(i1,j1)*sshy(i1,j1) & - - ocean_grid%sin_rot(i1,j1)*sshx(i1,j1) - enddo - enddo - deallocate(ssh); deallocate(sshx); deallocate(sshy) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - dataPtr_melt_potential = -dataPtr_melt_potential/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - !melt_potential, defined positive for T>Tfreeze - !so change sign - !testing - ijloc = maxloc(dataPtr_frazil) - if((sum(ijloc) .gt. 2) .and. & - (dataPtr_frazil(ijloc(1),ijloc(2)) .gt. 0.0))then - i1 = ijloc(1) - lbnd1 + isc - j1 = ijloc(2) - lbnd2 + jsc ! work around local vs global indexing - write (msgString,*)' MOM6 dataPtr_frazil at maxloc ',i1,j1,& - real(dataPtr_frazil(ijloc(1),ijloc(2)),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - write (msgString,*)' MOM6 dataPtr_melt_potential at maxloc ',i1,j1,& - real(dataPtr_melt_potential(ijloc(1),ijloc(2)),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - endif - !testing - - dataPtr_melt_potential = min(dataPtr_melt_potential,0.0) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - if(dataPtr_frazil(i,j) .eq. 0.0)then - dataPtr_frzmlt(i,j) = dataPtr_melt_potential(i,j) - else - dataPtr_frzmlt(i,j) = dataPtr_frazil(i,j) - endif - enddo - enddo - dataPtr_frzmlt = max(-1000.0,min(1000.0,dataPtr_frzmlt)) - ! rotate ocn current from tripolar grid back to lat/lon grid (CCW) - ! "grid" uses the usual MOM domain that has halos - ! and does not use global indexing. - ! x,y => latlon ocz = dataPtr_ocz ocm = dataPtr_ocm do j = lbnd2, ubnd2 @@ -2365,26 +2177,26 @@ subroutine ModelAdvance(gcomp, rc) deallocate(ocz, ocm) #endif - + ! If restart alarm is ringing - write restart file call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + ! call into system specific method to get desired restart filename restartname = "" call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & @@ -2418,7 +2230,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out endif endif - + if (len_trim(restartname) == 0) then ! none provided, so use a default restart filename call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) @@ -2432,7 +2244,7 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & "ocn", year, month, day, hour, minute, seconds call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2440,15 +2252,15 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out endif - + ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) - + if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) end if endif - + if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -2458,9 +2270,9 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out export_slice = export_slice + 1 endif - + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - + end subroutine ModelAdvance !=============================================================================== @@ -2542,9 +2354,9 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- + !-------------------------------- ! defaults restart_n = 0 @@ -2578,7 +2390,7 @@ subroutine ModelSetRunClock(gcomp, rc) else restart_option = "none" endif - + call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & @@ -2590,21 +2402,21 @@ subroutine ModelSetRunClock(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out first_time = .false. - - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + end if !-------------------------------- @@ -2725,7 +2537,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name + character(len=*), intent(in) :: scalar_name integer, intent(in) :: scalar_count integer, intent(inout) :: rc @@ -2823,14 +2635,14 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + ! initialize to zero call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - fldptr = 0.0 + fldptr = 0.0 endif diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 34946cefdb..6e3558efc5 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,10 +1,8 @@ module mom_cap_methods - use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet - use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalTeg - use ESMF, only: ESMF_State, ESMF_StateGet + use ESMF, only: ESMF_time, ESMF_ClockGet, ESMF_TimeGet, ESMF_State, ESMF_Clock use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError - use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_FieldGet + use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_StateGet, ESMF_FieldGet use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type @@ -49,7 +47,6 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices integer :: lbnd1, lbnd2 real :: slp_L, slp_R, slp_C, slope, u_min, u_max - real :: I_time_int !< The inverse of coupling time interval in s-1. integer :: day, secs type(ESMF_time) :: currTime real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) @@ -61,8 +58,6 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) - type(ESMF_TimeInterval) :: timeStep - integer :: dt_int !< time over which to advance the ocean (ocean_coupling_time_step), in sec character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*), parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- @@ -121,23 +116,6 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - ! Use Adcroft's rule of reciprocals; it does the right thing here. - call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (real(dt_int) > 0.0) then - I_time_int = 1.0 / real(dt_int) - else - I_time_int = 0.0 - end if - ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. ! The mask comes from "grid" that uses the usual MOM domain that has halos ! and does not use global indexing. @@ -154,20 +132,10 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) dataPtr_q(i1,j1) = 0. dataPtr_bldepth(i1,j1) = 0. ! TODO: this needs to be generalized - - ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 - if (ocn_public%frazil(ig,jg) > 0.0) then - ! Frazil: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(i1,j1) = ocn_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int - else - ! Melt_potential: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(i1,j1) = -ocn_public%melt_potential(i,j) * grid%mask2dT(ig,jg) * I_time_int !* ncouple_per_day - - ! make sure Melt_potential is always <= 0 - if (dataPtr_Fioo_q(i1,j1) > 0.0) then - dataPtr_Fioo_q(i1,j1) = 0.0 - endif - end if + !dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & + ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) + !dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & + ! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) end do end do diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 new file mode 100644 index 0000000000..f009a72e8e --- /dev/null +++ b/config_src/nuopc_driver/time_utils.F90 @@ -0,0 +1,161 @@ +module time_utils_mod + + use fms_mod, only: uppercase + use mpp_mod, only: mpp_error, FATAL + use time_manager_mod, only: time_type, set_time, set_date, get_date + use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR + use time_manager_mod, only: fms_get_calendar_type => get_calendar_type + use ESMF + + implicit none + private + + !-------------------- interface blocks --------------------- + interface fms2esmf_cal + module procedure fms2esmf_cal_c + module procedure fms2esmf_cal_i + end interface fms2esmf_cal + interface esmf2fms_time + module procedure esmf2fms_time_t + module procedure esmf2fms_timestep + end interface esmf2fms_time + + public fms2esmf_cal + public esmf2fms_time + public fms2esmf_time + public string_to_date + + contains + + !-------------------- module code --------------------- + + function fms2esmf_cal_c(calendar) +! ! Return Value: + type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c +! ! Arguments: + character(len=*), intent(in) :: calendar + + select case( uppercase(trim(calendar)) ) + case( 'GREGORIAN' ) + fms2esmf_cal_c = ESMF_CALKIND_GREGORIAN + case( 'JULIAN' ) + fms2esmf_cal_c = ESMF_CALKIND_JULIAN + case( 'NOLEAP' ) + fms2esmf_cal_c = ESMF_CALKIND_NOLEAP + case( 'THIRTY_DAY' ) + fms2esmf_cal_c = ESMF_CALKIND_360DAY + case( 'NO_CALENDAR' ) + fms2esmf_cal_c = ESMF_CALKIND_NOCALENDAR + case default + call mpp_error(FATAL, & + 'ocean_solo: ocean_solo_nml entry calendar must be one of GREGORIAN|JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) + end select + end function fms2esmf_cal_c + + function fms2esmf_cal_i(calendar) +! ! Return Value: + type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i +! ! Arguments: + integer, intent(in) :: calendar + + select case(calendar) + case(THIRTY_DAY_MONTHS) + fms2esmf_cal_i = ESMF_CALKIND_360DAY + case(GREGORIAN) + fms2esmf_cal_i = ESMF_CALKIND_GREGORIAN + case(JULIAN) + fms2esmf_cal_i = ESMF_CALKIND_JULIAN + case(NOLEAP) + fms2esmf_cal_i = ESMF_CALKIND_NOLEAP + case(NO_CALENDAR) + fms2esmf_cal_i = ESMF_CALKIND_NOCALENDAR + end select + end function fms2esmf_cal_i + + function esmf2fms_time_t(time) + ! Return Value + type(Time_type) :: esmf2fms_time_t + ! Input Arguments + type(ESMF_Time), intent(in) :: time + ! Local Variables + integer :: yy, mm, dd, h, m, s + type(ESMF_CALKIND_FLAG) :: calkind + + integer :: rc + + call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, & + calkindflag=calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + esmf2fms_time_t = Set_date(yy, mm, dd, h, m, s) + + end function esmf2fms_time_t + + function esmf2fms_timestep(timestep) + ! Return Value + type(Time_type) :: esmf2fms_timestep + ! Input Arguments + type(ESMF_TimeInterval), intent(in):: timestep + ! Local Variables + integer :: s + type(ESMF_CALKIND_FLAG) :: calkind + + integer :: rc + + call ESMF_TimeIntervalGet(timestep, s=s, calkindflag=calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + esmf2fms_timestep = set_time(s, 0) + + end function esmf2fms_timestep + + function fms2esmf_time(time, calkind) + ! Return Value + type(ESMF_Time) :: fms2esmf_time + ! Input Arguments + type(Time_type), intent(in) :: time + type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind + ! Local Variables + integer :: yy, mm, d, h, m, s + type(ESMF_CALKIND_FLAG) :: l_calkind + + integer :: rc + + if(present(calkind)) then + l_calkind = calkind + else + l_calkind = fms2esmf_cal(fms_get_calendar_type()) + endif + + call get_date(time, yy, mm, d, h, m, s) + + call ESMF_TimeSet(fms2esmf_time, yy=yy, mm=mm, d=d, h=h, m=m, s=s, & + calkindflag=l_calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end function fms2esmf_time + + function string_to_date(string, rc) + character(len=15), intent(in) :: string + integer, intent(out), optional :: rc + type(time_type) :: string_to_date + + integer :: yr,mon,day,hr,min,sec + + if(present(rc)) rc = ESMF_SUCCESS + + read(string, '(I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') yr, mon, day, hr, min, sec + string_to_date = set_date(yr, mon, day, hr, min, sec) + + end function string_to_date + +end module time_utils_mod From 0229d1d92f303e50ba06085233d0e3ad2aa355ae Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 4 Dec 2018 11:38:31 -0700 Subject: [PATCH 10/77] modifications to have nuopc cap working with latest dev/ncar code base --- config_src/nuopc_driver/MOM_ocean_model.F90 | 67 +++- config_src/nuopc_driver/mom_cap.F90 | 364 +++++++++++++++----- config_src/nuopc_driver/mom_cap_methods.F90 | 50 ++- 3 files changed, 369 insertions(+), 112 deletions(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 17d66789b5..3d44587832 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -121,7 +121,9 @@ module MOM_ocean_model !! i.e. dzt(1) + eta_t + patm/rho0/grav (m) frazil =>NULL(), & !< Accumulated heating (in Joules/m^2) from frazil !! formation in the ocean. - area => NULL() !< cell area of the ocean surface, in m2. + melt_potential => NULL(), & !< Instantaneous heat used to melt sea ice (in J/m^2) + area => NULL(), & !< cell area of the ocean surface, in m2. + OBLD => NULL() !< Ocean boundary layer depth, in m. type(coupler_2d_bc_type) :: fields !< A structure that may contain named !! arrays of tracer-related surface fields. integer :: avg_kount !< A count of contributions to running @@ -242,6 +244,12 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! Local variables real :: Rho0 ! The Boussinesq ocean density, in kg m-3. real :: G_Earth ! The gravitational acceleration in m s-2. + real :: HFrz !< If HFrz > 0 (m), melt potential will be computed. + !! The actual depth over which melt potential is computed will + !! min(HFrz, OBLD), where OBLD is the boundary layer depth. + !! If HFrz <= 0 (default), melt potential will not be computed. + logical :: use_melt_pot!< If true, allocate melt_potential array + ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "ocean_model_init" ! This module's name. @@ -343,10 +351,22 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i OS%press_to_z = 1.0/(Rho0*G_Earth) + call get_param(param_file, mdl, "HFREEZE", HFrz, & + "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& + "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//& + "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//& + "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) + + if (HFrz .gt. 0.0) then + use_melt_pot=.true. + else + use_melt_pot=.false. + endif + ! Consider using a run-time flag to determine whether to do the diagnostic ! vertical integrals, since the related 3-d sums are not negligible in cost. call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, & - do_integrals=.true., gas_fields_ocn=gas_fields_ocn) + do_integrals=.true., gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot) call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) @@ -636,8 +656,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%nstep = OS%nstep + 1 call enable_averaging(dt_coupling, OS%Time, OS%diag) - call mech_forcing_diags(OS%forces, OS%fluxes, dt_coupling, OS%grid, & - OS%diag, OS%forcing_CSp%handles) + call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles) + !TODO: this came in for the merge and is not consistent with the MOA branch + !call mech_forcing_diags(OS%forces, OS%fluxes, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles) + call disable_averaging(OS%diag) if (OS%fluxes%fluxes_used) then @@ -797,6 +819,8 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf (isc:iec,jsc:jec), & Ocean_sfc%sea_lev(isc:iec,jsc:jec), & Ocean_sfc%area (isc:iec,jsc:jec), & + Ocean_sfc%OBLD (isc:iec,jsc:jec), & + Ocean_sfc%melt_potential(isc:iec,jsc:jec), & Ocean_sfc%frazil (isc:iec,jsc:jec)) Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model @@ -805,6 +829,8 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model + Ocean_sfc%melt_potential = 0.0 ! time accumulated melt potential (J/m^2) passed to ice model + Ocean_sfc%OBLD = 0.0 ! ocean boundary layer depth, in m Ocean_sfc%area = 0.0 Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics @@ -889,6 +915,18 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z enddo ; enddo endif + if (allocated(sfc_state%melt_potential)) then + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%melt_potential(i,j) = sfc_state%melt_potential(i+i0,j+j0) + enddo ; enddo + endif + + if (allocated(sfc_state%Hml)) then + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%OBLD(i,j) = sfc_state%Hml(i+i0,j+j0) + enddo ; enddo + endif + if (Ocean_sfc%stagger == AGRID) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%u_surf(i,j) = G%mask2dT(i+i0,j+j0) * & @@ -1057,25 +1095,25 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) case('btfHeat') array2D(isc:,jsc:) = 0 case('tlat') - array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) case('tlon') - array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) case('ulat') - array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) case('ulon') - array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) case('vlat') - array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) case('vlon') - array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) case('geoLatBu') - array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) case('geoLonBu') - array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) case('cos_rot') - array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 case('sin_rot') - array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 + array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 case default call MOM_error(FATAL,'get_ocean_grid_data2D: unknown argument name='//name) end select @@ -1121,6 +1159,7 @@ subroutine ocean_public_type_chksum(id, timestep, ocn) write(outunit,100) 'ocean%v_surf ',mpp_chksum(ocn%v_surf ) write(outunit,100) 'ocean%sea_lev ',mpp_chksum(ocn%sea_lev) write(outunit,100) 'ocean%frazil ',mpp_chksum(ocn%frazil ) + write(outunit,100) 'ocean%melt_potential ',mpp_chksum(ocn%melt_potential) call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%') 100 FORMAT(" CHECKSUM::",A20," = ",Z20) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index eb8c003945..8e083fbe55 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -404,9 +404,9 @@ module mom_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit - use ESMF - use NUOPC - use NUOPC_Model, & + use ESMF + use NUOPC + use NUOPC_Model, & model_routine_SS => SetServices, & model_label_Advance => label_Advance, & model_label_DataInitialize => label_DataInitialize, & @@ -456,7 +456,7 @@ module mom_cap_mod logical :: grid_attach_area = .false. character(len=128) :: scalar_field_name integer :: scalar_field_count - integer :: scalar_field_idx_grid_nx + integer :: scalar_field_idx_grid_nx integer :: scalar_field_idx_grid_ny character(len=*),parameter :: u_file_u = & __FILE__ @@ -578,23 +578,23 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + write_diagnostics = .false. call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") - + write(logmsg,*) write_diagnostics call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return profile_memory = .false. call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & @@ -602,14 +602,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) profile_memory=(trim(value)=="true") write(logmsg,*) profile_memory call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return grid_attach_area = .false. call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & @@ -617,14 +617,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") write(logmsg,*) grid_attach_area call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return scalar_field_name = "" call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & @@ -632,14 +632,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - if (isPresent .and. isSet) then + return + if (isPresent .and. isSet) then scalar_field_name = trim(value) call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_count = 0 @@ -648,7 +648,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then @@ -662,7 +662,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_nx = 0 @@ -671,7 +671,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then @@ -685,7 +685,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_ny = 0 @@ -694,7 +694,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then @@ -708,16 +708,16 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - call NUOPC_CompAttributeAdd(gcomp, & + call NUOPC_CompAttributeAdd(gcomp, & attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + end subroutine !=============================================================================== @@ -766,7 +766,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: userRc character(len=512) :: restartfile ! Path/Name of restart file character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' - !-------------------------------- + real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_frzmlt + real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdx + real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdy +!-------------------------------- rc = ESMF_SUCCESS @@ -774,7 +777,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer @@ -827,11 +830,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! rsd need to figure out how to get this without share code !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - !inst_name = "OCN"//trim(inst_suffix) + !inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & isPresent=isPresentDiro, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -842,7 +845,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresentDiro .and. isPresentLogfile) then open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else @@ -853,7 +856,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif starttype = "" - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -867,7 +870,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif runtype = "" @@ -881,7 +884,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//": unknown starttype - "//trim(starttype), & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return endif if (len_trim(runtype) > 0) then @@ -889,9 +892,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + restartfile = "" if (runtype == "initial") then ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml @@ -914,36 +917,36 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then restartfile = trim(cvalue) call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return else - call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & ESMF_LOGMSG_WARNING, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif end if - + ocean_public%is_ocean_pe = .true. if (len_trim(restartfile) > 0) then - call ocean_model_init(ocean_public, ocean_state, Time, Time, & + call ocean_model_init(ocean_public, ocean_state, Time, Time, & input_restart_file=trim(restartfile)) else call ocean_model_init(ocean_public, ocean_state, Time, Time) @@ -1008,7 +1011,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -1020,7 +1023,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -1037,7 +1040,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -1103,19 +1106,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential ! EMC fields not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") ! not in CESM - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") ! not in CESM + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") ! not in CESM ! Optional CESM fields currently not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -1177,8 +1179,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide",& data=ocean_public%sea_lev) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& - data=ocean_public%frazil) + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& + ! data=ocean_public%frazil) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide",& + data=Ocean_public%frazil) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide",& + data=Ocean_public%melt_potential) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential", "will provide", & + data=dataPtr_frzmlt) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide",& + data=ocean_public%frazil) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide",& + data=ocean_public%frazil) !JW #endif @@ -1303,7 +1315,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- @@ -1324,7 +1336,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return - + !--------------------------------- ! get start and end indices of each tile and their PET !--------------------------------- @@ -1339,10 +1351,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return enddo end if - + !--------------------------------- ! create delayout and distgrid @@ -1425,7 +1437,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1437,9 +1449,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return deallocate(IndexList) - + !--------------------------------- ! create grid !--------------------------------- @@ -1730,7 +1742,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1783,7 +1795,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out - + end subroutine InitializeRealize !=============================================================================== @@ -1914,6 +1926,7 @@ subroutine ModelAdvance(gcomp, rc) integer :: dth, dtm, dts, dt_cpld = 86400 integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 integer :: i,j,i1,j1 + real :: slp_L, slp_R, slp_C, slope, u_min, u_max !JW integer :: nc type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute @@ -1927,12 +1940,22 @@ subroutine ModelAdvance(gcomp, rc) real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_melt_potential(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_frzmlt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) !JW + real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) !JW real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) + real(ESMF_KIND_R8), allocatable :: ssh(:,:) + real(ESMF_KIND_R8), allocatable :: sshx(:,:) + real(ESMF_KIND_R8), allocatable :: sshy(:,:) #endif type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' + ! helper flag for debugging bounds + logical :: BoundsDebug = .false. + integer :: ijloc(2) !-------------------------------- rc = ESMF_SUCCESS @@ -2021,6 +2044,7 @@ subroutine ModelAdvance(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) #ifdef CESMCOUPLED + call shr_file_setLogUnit (logunit) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) @@ -2028,7 +2052,9 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out + #else + call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2081,7 +2107,7 @@ subroutine ModelAdvance(gcomp, rc) mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -2114,6 +2140,7 @@ subroutine ModelAdvance(gcomp, rc) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") #ifdef CESMCOUPLED + call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2151,14 +2178,175 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + !call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! fixfrzmlt !JW + call State_getFldPtr(exportState,'accum_heat_frazil',dataPtr_frazil,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'inst_melt_potential',dataPtr_melt_potential,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frzmlt,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_zonal',dataPtr_dhdx,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_merid',dataPtr_dhdy,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !JW + + allocate( ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + allocate(sshx(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + allocate(sshy(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + ssh = 0.0_ESMF_KIND_R8 !JW + sshx = 0.0_ESMF_KIND_R8 !JW + sshy = 0.0_ESMF_KIND_R8 !JW + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! note: the following code is modified from NCAR nuopc driver mom_cap_methods + ! where is the rotation in that system? + ! + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ! + ! here, isc,iec,jsc,jec are global indices on cap domain (no halos) + + do j=jsc,jec + do i=isc,iec + j1 = j - ocean_grid%jdg_offset + i1 = i - ocean_grid%idg_offset + ssh(i1,j1) = Ocean_public%sea_lev(i,j) + end do + end do + + ! Update halo of ssh so we can calculate gradients + call pass_var(ssh, ocean_grid%domain) + + ! calculation of slope on native mom domains (local indexing, halos) + ! stay inside of halos (ie 2:79,2:97) + ! d/dx ssh + do j = ocean_grid%jsd+1,ocean_grid%jed-1 + do i = ocean_grid%isd+1,ocean_grid%ied-1 + ! This is a simple second-order difference + !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) + if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(i,j) + if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + sshx(i,j) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 + end do + end do + + ! d/dy ssh + do j = ocean_grid%jsd+1,ocean_grid%jed-1 + do i = ocean_grid%isd+1,ocean_grid%ied-1 + ! This is a simple second-order difference + !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) + if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) + if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + sshy(i,j) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 + end do + end do + ! rotate slopes from tripolar grid back to lat/lon grid (CCW) + ! "grid" uses the usual MOM domain that has halos + ! and does not use global indexing. + ! x,y => latlon + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 + dataPtr_dhdx(i,j) = ocean_grid%cos_rot(i1,j1)*sshx(i1,j1) & + + ocean_grid%sin_rot(i1,j1)*sshy(i1,j1) + dataPtr_dhdy(i,j) = ocean_grid%cos_rot(i1,j1)*sshy(i1,j1) & + - ocean_grid%sin_rot(i1,j1)*sshx(i1,j1) + enddo + enddo + deallocate(ssh); deallocate(sshx); deallocate(sshy) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + dataPtr_melt_potential = -dataPtr_melt_potential/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + !melt_potential, defined positive for T>Tfreeze + !so change sign + !testing + ijloc = maxloc(dataPtr_frazil) + if((sum(ijloc) .gt. 2) .and. & + (dataPtr_frazil(ijloc(1),ijloc(2)) .gt. 0.0))then + i1 = ijloc(1) - lbnd1 + isc + j1 = ijloc(2) - lbnd2 + jsc ! work around local vs global indexing + write (msgString,*)' MOM6 dataPtr_frazil at maxloc ',i1,j1,& + real(dataPtr_frazil(ijloc(1),ijloc(2)),4) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + + write (msgString,*)' MOM6 dataPtr_melt_potential at maxloc ',i1,j1,& + real(dataPtr_melt_potential(ijloc(1),ijloc(2)),4) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + endif + !testing + + dataPtr_melt_potential = min(dataPtr_melt_potential,0.0) + + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + if(dataPtr_frazil(i,j) .eq. 0.0)then + dataPtr_frzmlt(i,j) = dataPtr_melt_potential(i,j) + else + dataPtr_frzmlt(i,j) = dataPtr_frazil(i,j) + endif + enddo + enddo + dataPtr_frzmlt = max(-1000.0,min(1000.0,dataPtr_frzmlt)) + ! rotate ocn current from tripolar grid back to lat/lon grid (CCW) + ! "grid" uses the usual MOM domain that has halos + ! and does not use global indexing. + ! x,y => latlon ocz = dataPtr_ocz ocm = dataPtr_ocm do j = lbnd2, ubnd2 @@ -2177,26 +2365,26 @@ subroutine ModelAdvance(gcomp, rc) deallocate(ocz, ocm) #endif - + ! If restart alarm is ringing - write restart file call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + ! call into system specific method to get desired restart filename restartname = "" call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & @@ -2230,7 +2418,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out endif endif - + if (len_trim(restartname) == 0) then ! none provided, so use a default restart filename call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) @@ -2244,7 +2432,7 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & "ocn", year, month, day, hour, minute, seconds call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2252,15 +2440,15 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out endif - + ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) - + if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) end if endif - + if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -2270,9 +2458,9 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out export_slice = export_slice + 1 endif - + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - + end subroutine ModelAdvance !=============================================================================== @@ -2354,9 +2542,9 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- + !-------------------------------- ! defaults restart_n = 0 @@ -2390,7 +2578,7 @@ subroutine ModelSetRunClock(gcomp, rc) else restart_option = "none" endif - + call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & @@ -2402,21 +2590,21 @@ subroutine ModelSetRunClock(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out first_time = .false. - - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + end if !-------------------------------- @@ -2537,7 +2725,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name + character(len=*), intent(in) :: scalar_name integer, intent(in) :: scalar_count integer, intent(inout) :: rc @@ -2635,14 +2823,14 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + ! initialize to zero call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - fldptr = 0.0 + fldptr = 0.0 endif diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 6e3558efc5..a7de74bb82 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,8 +1,10 @@ module mom_cap_methods - use ESMF, only: ESMF_time, ESMF_ClockGet, ESMF_TimeGet, ESMF_State, ESMF_Clock + use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet + use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet + use ESMF, only: ESMF_State, ESMF_StateGet use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError - use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_StateGet, ESMF_FieldGet + use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_FieldGet use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type @@ -47,6 +49,7 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices integer :: lbnd1, lbnd2 real :: slp_L, slp_R, slp_C, slope, u_min, u_max + real :: I_time_int !< The inverse of coupling time interval in s-1. integer :: day, secs type(ESMF_time) :: currTime real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) @@ -54,10 +57,12 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) real(ESMF_KIND_R8), pointer :: dataPtr_s(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_u(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_v(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_q(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fioo_q(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) + type(ESMF_TimeInterval) :: timeStep + integer :: dt_int !< time over which to advance the ocean (ocean_coupling_time_step), in sec character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*), parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- @@ -89,7 +94,7 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(exportState,"Fioo_q", dataPtr_q, rc=rc) + call State_getFldPtr(exportState,"Fioo_q", dataPtr_fioo_q, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -116,6 +121,23 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + ! Use Adcroft's rule of reciprocals; it does the right thing here. + call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (real(dt_int) > 0.0) then + I_time_int = 1.0 / real(dt_int) + else + I_time_int = 0.0 + end if + ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. ! The mask comes from "grid" that uses the usual MOM domain that has halos ! and does not use global indexing. @@ -130,12 +152,20 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_q(i1,j1) = 0. - dataPtr_bldepth(i1,j1) = 0. ! TODO: this needs to be generalized - !dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & - ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) - !dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & - ! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) + dataPtr_bldepth(i1,j1) = ocean_public%OBLD(i,j) * grid%mask2dT(ig,jg) + ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 + if (ocean_public%frazil(ig,jg) > 0.0) then + ! Frazil: change from J/m^2 to W/m^2 + dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int + else + ! Melt_potential: change from J/m^2 to W/m^2 + dataPtr_Fioo_q(i1,j1) = -ocean_public%melt_potential(i,j) * grid%mask2dT(ig,jg) * I_time_int !* ncouple_per_day + + ! make sure Melt_potential is always <= 0 + if (dataPtr_Fioo_q(i1,j1) > 0.0) then + dataPtr_Fioo_q(i1,j1) = 0.0 + endif + end if end do end do From eefd4dc81b7a849a463b76b1b1c4da3e19eff935 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 4 Dec 2018 15:25:34 -0700 Subject: [PATCH 11/77] removed trailing whitespace --- config_src/nuopc_driver/MOM_ocean_model.F90 | 9 +- config_src/nuopc_driver/mom_cap.F90 | 158 ++++++++++---------- 2 files changed, 83 insertions(+), 84 deletions(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 3d44587832..28ae82750a 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -352,10 +352,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i OS%press_to_z = 1.0/(Rho0*G_Earth) call get_param(param_file, mdl, "HFREEZE", HFrz, & - "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& - "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//& - "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//& - "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) + "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& + "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//& + "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//& + "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) if (HFrz .gt. 0.0) then use_melt_pot=.true. @@ -1176,4 +1176,3 @@ subroutine get_ocean_grid(OS, Gridp) end subroutine get_ocean_grid end module MOM_ocean_model - diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 8e083fbe55..14f92076e4 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -404,9 +404,9 @@ module mom_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit - use ESMF - use NUOPC - use NUOPC_Model, & + use ESMF + use NUOPC + use NUOPC_Model, & model_routine_SS => SetServices, & model_label_Advance => label_Advance, & model_label_DataInitialize => label_DataInitialize, & @@ -456,7 +456,7 @@ module mom_cap_mod logical :: grid_attach_area = .false. character(len=128) :: scalar_field_name integer :: scalar_field_count - integer :: scalar_field_idx_grid_nx + integer :: scalar_field_idx_grid_nx integer :: scalar_field_idx_grid_ny character(len=*),parameter :: u_file_u = & __FILE__ @@ -578,23 +578,23 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + write_diagnostics = .false. call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") - + write(logmsg,*) write_diagnostics call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return profile_memory = .false. call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & @@ -602,14 +602,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) profile_memory=(trim(value)=="true") write(logmsg,*) profile_memory call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return grid_attach_area = .false. call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & @@ -617,14 +617,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") write(logmsg,*) grid_attach_area call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return scalar_field_name = "" call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & @@ -632,14 +632,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - if (isPresent .and. isSet) then + return + if (isPresent .and. isSet) then scalar_field_name = trim(value) call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_count = 0 @@ -648,7 +648,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then @@ -662,7 +662,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_nx = 0 @@ -671,7 +671,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then @@ -685,7 +685,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_ny = 0 @@ -694,7 +694,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then @@ -708,16 +708,16 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - call NUOPC_CompAttributeAdd(gcomp, & + call NUOPC_CompAttributeAdd(gcomp, & attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + end subroutine !=============================================================================== @@ -768,7 +768,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_frzmlt real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdx - real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdy + real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdy !-------------------------------- rc = ESMF_SUCCESS @@ -777,7 +777,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer @@ -830,11 +830,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! rsd need to figure out how to get this without share code !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - !inst_name = "OCN"//trim(inst_suffix) + !inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & isPresent=isPresentDiro, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -845,7 +845,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresentDiro .and. isPresentLogfile) then open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else @@ -856,7 +856,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif starttype = "" - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -870,7 +870,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif runtype = "" @@ -884,7 +884,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//": unknown starttype - "//trim(starttype), & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return endif if (len_trim(runtype) > 0) then @@ -892,9 +892,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + restartfile = "" if (runtype == "initial") then ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml @@ -917,36 +917,36 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then restartfile = trim(cvalue) call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return else - call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & ESMF_LOGMSG_WARNING, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif end if - + ocean_public%is_ocean_pe = .true. if (len_trim(restartfile) > 0) then - call ocean_model_init(ocean_public, ocean_state, Time, Time, & + call ocean_model_init(ocean_public, ocean_state, Time, Time, & input_restart_file=trim(restartfile)) else call ocean_model_init(ocean_public, ocean_state, Time, Time) @@ -1011,7 +1011,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -1023,7 +1023,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -1040,7 +1040,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -1108,7 +1108,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential ! EMC fields not used @@ -1117,7 +1117,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Optional CESM fields currently not used ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -1315,7 +1315,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- @@ -1336,7 +1336,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return - + !--------------------------------- ! get start and end indices of each tile and their PET !--------------------------------- @@ -1351,10 +1351,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return enddo end if - + !--------------------------------- ! create delayout and distgrid @@ -1437,7 +1437,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1449,9 +1449,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return deallocate(IndexList) - + !--------------------------------- ! create grid !--------------------------------- @@ -1742,7 +1742,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1795,7 +1795,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out - + end subroutine InitializeRealize !=============================================================================== @@ -2107,7 +2107,7 @@ subroutine ModelAdvance(gcomp, rc) mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -2365,26 +2365,26 @@ subroutine ModelAdvance(gcomp, rc) deallocate(ocz, ocm) #endif - + ! If restart alarm is ringing - write restart file call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + ! call into system specific method to get desired restart filename restartname = "" call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & @@ -2418,7 +2418,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out endif endif - + if (len_trim(restartname) == 0) then ! none provided, so use a default restart filename call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) @@ -2432,7 +2432,7 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & "ocn", year, month, day, hour, minute, seconds call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2440,15 +2440,15 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out endif - + ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) - + if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) end if endif - + if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -2458,9 +2458,9 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out export_slice = export_slice + 1 endif - + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - + end subroutine ModelAdvance !=============================================================================== @@ -2542,9 +2542,9 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- + !-------------------------------- ! defaults restart_n = 0 @@ -2578,7 +2578,7 @@ subroutine ModelSetRunClock(gcomp, rc) else restart_option = "none" endif - + call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & @@ -2590,21 +2590,21 @@ subroutine ModelSetRunClock(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out first_time = .false. - - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + end if !-------------------------------- @@ -2725,7 +2725,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name + character(len=*), intent(in) :: scalar_name integer, intent(in) :: scalar_count integer, intent(inout) :: rc @@ -2823,14 +2823,14 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + ! initialize to zero call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - fldptr = 0.0 + fldptr = 0.0 endif From 0bc248cb279a2f57f27dcf24e29a06c1f71e2591 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 9 Dec 2018 11:58:48 -0700 Subject: [PATCH 12/77] identified source of restart problem - still needs to be resolved --- config_src/nuopc_driver/mom_cap_methods.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index a7de74bb82..26da8c8a56 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -156,15 +156,14 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 if (ocean_public%frazil(ig,jg) > 0.0) then ! Frazil: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int + ! NOTE: if this is uncommented - then restarts no longer work + !dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int else ! Melt_potential: change from J/m^2 to W/m^2 dataPtr_Fioo_q(i1,j1) = -ocean_public%melt_potential(i,j) * grid%mask2dT(ig,jg) * I_time_int !* ncouple_per_day ! make sure Melt_potential is always <= 0 - if (dataPtr_Fioo_q(i1,j1) > 0.0) then - dataPtr_Fioo_q(i1,j1) = 0.0 - endif + if (dataPtr_Fioo_q(i1,j1) > 0.0) dataPtr_Fioo_q(i1,j1) = 0.0 end if end do end do From cef6178d9252af9933aade4004f50e9fb236fe80 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 9 Dec 2018 16:06:29 -0700 Subject: [PATCH 13/77] rewrote unified cap to have nems import and export routines now in mom_cap_methods.F90 --- config_src/nuopc_driver/mom_cap.F90 | 853 ++++++-------------- config_src/nuopc_driver/mom_cap_methods.F90 | 345 ++++++-- 2 files changed, 563 insertions(+), 635 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 14f92076e4..ad19ae4df5 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -147,23 +147,22 @@ !! !! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) !! -!! Prior to this call, the cap performs a few steps: +!! Priori to the call to `update_ocean_model()`, the cap performs these steps !! - the `Time` and `Time_step_coupled` parameters, based on FMS types, are derived from the incoming ESMF clock !! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently !! inactive, but may be modified to read in import data from file or from an external coupler !! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field -!! - import fields are prepared: +!! - mom_import_cesm or mom_import_nems is called !! - the sign is reversed on `mean_evap_rate` and `mean_sensi_heat_flux` !! - momentum flux vectors are rotated to internal grid !! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` !! !! After the call to `update_ocean_model()`, the cap performs these steps: -!! - the `ocean_mask` export is set to match that of the internal MOM mask -!! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval -!! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid -!! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field -!! - a call is made to `external_coupler_sbc_after()` to update exports from an external coupler (currently an inactive -!! stub) +!! - mom_export_cesm or mom_export_nems is called +!! - the `ocean_mask` export is set to match that of the internal MOM mask +!! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval +!! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid +!! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field !! !! @subsubsection VectorRotations Vector Rotations !! @@ -397,10 +396,11 @@ module mom_cap_mod use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid use mom_cap_time, only: AlarmInit #ifdef CESMCOUPLED - use mom_cap_methods, only: mom_import, mom_export use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel #endif + use mom_cap_methods, only: mom_import_cesm, mom_export_cesm + use mom_cap_methods, only: mom_import_nems, mom_export_nems use, intrinsic :: iso_fortran_env, only: output_unit @@ -461,6 +461,12 @@ module mom_cap_mod character(len=*),parameter :: u_file_u = & __FILE__ +#ifdef CESMCOUPLED + logical :: cesm_coupled = .true. +#else + logical :: cesm_coupled = .false. +#endif + contains !=============================================================================== @@ -1000,199 +1006,166 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out -#ifdef CESMCOUPLED - - !--------- import fields ------------- - if (len_trim(scalar_field_name) > 0) then - call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC - endif - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - - ! EMC fields not used - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not in CESM - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") ! not in CESM - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not in CESM - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not in CESM - - ! CESM currently not used - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphidry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphodry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphiwet" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet1" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet2" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet3" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet4" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry1" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry2" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry3" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry4" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcphi" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcpho" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_flxdst" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "So_duu10n" , "will provide") - - ! Optional CESM fields currently not used - ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) flds_co2a - ! call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) flds_co2c - ! call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! if (flds_co2a .or. flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2prog" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2diag" , "will provide") - ! end if - ! call NUOPC_CompAttributeGet(gcomp, name='ice_ncat', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) ice_ncat - ! call ESMF_LogWrite('ice_ncat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) flds_i2o_per_cat - ! call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! if (flds_i2o_per_cat) then - ! do num = 1, ice_ncat - ! name = 'Si_ifrac_' // cnum - ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") - ! name = 'PFioi_swpen_ifrac_' // cnum - ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") - ! end do - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afrac" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afracr" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_afracr", "will provide") - ! end if - ! do n = 1,shr_string_listGetNum(ndep_fields) - ! call shr_string_listGetName(ndep_fields, n, name) - ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") - ! end do - - !--------- export fields ------------- - if (len_trim(scalar_field_name) > 0) then - call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") ! not in EMC - endif - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential - - ! EMC fields not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") ! not in CESM - - ! Optional CESM fields currently not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") ! not in EMC - ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") - ! end if + if (cesm_coupled) then + !--------- import fields ------------- + if (len_trim(scalar_field_name) > 0) then + call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC + endif + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface + + ! EMC fields not used + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not in CESM + + ! CESM currently not used + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphidry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphodry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphiwet" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet1" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet2" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet3" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet4" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry1" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry2" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry3" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry4" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcphi" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcpho" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_flxdst" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "So_duu10n" , "will provide") + + ! Optional CESM fields currently not used + ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) flds_co2a + ! call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) + ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) flds_co2c + ! call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) + ! if (flds_co2a .or. flds_co2c) then + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2prog" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2diag" , "will provide") + ! end if + ! call NUOPC_CompAttributeGet(gcomp, name='ice_ncat', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) ice_ncat + ! call ESMF_LogWrite('ice_ncat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) + ! call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) flds_i2o_per_cat + ! call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) + ! if (flds_i2o_per_cat) then + ! do num = 1, ice_ncat + ! name = 'Si_ifrac_' // cnum + ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") + ! name = 'PFioi_swpen_ifrac_' // cnum + ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") + ! end do + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afrac" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afracr" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_afracr", "will provide") + ! end if + ! do n = 1,shr_string_listGetNum(ndep_fields) + ! call shr_string_listGetName(ndep_fields, n, name) + ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") + ! end do + + !--------- export fields ------------- + if (len_trim(scalar_field_name) > 0) then + call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") ! not in EMC + endif + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential + + ! EMC fields not used + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") ! not in CESM + + ! Optional CESM fields currently not used + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") ! not in EMC + ! if (flds_co2c) then + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! end if -#else + else - ! This sets pointers of the fldsToOcn to the iceocean_boundary_type - ! Don't point directly into mom data YET (last field is optional in interface) - ! instead, create space for the field when it's "realized". - - !--------- import fields ------------- - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide",& - data=Ice_ocean_boundary%u_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide",& - data=Ice_ocean_boundary%v_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide",& - data=Ice_ocean_boundary%t_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide",& - data=Ice_ocean_boundary%q_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide",& - data=Ice_ocean_boundary%salt_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide",& - data=Ice_ocean_boundary%lw_flux ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide",& - data=Ice_ocean_boundary%sw_flux_vis_dir) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide",& - data=Ice_ocean_boundary%sw_flux_vis_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide",& - data=Ice_ocean_boundary%sw_flux_nir_dir) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide",& - data=Ice_ocean_boundary%sw_flux_nir_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide",& - data=Ice_ocean_boundary%lprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide",& - data=Ice_ocean_boundary%fprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide",& - data=Ice_ocean_boundary%runoff ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide",& - data=Ice_ocean_boundary%calving) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide",& - data=Ice_ocean_boundary%runoff_hflx ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide",& - data=Ice_ocean_boundary%calving_hflx) - call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide",& - data=Ice_ocean_boundary%p ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide",& - data=Ice_ocean_boundary%mi) - - !--------- export fields ------------- - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide",& - data=ocean_public%t_surf) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide",& - data=ocean_public%s_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide",& - data=ocean_public%u_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide",& - data=ocean_public%v_surf ) - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir" , "will provide") - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide",& - data=ocean_public%sea_lev) - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& - ! data=ocean_public%frazil) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide",& - data=Ocean_public%frazil) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide",& - data=Ocean_public%melt_potential) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential", "will provide", & - data=dataPtr_frzmlt) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide",& - data=ocean_public%frazil) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide",& - data=ocean_public%frazil) !JW + !--------- import fields ------------- + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") + + !--------- export fields ------------- + ! This sets pointers of the fldsFrOcn to the ocean_public data (unlike the cesm copy paradigm) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide", data=ocean_public%t_surf) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=ocean_public%s_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide", data=ocean_public%u_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide", data=ocean_public%v_surf ) + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=ocean_public%sea_lev) + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=ocean_public%frazil) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide", data=Ocean_public%frazil) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide", data=Ocean_public%melt_potential) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=dataPtr_frzmlt) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide", data=ocean_public%frazil) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide", data=ocean_public%frazil) !JW -#endif + end if do n = 1,fldsToOcn_num call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) @@ -1212,8 +1185,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end subroutine InitializeAdvertise - !=============================================================================== - +!=============================================================================== !> Called by NUOPC to realize import and export fields. "Realizing" a field !! means that its grid has been defined and an ESMF_Field object has been !! created and put into the import or export State. @@ -1817,6 +1789,7 @@ subroutine DataInitialize(gcomp, rc) type(ESMF_Field) :: field character(len=64),allocatable :: fieldNameList(:) character(len=*),parameter :: subname='(mom_cap:DataInitialize)' + !-------------------------------- ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) @@ -1836,13 +1809,13 @@ subroutine DataInitialize(gcomp, rc) ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call get_ocean_grid(ocean_state, ocean_grid) -#ifdef CESMCOUPLED - call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#endif + if (cesm_coupled) then + call mom_export_cesm(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1920,42 +1893,17 @@ subroutine ModelAdvance(gcomp, rc) type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() type(ocean_internalstate_wrapper) :: ocean_internalstate + type(ocean_grid_type) , pointer :: ocean_grid type(time_type) :: Time type(time_type) :: Time_step_coupled type(time_type) :: Time_restart_current integer :: dth, dtm, dts, dt_cpld = 86400 - integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 - integer :: i,j,i1,j1 - real :: slp_L, slp_R, slp_C, slope, u_min, u_max !JW integer :: nc type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute character(ESMF_MAXSTR) :: restartname, cvalue -#ifndef CESMCOUPLED - real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) - real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_melt_potential(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_frzmlt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) !JW - real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) !JW - real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) - real(ESMF_KIND_R8), allocatable :: ssh(:,:) - real(ESMF_KIND_R8), allocatable :: sshx(:,:) - real(ESMF_KIND_R8), allocatable :: sshy(:,:) -#endif - type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' - ! helper flag for debugging bounds - logical :: BoundsDebug = .false. - integer :: ijloc(2) !-------------------------------- rc = ESMF_SUCCESS @@ -2017,6 +1965,10 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out + !--------------- + ! Determine dt_cpld (needed for export) + !--------------- + call ESMF_TimeIntervalGet(timeStep, h=dth, m=dtm, s=dts, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2027,6 +1979,10 @@ subroutine ModelAdvance(gcomp, rc) Time_step_coupled = esmf2fms_time(timeStep) dt_cpld = dth*3600+dtm*60+dts + !--------------- + ! Write diagnostics for import + !--------------- + if(write_diagnostics) then call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & timeslice=import_slice, relaxedFlag=.true., rc=rc) @@ -2037,336 +1993,85 @@ subroutine ModelAdvance(gcomp, rc) import_slice = import_slice + 1 endif - ! rotate the lat/lon wind vector (CW) onto local tripolar coordinate system - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + !--------------- + ! Get ocean grid + !--------------- call get_ocean_grid(ocean_state, ocean_grid) -#ifdef CESMCOUPLED + !--------------- + ! Import data + !--------------- - call shr_file_setLogUnit (logunit) - - call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - -#else - - call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr_mask,1) - ubnd1 = ubound(dataPtr_mask,1) - lbnd2 = lbound(dataPtr_mask,2) - ubnd2 = ubound(dataPtr_mask,2) - - call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_merid_moment_flx',dataPtr_mmmf,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_evap_rate',dataPtr_evap,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_sensi_heat_flx',dataPtr_sensi,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - dataPtr_evap = - dataPtr_evap - dataPtr_sensi = - dataPtr_sensi - - print *, 'lbnd1,ubnd1,lbnd2,ubnd2', lbnd1, ubnd1, lbnd2, ubnd2 - - allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 -! j1 = j - lbnd2 + jsc ! work around local vs global indexing -! i1 = i - lbnd1 + isc - j1 = j + ocean_grid%jsc - lbnd2 - i1 = i + ocean_grid%isc - lbnd1 -! mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & -! + ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) -! mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & -! - ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) - mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) - mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) - enddo - enddo - dataPtr_mzmf = mzmf - dataPtr_mmmf = mmmf - deallocate(mzmf, mmmf) - - !Optionally write restart files when currTime-startTime is integer multiples of restart_interval -! if (restart_interval > 0 ) then -! time_elapsed = currTime - startTime -! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out -! n_interval = time_elapsed_sec / restart_interval -! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then -! time_restart_current = esmf2fms_time(currTime) -! timestamp = date_to_string(time_restart_current) -! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) -! write(*,*) 'calling ocean_model_restart' -! call ocean_model_restart(ocean_state, timestamp) -! endif -! endif -#endif + if (cesm_coupled) then + call shr_file_setLogUnit (logunit) + call mom_import_cesm(ocean_public, ocean_grid, importState, ice_ocean_boundary, & + logunit, runtype, clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + call mom_import_nems(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + !--------------- ! Update MOM6 + !--------------- + + ! Optionally write restart files when currTime-startTime is integer multiples of restart_interval + ! if (restart_interval > 0 ) then + ! time_elapsed = currTime - startTime + ! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! n_interval = time_elapsed_sec / restart_interval + ! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then + ! time_restart_current = esmf2fms_time(currTime) + ! timestamp = date_to_string(time_restart_current) + ! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) + ! write(*,*) 'calling ocean_model_restart' + ! call ocean_model_restart(ocean_state, timestamp) + ! endif + ! endif if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") -#ifdef CESMCOUPLED - - call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! reset shr logging to my original values - call shr_file_setLogUnit (output_unit) - -#else - - allocate(ofld(isc:iec,jsc:jec)) - - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - deallocate(ofld) - - ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) - allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) - - call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - !call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! fixfrzmlt !JW - call State_getFldPtr(exportState,'accum_heat_frazil',dataPtr_frazil,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'inst_melt_potential',dataPtr_melt_potential,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frzmlt,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'sea_surface_slope_zonal',dataPtr_dhdx,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'sea_surface_slope_merid',dataPtr_dhdy,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out !JW - - allocate( ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - allocate(sshx(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - allocate(sshy(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - ssh = 0.0_ESMF_KIND_R8 !JW - sshx = 0.0_ESMF_KIND_R8 !JW - sshy = 0.0_ESMF_KIND_R8 !JW - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! note: the following code is modified from NCAR nuopc driver mom_cap_methods - ! where is the rotation in that system? - ! - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - ! - ! here, isc,iec,jsc,jec are global indices on cap domain (no halos) - - do j=jsc,jec - do i=isc,iec - j1 = j - ocean_grid%jdg_offset - i1 = i - ocean_grid%idg_offset - ssh(i1,j1) = Ocean_public%sea_lev(i,j) - end do - end do - - ! Update halo of ssh so we can calculate gradients - call pass_var(ssh, ocean_grid%domain) - - ! calculation of slope on native mom domains (local indexing, halos) - ! stay inside of halos (ie 2:79,2:97) - ! d/dx ssh - do j = ocean_grid%jsd+1,ocean_grid%jed-1 - do i = ocean_grid%isd+1,ocean_grid%ied-1 - ! This is a simple second-order difference - !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) - if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(i,j) - if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - sshx(i,j) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 - end do - end do + !--------------- + ! Export Data + !--------------- - ! d/dy ssh - do j = ocean_grid%jsd+1,ocean_grid%jed-1 - do i = ocean_grid%isd+1,ocean_grid%ied-1 - ! This is a simple second-order difference - !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) - if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) - if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - sshy(i,j) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 - end do - end do - ! rotate slopes from tripolar grid back to lat/lon grid (CCW) - ! "grid" uses the usual MOM domain that has halos - ! and does not use global indexing. - ! x,y => latlon - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j + ocean_grid%jsc - lbnd2 - i1 = i + ocean_grid%isc - lbnd1 - dataPtr_dhdx(i,j) = ocean_grid%cos_rot(i1,j1)*sshx(i1,j1) & - + ocean_grid%sin_rot(i1,j1)*sshy(i1,j1) - dataPtr_dhdy(i,j) = ocean_grid%cos_rot(i1,j1)*sshy(i1,j1) & - - ocean_grid%sin_rot(i1,j1)*sshx(i1,j1) - enddo - enddo - deallocate(ssh); deallocate(sshx); deallocate(sshy) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - dataPtr_melt_potential = -dataPtr_melt_potential/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - !melt_potential, defined positive for T>Tfreeze - !so change sign - !testing - ijloc = maxloc(dataPtr_frazil) - if((sum(ijloc) .gt. 2) .and. & - (dataPtr_frazil(ijloc(1),ijloc(2)) .gt. 0.0))then - i1 = ijloc(1) - lbnd1 + isc - j1 = ijloc(2) - lbnd2 + jsc ! work around local vs global indexing - write (msgString,*)' MOM6 dataPtr_frazil at maxloc ',i1,j1,& - real(dataPtr_frazil(ijloc(1),ijloc(2)),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - write (msgString,*)' MOM6 dataPtr_melt_potential at maxloc ',i1,j1,& - real(dataPtr_melt_potential(ijloc(1),ijloc(2)),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - endif - !testing - - dataPtr_melt_potential = min(dataPtr_melt_potential,0.0) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - if(dataPtr_frazil(i,j) .eq. 0.0)then - dataPtr_frzmlt(i,j) = dataPtr_melt_potential(i,j) - else - dataPtr_frzmlt(i,j) = dataPtr_frazil(i,j) - endif - enddo - enddo - dataPtr_frzmlt = max(-1000.0,min(1000.0,dataPtr_frzmlt)) - - ! rotate ocn current from tripolar grid back to lat/lon grid (CCW) - ! "grid" uses the usual MOM domain that has halos - ! and does not use global indexing. - ! x,y => latlon - ocz = dataPtr_ocz - ocm = dataPtr_ocm - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j + ocean_grid%jsc - lbnd2 - i1 = i + ocean_grid%isc - lbnd1 - dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - + ocean_grid%sin_rot(i1,j1)*ocm(i,j) - dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - - ocean_grid%sin_rot(i1,j1)*ocz(i,j) - ! multiply by mask to zero out non-ocean points - dataPtr_ocz(i,j) = dataPtr_ocz(i,j) * dataPtr_mask(i,j) - dataPtr_ocm(i,j) = dataPtr_ocm(i,j) * dataPtr_mask(i,j) - enddo - enddo - deallocate(ocz, ocm) + if (cesm_coupled) then + call mom_export_cesm(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + call mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if -#endif + if (cesm_coupled) then + ! reset shr logging to my original values + call shr_file_setLogUnit (output_unit) + end if + !--------------- ! If restart alarm is ringing - write restart file + !--------------- + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2449,6 +2154,10 @@ subroutine ModelAdvance(gcomp, rc) end if endif + !--------------- + ! Write diagnostics + !--------------- + if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -2673,11 +2382,11 @@ subroutine ocean_model_finalize(gcomp, rc) return ! bail out Time = esmf2fms_time(currTime) -#ifdef CESMCOUPLED - call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) -#else - call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) -#endif + if (cesm_coupled) then + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) + else + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) + end if call field_manager_end() call fms_io_exit() @@ -2687,35 +2396,7 @@ subroutine ocean_model_finalize(gcomp, rc) end subroutine ocean_model_finalize - !==================================================================== - - subroutine State_GetFldPtr(ST, fldname, fldptr, rc) - type(ESMF_State) , intent(in) :: ST - character(len=*) , intent(in) :: fldname - real(ESMF_KIND_R8) , pointer, intent(in) :: fldptr(:,:) - integer , intent(out), optional :: rc - - ! local variables - type(ESMF_Field) :: lfield - integer :: lrc - character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - - call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (present(rc)) rc = lrc - - end subroutine State_GetFldPtr - - !----------------------------------------------------------------------------- +!=============================================================================== subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_count, rc) ! ---------------------------------------------- @@ -2756,7 +2437,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ end subroutine State_SetScalar - !----------------------------------------------------------------------------- +!=============================================================================== subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) @@ -2857,7 +2538,7 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) end subroutine MOM_RealizeFields - !----------------------------------------------------------------------------- +!=============================================================================== subroutine SetScalarField(field, rc) ! ---------------------------------------------- @@ -2889,7 +2570,7 @@ subroutine SetScalarField(field, rc) end subroutine SetScalarField - !----------------------------------------------------------------------------- +!=============================================================================== subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) ! ---------------------------------------------- @@ -2933,6 +2614,4 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) end subroutine fld_list_add - !----------------------------------------------------------------------------- - end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 26da8c8a56..e0ca9648c8 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,12 +1,18 @@ module mom_cap_methods + ! Cap import/export methods for both NEMS and CMEPS + + ! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` + ! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. + + use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF, only: ESMF_State, ESMF_StateGet - use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError - use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_FieldGet + use ESMF, only: ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError + use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE - use MOM_ocean_model, only: ocean_public_type, ocean_state_type + use MOM_ocean_model, only: ocean_public_type, ocean_state_type, ocean_model_data_get use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type use MOM_domains, only: pass_var @@ -18,25 +24,23 @@ module mom_cap_methods private ! Public member functions -#ifdef CESMCOUPLED - public :: mom_export - public :: mom_import -#endif + public :: mom_export_cesm + public :: mom_import_cesm + public :: mom_export_nems public :: mom_import_nems integer :: rc,dbrc integer :: import_cnt = 0 logical, parameter :: debug=.false. -!----------------------------------------------------------------------- +!=============================================================================== contains -!----------------------------------------------------------------------- +!=============================================================================== -#ifdef CESMCOUPLED !> Maps outgoing ocean data to ESMF State - !! See \ref section_mom_export for a summary of the data - !! that is transferred from MOM6 to MCT. - subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) + subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) + + ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid type(ESMF_State) , intent(inout) :: exportState !< outgoing data @@ -45,9 +49,9 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) integer , intent(inout) :: rc ! Local variables - real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo + real :: ssh(grid%isd:grid%ied,grid%jsd:grid%jed) !< Local copy of sea_lev with updated halo integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices - integer :: lbnd1, lbnd2 + integer :: lbnd1, lbnd2, ubnd1, ubnd2 real :: slp_L, slp_R, slp_C, slope, u_min, u_max real :: I_time_int !< The inverse of coupling time interval in s-1. integer :: day, secs @@ -156,8 +160,7 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 if (ocean_public%frazil(ig,jg) > 0.0) then ! Frazil: change from J/m^2 to W/m^2 - ! NOTE: if this is uncommented - then restarts no longer work - !dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int + ! dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int else ! Melt_potential: change from J/m^2 to W/m^2 dataPtr_Fioo_q(i1,j1) = -ocean_public%melt_potential(i,j) * grid%mask2dT(ig,jg) * I_time_int !* ncouple_per_day @@ -264,9 +267,9 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) end do end if - end subroutine mom_export + end subroutine mom_export_cesm -!----------------------------------------------------------------------- +!=============================================================================== !> This function has a few purposes: 1) it allocates and initializes the data !! in the fluxes structure; 2) it imports surface fluxes using data from @@ -274,7 +277,7 @@ end subroutine mom_export !! See \ref section_ocn_import for a summary of the surface fluxes that are !! passed from MCT to MOM6, including fluxes that need to be included in !! the future. - subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & + subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, & logunit, runtype, clock, rc) type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state @@ -500,25 +503,271 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & end do end if - end subroutine mom_import -#endif - !----------------------------------------------------------------------------- + end subroutine mom_import_cesm + +!=============================================================================== + + subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, exportState, rc) + + ! Input/output variables + type (ocean_state_type) , pointer :: ocean_state + type (ocean_public_type) , pointer :: ocean_public + type (ocean_grid_type) , pointer :: ocean_grid + integer , intent(in) :: dt_cpld + type(ESMF_State) , intent(inout) :: exportState !< outgoing data + integer , intent(out) :: rc + + ! Local variables + integer :: lbnd1, lbnd2, ubnd1, ubnd2 + integer :: i, j, i1, j1, ig, jg !< Grid indices + integer :: isc, iec, jsc, jec !< Grid indices + real :: slp_L, slp_R, slp_C, slope, u_min, u_max !JW + real(ESMF_KIND_R8), allocatable :: ofld(:,:) + real(ESMF_KIND_R8), allocatable :: ocz(:,:) + real(ESMF_KIND_R8), allocatable :: ocm(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_melt_potential(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_frzmlt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) !JW + real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) !JW + real(ESMF_KIND_R8), allocatable :: ssh(:,:) + real(ESMF_KIND_R8), allocatable :: sshx(:,:) + real(ESMF_KIND_R8), allocatable :: sshy(:,:) + integer :: ijloc(2) + character(len=240) :: msgString + !-------------------------------- + + call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + !call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! fixfrzmlt !JW + call State_getFldPtr(exportState,'accum_heat_frazil',dataPtr_frazil,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'inst_melt_potential',dataPtr_melt_potential,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frzmlt,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_zonal',dataPtr_dhdx,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_merid',dataPtr_dhdy,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !JW + + allocate( ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + allocate(sshx(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + allocate(sshy(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + ssh = 0.0_ESMF_KIND_R8 !JW + sshx = 0.0_ESMF_KIND_R8 !JW + sshy = 0.0_ESMF_KIND_R8 !JW + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! note: the following code is modified from NCAR nuopc driver mom_cap_methods + ! where is the rotation in that system? + ! + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ! + ! here, isc,iec,jsc,jec are global indices on cap domain (no halos) + + do j=jsc,jec + do i=isc,iec + j1 = j - ocean_grid%jdg_offset + i1 = i - ocean_grid%idg_offset + ssh(i1,j1) = Ocean_public%sea_lev(i,j) + end do + end do + + ! Update halo of ssh so we can calculate gradients + call pass_var(ssh, ocean_grid%domain) + + ! calculation of slope on native mom domains (local indexing, halos) + ! stay inside of halos (ie 2:79,2:97) + ! d/dx ssh + do j = ocean_grid%jsd+1,ocean_grid%jed-1 + do i = ocean_grid%isd+1,ocean_grid%ied-1 + ! This is a simple second-order difference + !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) + if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(i,j) + if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + sshx(i,j) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 + end do + end do + + ! d/dy ssh + do j = ocean_grid%jsd+1,ocean_grid%jed-1 + do i = ocean_grid%isd+1,ocean_grid%ied-1 + ! This is a simple second-order difference + !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) + if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) + if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + sshy(i,j) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 + end do + end do + ! rotate slopes from tripolar grid back to lat/lon grid (CCW) + ! "grid" uses the usual MOM domain that has halos + ! and does not use global indexing. + ! x,y => latlon + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 + dataPtr_dhdx(i,j) = ocean_grid%cos_rot(i1,j1)*sshx(i1,j1) & + + ocean_grid%sin_rot(i1,j1)*sshy(i1,j1) + dataPtr_dhdy(i,j) = ocean_grid%cos_rot(i1,j1)*sshy(i1,j1) & + - ocean_grid%sin_rot(i1,j1)*sshx(i1,j1) + enddo + enddo + deallocate(ssh); deallocate(sshx); deallocate(sshy) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + + dataPtr_melt_potential = -dataPtr_melt_potential/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + !melt_potential, defined positive for T>Tfreeze + !so change sign + !testing + ijloc = maxloc(dataPtr_frazil) + if((sum(ijloc) .gt. 2) .and. (dataPtr_frazil(ijloc(1),ijloc(2)) .gt. 0.0))then + i1 = ijloc(1) - lbnd1 + isc + j1 = ijloc(2) - lbnd2 + jsc ! work around local vs global indexing + + write (msgString,*)' MOM6 dataPtr_frazil at maxloc ',i1,j1,& + real(dataPtr_frazil(ijloc(1),ijloc(2)),4) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + + write (msgString,*)' MOM6 dataPtr_melt_potential at maxloc ',i1,j1,& + real(dataPtr_melt_potential(ijloc(1),ijloc(2)),4) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + endif + !testing + + dataPtr_melt_potential = min(dataPtr_melt_potential,0.0) + + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + if(dataPtr_frazil(i,j) .eq. 0.0)then + dataPtr_frzmlt(i,j) = dataPtr_melt_potential(i,j) + else + dataPtr_frzmlt(i,j) = dataPtr_frazil(i,j) + endif + enddo + enddo + dataPtr_frzmlt = max(-1000.0,min(1000.0,dataPtr_frzmlt)) + + ! rotate ocn current from tripolar grid back to lat/lon grid (CCW) + ! "grid" uses the usual MOM domain that has halos and does not use global indexing. + ! x,y => latlon + + allocate(ofld(isc:iec,jsc:jec)) + call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) + enddo + enddo + deallocate(ofld) - subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, rc) + allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) + allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) + ocz = dataPtr_ocz + ocm = dataPtr_ocm + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 + dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & + + ocean_grid%sin_rot(i1,j1)*ocm(i,j) + dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & + - ocean_grid%sin_rot(i1,j1)*ocz(i,j) + ! multiply by mask to zero out non-ocean points + dataPtr_ocz(i,j) = dataPtr_ocz(i,j) * dataPtr_mask(i,j) + dataPtr_ocm(i,j) = dataPtr_ocm(i,j) * dataPtr_mask(i,j) + enddo + enddo + deallocate(ocz, ocm) + + end subroutine mom_export_nems + +!=============================================================================== + + subroutine mom_import_nems(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc) + ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid + type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid type(ESMF_State) , intent(inout) :: importState !< incoming data type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing integer , intent(inout) :: rc ! Local Variables - integer :: i, j, i1, j1, ig, jg ! Grid indices - integer :: isc, iec, jsc, jec ! Grid indices - integer :: i0, j0, is, js, ie, je - integer :: lbnd1, lbnd2 - integer :: ubnd1, ubnd2 - real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) + integer :: lbnd1,ubnd1,lbnd2,ubnd2 + integer :: i, j, i1, j1, ig, jg ! Grid indices + integer :: isc, iec, jsc, jec ! Grid indices + integer :: i0, j0, is, js, ie, je ! Grid indices real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) @@ -538,7 +787,6 @@ subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, real(ESMF_KIND_R8), pointer :: dataPtr_calving_hflx(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_mi(:,:) - real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) integer :: day, secs type(ESMF_time) :: currTime @@ -548,22 +796,22 @@ subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, rc = ESMF_SUCCESS - call State_getFldPtr(importState,"mean_zonal_moment_flx", dataPtr_mzmf, rc=rc) + call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"mean_merid_moment_flx", dataPtr_mmmf, rc=rc) + call State_getFldPtr(importState,'mean_merid_moment_flx',dataPtr_mmmf,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"mean_sensi_heat_flx", dataPtr_sensi, rc=rc) + call State_getFldPtr(importState,'mean_evap_rate',dataPtr_evap,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"mean_evap_rate" , dataPtr_evap, rc=rc) + call State_getFldPtr(importState,'mean_sensi_heat_flx',dataPtr_sensi,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -573,12 +821,12 @@ subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndr, rc=rc) + call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndf, rc=rc) + call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndf, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -634,23 +882,24 @@ subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, file=__FILE__)) & return ! bail out + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + lbnd1 = lbound(dataPtr_p,1) ubnd1 = ubound(dataPtr_p,1) lbnd2 = lbound(dataPtr_p,2) ubnd2 = ubound(dataPtr_p,2) - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + print *, 'lbnd1,ubnd1,lbnd2,ubnd2', lbnd1, ubnd1, lbnd2, ubnd2 allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc - mzmf(i,j) = grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - + grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) - mmmf(i,j) = grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - - grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 + mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & + - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) + mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -685,7 +934,7 @@ subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, end subroutine mom_import_nems - !----------------------------------------------------------------------------- +!=============================================================================== subroutine State_GetFldPtr(ST, fldname, fldptr, rc) type(ESMF_State) , intent(in) :: ST From f0d557f2cf9e6a63168e62f9f169a00bbd03146e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 10 Dec 2018 12:39:59 -0700 Subject: [PATCH 14/77] more updates to get the nuopc and mct changes consistent --- .../nuopc_driver/MOM_surface_forcing.F90 | 139 ++++++++++++------ config_src/nuopc_driver/mom_cap.F90 | 46 +++--- config_src/nuopc_driver/mom_cap_methods.F90 | 48 +++--- 3 files changed, 149 insertions(+), 84 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 19a0ddbf86..cc8496a322 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -45,11 +45,15 @@ module MOM_surface_forcing #include -public convert_IOB_to_fluxes, convert_IOB_to_forces +public convert_IOB_to_fluxes +public convert_IOB_to_forces public surface_forcing_init -public ice_ocn_bnd_type_chksum public forcing_save_restart +public ice_ocn_bnd_type_chksum +private apply_flux_adjustments +private apply_force_adjustments +private surface_forcing_end ! surface_forcing_CS is a structure containing pointers to the forcing fields ! which may be used to drive MOM. All fluxes are positive downward. @@ -147,11 +151,13 @@ module MOM_surface_forcing type(user_revise_forcing_CS), pointer :: urf_CS => NULL() end type surface_forcing_CS - ! ice_ocean_boundary_type is a structure corresponding to forcing, but with ! the elements, units, and conventions that exactly conform to the use for ! MOM-based coupled models. type, public :: ice_ocean_boundary_type + real, pointer, dimension(:,:) :: latent_flux =>NULL() !< latent flux (W/m2) + real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff (W/m2) + real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff (W/m2) real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress (Pa) real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress (Pa) real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux (W/m2) @@ -190,7 +196,15 @@ module MOM_surface_forcing integer :: id_clock_forcing +#ifdef CESMCOUPLED + logical :: cesm_coupled = .true. +#else + logical :: cesm_coupled = .false. +#endif + +!======================================================================= contains +!======================================================================= !> This subroutine translates the Ice_ocean_boundary_type into a MOM !! thermodynamic forcing type, including changes of units, sign conventions, @@ -418,50 +432,75 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%q_flux)) & - fluxes%evap(i,j) = - IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%evap(i,j) = IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%runoff)) & - fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + ! Note: currently runoff is treated differently for nems and cesm coupling + if (cesm_coupled) then + ! liquid runoff flux + if (associated(fluxes%lrunoff)) & + fluxes%lrunoff(i,j) = G%mask2dT(i,j) * IOB%rofl_flux(i-i0,j-j0) - if (associated(IOB%calving)) & - fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + ! ice runoff flux + if (associated(fluxes%frunoff)) & + fluxes%frunoff(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0) - if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + ! GMM, cime does not not have an equivalent for heat_content_lrunoff and + ! heat_content_frunoff. I am seeting these to zero for now. + if (associated(IOB%runoff_hflx)) & + fluxes%heat_content_lrunoff(i,j) = 0.0 * G%mask2dT(i,j) - if (associated(IOB%area_berg)) & - fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%calving_hflx)) & + fluxes%heat_content_frunoff(i,j) = 0.0 * G%mask2dT(i,j) + else + if (associated(IOB%runoff)) & + fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%mass_berg)) & - fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%calving)) & + fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%ustar_berg)) & + fluxes%ustar_berg(i,j) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%area_berg)) & + fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%runoff_hflx)) & - fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%mass_berg)) & + fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%calving_hflx)) & - fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%runoff_hflx)) & + fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%calving_hflx)) & + fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + end if if (associated(IOB%lw_flux)) & fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%t_flux)) & - fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - - fluxes%latent(i,j) = 0.0 - if (associated(IOB%fprec)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_fprec_diag(i,j) = -G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion - endif - if (associated(IOB%calving)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - endif - if (associated(IOB%q_flux)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - endif + fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) + ! Note: currently latent heat flux is treated differently for nems and cesm + if (cesm_coupled) then + if (associated(IOB%latent_flux)) & + fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) + else + fluxes%latent(i,j) = 0.0 + if (associated(IOB%fprec)) then + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent_fprec_diag(i,j) = -G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion + endif + if (associated(IOB%calving)) then + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + endif + if (associated(IOB%q_flux)) then + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + endif + + fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) + end if if (associated(IOB%sw_flux_vis_dir)) & fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0) @@ -500,15 +539,15 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & enddo ; enddo endif -!### if (associated(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif + !### if (associated(CS%ctrl_forcing_CSp)) then + !### do j=js,je ; do i=is,ie + !### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) + !### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) + !### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) + !### enddo ; enddo + !### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & + !### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) + !### endif ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then @@ -560,6 +599,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & end subroutine convert_IOB_to_fluxes +!======================================================================= + !> This subroutine translates the Ice_ocean_boundary_type into a MOM !! mechanical forcing type, including changes of units, sign conventions, !! and putting the fields into arrays with MOM-standard halos. @@ -844,6 +885,8 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) call cpu_clock_end(id_clock_forcing) end subroutine convert_IOB_to_forces +!======================================================================= + !> Adds thermodynamic flux adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: @@ -889,6 +932,8 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) ! Not needed? ! if (overrode_h) call pass_var(fluxes%vprec, G%Domain) end subroutine apply_flux_adjustments +!======================================================================= + !> Adds mechanical forcing adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: @@ -947,6 +992,8 @@ subroutine apply_force_adjustments(G, CS, Time, forces) end subroutine apply_force_adjustments +!======================================================================= + !> Save any restart files associated with the surface forcing. subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) @@ -967,6 +1014,8 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart +!======================================================================= + !> Initialize the surface forcing, including setting parameters and allocating permanent memory. subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) type(time_type), intent(in) :: Time !< The current model time @@ -1299,6 +1348,8 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res call cpu_clock_end(id_clock_forcing) end subroutine surface_forcing_init +!======================================================================= + !> Clean up and deallocate any memory associated with this module and its children. subroutine surface_forcing_end(CS, fluxes) type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by @@ -1317,6 +1368,8 @@ subroutine surface_forcing_end(CS, fluxes) end subroutine surface_forcing_end +!======================================================================= + !> Write out a set of messages with checksums of the fields in an ice_ocen_boundary type subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index ad19ae4df5..d15b102b33 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -467,7 +467,9 @@ module mom_cap_mod logical :: cesm_coupled = .false. #endif +!======================================================================= contains +!======================================================================= !=============================================================================== !> NUOPC SetService method is the only public entry point. @@ -979,6 +981,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & Ice_ocean_boundary% mi (isc:iec,jsc:jec), & Ice_ocean_boundary% p (isc:iec,jsc:jec)) + if (cesm_coupled) then + allocate( Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% latent_flux (isc:iec,jsc:jec)) + end if Ice_ocean_boundary%u_flux = 0.0 Ice_ocean_boundary%v_flux = 0.0 @@ -998,6 +1005,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary%calving_hflx = 0.0 Ice_ocean_boundary%mi = 0.0 Ice_ocean_boundary%p = 0.0 + if (cesm_coupled) then + Ice_ocean_boundary%rofl_flux = 0.0 + Ice_ocean_boundary%rofi_flux = 0.0 + Ice_ocean_boundary%latent_flux = 0.0 + end if ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) @@ -1012,23 +1024,23 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (len_trim(scalar_field_name) > 0) then call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC endif - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr", "will provide") ! -> mean_net_sw_ir_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr", "will provide") ! -> mean_net_sw_vis_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf", "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf", "will provide") ! -> mean_net_sw_vis_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index e0ca9648c8..7ca7ab39ef 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -8,7 +8,7 @@ module mom_cap_methods use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF, only: ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + use ESMF, only: ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE @@ -300,7 +300,6 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, real(ESMF_KIND_R8), pointer :: dataPtr_sen(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_lat(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_osalt(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:,:) @@ -309,7 +308,7 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_iosalt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_salt(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) @@ -394,7 +393,7 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Fioi_salt" , dataPtr_iosalt, rc=rc) + call State_getFldPtr(importState,"Fioi_salt" , dataPtr_salt, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -430,23 +429,23 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, j1 = j + lbnd2 - jsc do i = isc, iec i1 = i + lbnd1 - isc - - ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) - ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) - ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) - ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) - ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1) - ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) - ice_ocean_boundary%salt_flux(i,j) = dataPtr_iosalt(i1,j1) - ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) - !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) - !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) + ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) ! surface pressure + ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) ! zonal surface stress - taux + ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) ! meridional surface stress - tauy + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) ! liquid precipitation (rain) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) ! frozen precipitation (snow) + ice_ocean_boundary%t_flux(i,j) = dataPtr_sen(i1,j1) ! sensible heat flux (W/m2) + ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) ! latent heat flux (W/m^2) + ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(i1,j1) ! specific humidity flux + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) & + + dataPtr_lwdn(i1,j1) ! longwave radiation, sum up and down (W/m2) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) ! visible, direct shortwave (W/m2) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) ! visible, diffuse shortwave (W/m2) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) ! near-IR, direct shortwave (W/m2) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) ! near-IR, diffuse shortwave (W/m2) + ice_ocean_boundary%rofl_flux(i,j) = dataPtr_rofl(i1,j1) ! ice runoff + ice_ocean_boundary%rofi_flux(i,j) = dataPtr_rofi(i1,j1) ! liquid runoff + ice_ocean_boundary%salt_flux(i,j) = -dataPtr_salt(i1,j1) ! salt flux (minus sign needed here -GMM) enddo enddo @@ -460,6 +459,7 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, ! GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) ! end do ! end do + end if ! debug output @@ -696,7 +696,7 @@ subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, expor write (msgString,*)' MOM6 dataPtr_frazil at maxloc ',i1,j1,& real(dataPtr_frazil(ijloc(1),ijloc(2)),4) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - + write (msgString,*)' MOM6 dataPtr_melt_potential at maxloc ',i1,j1,& real(dataPtr_melt_potential(ijloc(1),ijloc(2)),4) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) @@ -913,8 +913,8 @@ subroutine mom_import_nems(ocean_public, ocean_grid, importState, ice_ocean_boun ice_ocean_boundary%u_flux(i,j) = dataPtr_mzmf(i1,j1) ice_ocean_boundary%v_flux(i,j) = dataPtr_mmmf(i1,j1) - ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) - ice_ocean_boundary%t_flux(i,j) = -dataPtr_sensi(i1,j1) + ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(i1,j1) + ice_ocean_boundary%t_flux(i,j) = dataPtr_sensi(i1,j1) ice_ocean_boundary%salt_flux(i,j) = dataPtr_salt(i1,j1) ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwflux(i1,j1) ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) From 79cf0d03b2f6c7ee52f9f72bcbf14e9d8c6b934f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 10 Dec 2018 15:01:46 -0700 Subject: [PATCH 15/77] more updates to get mom6 working correctly --- .../nuopc_driver/MOM_surface_forcing.F90 | 66 ++++++++++--------- config_src/nuopc_driver/mom_cap_methods.F90 | 2 +- 2 files changed, 36 insertions(+), 32 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index cc8496a322..88848fc3c2 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -293,14 +293,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) - if (CS%use_limited_P_SSH) then - fluxes%p_surf_SSH => fluxes%p_surf - else - fluxes%p_surf_SSH => fluxes%p_surf_full - endif - + if (.not. cesm_coupled) then + call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) + if (CS%use_limited_P_SSH) then + fluxes%p_surf_SSH => fluxes%p_surf + else + fluxes%p_surf_SSH => fluxes%p_surf_full + endif + end if + call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) @@ -515,22 +517,24 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & enddo ; enddo - ! applied surface pressure from atmosphere and cryosphere - if (associated(IOB%p)) then - if (CS%max_p_surf >= 0.0) then - do j=js,je ; do i=is,ie - fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) - fluxes%p_surf(i,j) = MIN(fluxes%p_surf_full(i,j),CS%max_p_surf) - enddo ; enddo - else - do j=js,je ; do i=is,ie - fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) - fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) - enddo ; enddo - endif - fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. - endif - + if (.not. cesm_coupled) then + ! applied surface pressure from atmosphere and cryosphere + if (associated(IOB%p)) then + if (CS%max_p_surf >= 0.0) then + do j=js,je ; do i=is,ie + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf(i,j) = MIN(fluxes%p_surf_full(i,j),CS%max_p_surf) + enddo; enddo + else + do j=js,je ; do i=is,ie + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) + enddo; enddo + endif + fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. + endif + end if + ! more salt restoring logic if (associated(IOB%salt_flux)) then do j=js,je ; do i=is,ie @@ -656,16 +660,11 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) ! allocation and initialization if this is the first time that this ! mechanical forcing type has been used. if (.not.forces%initialized) then - call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., & - press=.true.) + + call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., press=.true.) call safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed) call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed) - if (CS%use_limited_P_SSH) then - forces%p_surf_SSH => forces%p_surf - else - forces%p_surf_SSH => forces%p_surf_full - endif if (CS%rigid_sea_ice) then call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) @@ -689,6 +688,11 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 ! applied surface pressure from atmosphere and cryosphere + if (CS%use_limited_P_SSH) then + forces%p_surf_SSH => forces%p_surf + else + forces%p_surf_SSH => forces%p_surf_full + endif if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then do j=js,je ; do i=is,ie diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 7ca7ab39ef..fe515ae123 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -160,7 +160,7 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 if (ocean_public%frazil(ig,jg) > 0.0) then ! Frazil: change from J/m^2 to W/m^2 - ! dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int + dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int else ! Melt_potential: change from J/m^2 to W/m^2 dataPtr_Fioo_q(i1,j1) = -ocean_public%melt_potential(i,j) * grid%mask2dT(ig,jg) * I_time_int !* ncouple_per_day From e0d604ccabdb47b49e2de8ca055bb9b960d2442c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 11 Dec 2018 11:00:07 -0700 Subject: [PATCH 16/77] bug fixes and removal of trailing white space --- config_src/nuopc_driver/MOM_surface_forcing.F90 | 4 ++-- config_src/nuopc_driver/mom_cap.F90 | 2 +- config_src/nuopc_driver/mom_cap_methods.F90 | 2 +- src/ice_shelf/MOM_ice_shelf.F90 | 10 +++++----- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 4 ++-- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 88848fc3c2..8b25fdf958 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -302,7 +302,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%p_surf_SSH => fluxes%p_surf_full endif end if - + call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) @@ -534,7 +534,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. endif end if - + ! more salt restoring logic if (associated(IOB%salt_flux)) then do j=js,je ; do i=is,ie diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index d15b102b33..efb8aa75d6 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -147,7 +147,7 @@ !! !! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) !! -!! Priori to the call to `update_ocean_model()`, the cap performs these steps +!! Priori to the call to `update_ocean_model()`, the cap performs these steps !! - the `Time` and `Time_step_coupled` parameters, based on FMS types, are derived from the incoming ESMF clock !! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently !! inactive, but may be modified to read in import data from file or from an external coupler diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index fe515ae123..0f305296f3 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -158,7 +158,7 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) dataPtr_bldepth(i1,j1) = ocean_public%OBLD(i,j) * grid%mask2dT(ig,jg) ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 - if (ocean_public%frazil(ig,jg) > 0.0) then + if (ocean_public%frazil(i,j) > 0.0) then ! Frazil: change from J/m^2 to W/m^2 dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int else diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 3a27c988c9..9abebcfe9a 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -308,7 +308,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) if (CS%mass_from_file) call update_shelf_mass(G, CS, ISS, Time) endif - if (CS%DEBUG) then + if (CS%debug) then call hchksum(fluxes%frac_shelf_h, "frac_shelf_h before apply melting", G%HI, haloshift=0) call hchksum(state%sst, "sst before apply melting", G%HI, haloshift=0) call hchksum(state%sss, "sss before apply melting", G%HI, haloshift=0) @@ -633,7 +633,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call change_thickness_using_melt(ISS, G, time_step, fluxes, CS%density_ice, CS%debug) endif - if (CS%DEBUG) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) + if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) call add_shelf_flux(G, CS, state, fluxes) @@ -675,7 +675,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call cpu_clock_end(id_clock_shelf) - if (CS%DEBUG) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) + if (CS%debug) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) end subroutine shelf_calc_flux @@ -1043,7 +1043,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) endif enddo ; enddo - if (CS%DEBUG) then + if (CS%debug) then write(mesg,*) 'Mean melt flux (kg/(m^2 s)), dt = ', mean_melt_flux, CS%time_step call MOM_mesg(mesg) call MOM_forcing_chksum("After constant sea level", fluxes, G, haloshift=0) @@ -1483,7 +1483,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / G%areaT(i,j) enddo ; enddo ; endif - if (CS%DEBUG) then + if (CS%debug) then call hchksum(fluxes%frac_shelf_h, "IS init: frac_shelf_h", G%HI, haloshift=0) endif diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index eea9ee322a..eac698f67c 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -920,7 +920,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) call ice_shelf_solve_inner(CS, ISS, G, u, v, TAUDX, TAUDY, H_node, float_cond, & ISS%hmask, conv_flag, iters, time, Phi, Phisub) - if (CS%DEBUG) then + if (CS%debug) then call qchksum(u, "u shelf", G%HI, haloshift=2) call qchksum(v, "v shelf", G%HI, haloshift=2) endif @@ -3597,7 +3597,7 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) call pass_var(CS%t_shelf, G%domain) call pass_var(CS%tmask, G%domain) - if (CS%DEBUG) then + if (CS%debug) then call hchksum(CS%t_shelf, "temp after front", G%HI, haloshift=3) endif From c41cdb3df4e5527d7cf96c4f96d093c39fe676e0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 12 Dec 2018 13:12:44 -0700 Subject: [PATCH 17/77] for cesm use mesh rather than grid - huge cost savings for initialization with CMEPS --- config_src/nuopc_driver/mom_cap.F90 | 834 +++++++++++--------- config_src/nuopc_driver/mom_cap_methods.F90 | 403 ++++------ 2 files changed, 643 insertions(+), 594 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index efb8aa75d6..dd7da83ebc 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -390,7 +390,7 @@ module mom_cap_mod use MOM_domains, only: pass_var use MOM_error_handler, only: is_root_pe use MOM_ocean_model, only: ice_ocean_boundary_type - use MOM_grid, only: ocean_grid_type + use MOM_grid, only: ocean_grid_type, get_global_grid_size use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid @@ -1207,6 +1207,7 @@ end subroutine InitializeAdvertise !! @param exportState an ESMF_State object for export fields !! @param clock an ESMF_Clock object !! @param rc return code + subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -1215,14 +1216,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Local Variables type(ESMF_VM) :: vm - type(ESMF_Grid) :: gridIn - type(ESMF_Grid) :: gridOut + type(ESMF_Grid) :: gridIn, gridOut + type(ESMF_Mesh) :: Emesh, EmeshTemp type(ESMF_DeLayout) :: delayout type(ESMF_Distgrid) :: Distgrid type(ESMF_DistGridConnection), allocatable :: connectionList(:) type (ocean_public_type), pointer :: ocean_public => NULL() type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_grid_type) , pointer :: ocean_grid type(ocean_internalstate_wrapper) :: ocean_internalstate integer :: npet, ntiles integer :: nxg, nyg, cnt @@ -1249,6 +1251,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_Field) :: field_t_surf integer :: mpicom integer :: localPet + integer :: lsize + integer :: ig,jg, ni,nj,k + integer, allocatable :: gindex(:) ! global index space + character(len=256) :: cvalue character(len=*), parameter :: subname='(mom_cap:InitializeRealize)' !-------------------------------- @@ -1339,385 +1345,454 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo end if - !--------------------------------- - ! create delayout and distgrid + ! Create either a grid or a mesh !--------------------------------- - allocate(deBlockList(2,2,ntiles)) - allocate(petMap(ntiles)) - allocate(deLabelList(ntiles)) - - do n = 1, ntiles - deLabelList(n) = n - deBlockList(1,1,n) = xb(n) - deBlockList(1,2,n) = xe(n) - deBlockList(2,1,n) = yb(n) - deBlockList(2,2,n) = ye(n) - petMap(n) = pe(n) - ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side - enddo + if (cesm_coupled) then - delayout = ESMF_DELayoutCreate(petMap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !--------------------------------- + ! Create a MOM6 mesh + !--------------------------------- + + ! Get the ocean grid and sizes of global and computational domains + call get_ocean_grid(ocean_state, ocean_grid) + call get_global_grid_size(ocean_grid, ni, nj) + lsize = ( ocean_grid%iec - ocean_grid%isc + 1 ) * ( ocean_grid%jec - ocean_grid%jsc + 1 ) + + ! Create the global index space for the computational domain + allocate(gindex(lsize)) + k = 0 + do j = ocean_grid%jsc, ocean_grid%jec + jg = j + ocean_grid%jdg_offset + do i = ocean_grid%isc, ocean_grid%iec + ig = i + ocean_grid%idg_offset + k = k + 1 ! Increment position within gindex + gindex(k) = ni * (jg - 1) + ig + enddo + enddo - ! rsd this assumes tripole grid, but sometimes in CESM a bipole - ! grid is used -- need to introduce conditional logic here + DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - allocate(connectionList(2)) + ! read in the mesh + call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - ! bipolar boundary condition at top row: nyg - call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & - orientationVector=(/-1, -2/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (localPet == 0) then + write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) + end if + + ! recreate the mesh using the above distGrid + EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - ! periodic boundary condition along first dimension - call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! realize the import and export fields using the mesh + call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", mesh=Emesh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", mesh=Emesh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & -! indexflag = ESMF_INDEX_DELOCAL, & - deBlockList=deBlockList, & -! deLabelList=deLabelList, & - delayout=delayout, & - connectionList=connectionList, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + else - deallocate(xb,xe,yb,ye,pe) - deallocate(connectionList) - deallocate(deLabelList) - deallocate(deBlockList) - deallocate(petMap) + !--------------------------------- + ! create a MOM6 grid + !--------------------------------- + + ! generate delayout and dist_grid + + allocate(deBlockList(2,2,ntiles)) + allocate(petMap(ntiles)) + allocate(deLabelList(ntiles)) + + do n = 1, ntiles + deLabelList(n) = n + deBlockList(1,1,n) = xb(n) + deBlockList(1,2,n) = xe(n) + deBlockList(2,1,n) = yb(n) + deBlockList(2,2,n) = ye(n) + petMap(n) = pe(n) + ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side + enddo - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(indexList(cnt)) - write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& - indexList(1),indexList(cnt),minval(indexList), maxval(indexList) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - deallocate(IndexList) + delayout = ESMF_DELayoutCreate(petMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - !--------------------------------- - ! create grid - !--------------------------------- + ! rsd this assumes tripole grid, but sometimes in CESM a bipole + ! grid is used -- need to introduce conditional logic here - gridIn = ESMF_GridCreate(distgrid=distgrid, & - gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & - coordSys = ESMF_COORDSYS_SPH_DEG, & - rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + allocate(connectionList(2)) - mom_grid_i = gridIn + ! bipolar boundary condition at top row: nyg + call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & + orientationVector=(/-1, -2/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! periodic boundary condition along first dimension + call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! Attach area to the Grid optionally. By default the cell areas are computed. - if(grid_attach_area) then - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif + distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & + ! indexflag = ESMF_INDEX_DELOCAL, & + deBlockList=deBlockList, & + ! deLabelList=deLabelList, & + delayout=delayout, & + connectionList=connectionList, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_xcen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_ycen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + deallocate(xb,xe,yb,ye,pe) + deallocate(connectionList) + deallocate(deLabelList) + deallocate(deBlockList) + deallocate(petMap) - call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_xcor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_ycor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + allocate(indexList(cnt)) + write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& + indexList(1),indexList(cnt),minval(indexList), maxval(indexList) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + deallocate(IndexList) - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_mask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if(grid_attach_area) then - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_area, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif + ! create grid - !--------------------------------- - ! load up area, mask, center and corner values - ! area, mask, and centers should be same size in mom and esmf grid - ! corner points may not be, need to offset corner points by 1 in i and j - ! for esmf and also need to "make up" j=1 values. use wraparound in i - !--------------------------------- + gridIn = ESMF_GridCreate(distgrid=distgrid, & + gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & + coordSys = ESMF_COORDSYS_SPH_DEG, & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + mom_grid_i = gridIn - lbnd1 = lbound(dataPtr_mask,1) - ubnd1 = ubound(dataPtr_mask,1) - lbnd2 = lbound(dataPtr_mask,2) - ubnd2 = ubound(dataPtr_mask,2) + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - lbnd3 = lbound(dataPtr_xcor,1) - ubnd3 = ubound(dataPtr_xcor,1) - lbnd4 = lbound(dataPtr_xcor,2) - ubnd4 = ubound(dataPtr_xcor,2) + ! Attach area to the Grid optionally. By default the cell areas are computed. + if(grid_attach_area) then + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif - write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_xcen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_ycen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_xcor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_ycor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_mask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if(grid_attach_area) then + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_area, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif - if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": fld and grid do not have the same size.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - allocate(ofld(isc:iec,jsc:jec)) - allocate(gfld(nxg,nyg)) + ! load up area, mask, center and corner values + ! area, mask, and centers should be same size in mom and esmf grid + ! corner points may not be, need to offset corner points by 1 in i and j + ! for esmf and also need to "make up" j=1 values. use wraparound in i - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - if(grid_attach_area) then - call ocean_model_data_get(ocean_state, ocean_public, 'area', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_area(i,j) = ofld(i1,j1) - enddo - enddo - endif + lbnd1 = lbound(dataPtr_mask,1) + ubnd1 = ubound(dataPtr_mask,1) + lbnd2 = lbound(dataPtr_mask,2) + ubnd2 = ubound(dataPtr_mask,2) - call ocean_model_data_get(ocean_state, ocean_public, 'tlon', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_xcen(i,j) = ofld(i1,j1) - dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - enddo - enddo + lbnd3 = lbound(dataPtr_xcor,1) + ubnd3 = ubound(dataPtr_xcor,1) + lbnd4 = lbound(dataPtr_xcor,2) + ubnd4 = ubound(dataPtr_xcor,2) - call ocean_model_data_get(ocean_state, ocean_public, 'tlat', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_ycen(i,j) = ofld(i1,j1) - enddo - enddo + write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call ocean_model_data_get(ocean_state, ocean_public, 'geoLonBu', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd4, ubnd4 - do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) -! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. -! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_xcor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in xu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - enddo - enddo + write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ! MOM6 runs on C-Grid. - call ocean_model_data_get(ocean_state, ocean_public, 'geoLatBu', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd4, ubnd4 - do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_ycor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in yu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - enddo - enddo + write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": fld and grid do not have the same size.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif - if(grid_attach_area) then - write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - endif + allocate(ofld(isc:iec,jsc:jec)) + allocate(gfld(nxg,nyg)) + + call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call mpp_global_field(ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) + enddo + enddo - write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if(grid_attach_area) then + call ocean_model_data_get(ocean_state, ocean_public, 'area', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call mpp_global_field(ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_area(i,j) = ofld(i1,j1) + enddo + enddo + endif - write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ocean_model_data_get(ocean_state, ocean_public, 'tlon', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call mpp_global_field(ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_xcen(i,j) = ofld(i1,j1) + dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) + enddo + enddo - write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ocean_model_data_get(ocean_state, ocean_public, 'tlat', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call mpp_global_field(ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_ycen(i,j) = ofld(i1,j1) + enddo + enddo - write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ocean_model_data_get(ocean_state, ocean_public, 'geoLonBu', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call mpp_global_field(ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + do j = lbnd4, ubnd4 + do i = lbnd3, ubnd3 + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) + ! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. + ! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_xcor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in xu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) + ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + enddo + enddo - deallocate(gfld) + ! MOM6 runs on C-Grid. + call ocean_model_data_get(ocean_state, ocean_public, 'geoLatBu', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call mpp_global_field(ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + do j = lbnd4, ubnd4 + do i = lbnd3, ubnd3 + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_ycor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in yu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + enddo + enddo - gridOut = gridIn ! for now out same as in + write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - !--------------------------------- - ! realize fields on grid - !--------------------------------- + if(grid_attach_area) then + write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + endif + write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call MOM_RealizeFields(exportState, gridOut, fldsFrOcn_num, fldsFrOcn, "Ocn export", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + deallocate(gfld) + + gridOut = gridIn ! for now out same as in + + call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", grid=gridIn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", grid=gridOut, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end if + + !--------------------------------- + ! set scalar data in export state + !--------------------------------- if (len_trim(scalar_field_name) > 0) then call State_SetScalar(dble(nxg),scalar_field_idx_grid_nx, exportState, localPet, & @@ -1726,7 +1801,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1734,6 +1809,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out endif + + !--------------------------------- + ! realize fields on grid + !--------------------------------- call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2451,14 +2530,15 @@ end subroutine State_SetScalar !=============================================================================== - subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) + subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) - type(ESMF_State) , intent(inout) :: state - type(ESMF_Grid) , intent(in) :: grid - integer , intent(in) :: nfields - type(fld_list_type) , intent(inout) :: field_defs(:) - character(len=*) , intent(in) :: tag - integer , intent(inout) :: rc + type(ESMF_State) , intent(inout) :: state + integer , intent(in) :: nfields + type(fld_list_type) , intent(inout) :: field_defs(:) + character(len=*) , intent(in) :: tag + type(ESMF_Grid) , intent(in), optional :: grid + type(ESMF_Mesh) , intent(in), optional :: mesh + integer , intent(inout) :: rc integer :: i type(ESMF_Field) :: field @@ -2496,34 +2576,58 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=rc) - field = ESMF_FieldCreate(grid=grid, & - farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & - !farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + + if (present(grid)) then + field = ESMF_FieldCreate(grid=grid, & + farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & + !farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else if (present(mesh)) then + field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + else + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & rc=rc) - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (present(grid)) then - ! initialize to zero - call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - fldptr = 0.0 + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! initialize to zero + call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr = 0.0 + + else if (present(mesh)) then + + field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if endif diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 0f305296f3..ac85e73491 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -29,9 +29,13 @@ module mom_cap_methods public :: mom_export_nems public :: mom_import_nems + interface State_GetFldPtr + module procedure State_GetFldPtr_1d + module procedure State_GetFldPtr_2d + end interface + integer :: rc,dbrc integer :: import_cnt = 0 - logical, parameter :: debug=.false. !=============================================================================== contains @@ -51,20 +55,20 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) ! Local variables real :: ssh(grid%isd:grid%ied,grid%jsd:grid%jed) !< Local copy of sea_lev with updated halo integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices - integer :: lbnd1, lbnd2, ubnd1, ubnd2 + integer :: n real :: slp_L, slp_R, slp_C, slope, u_min, u_max real :: I_time_int !< The inverse of coupling time interval in s-1. integer :: day, secs type(ESMF_time) :: currTime - real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_t(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_s(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_u(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_v(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fioo_q(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_omask(:) + real(ESMF_KIND_R8), pointer :: dataPtr_t(:) + real(ESMF_KIND_R8), pointer :: dataPtr_s(:) + real(ESMF_KIND_R8), pointer :: dataPtr_u(:) + real(ESMF_KIND_R8), pointer :: dataPtr_v(:) + real(ESMF_KIND_R8), pointer :: dataPtr_fioo_q(:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:) + real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:) type(ESMF_TimeInterval) :: timeStep integer :: dt_int !< time over which to advance the ocean (ocean_coupling_time_step), in sec character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" @@ -120,11 +124,6 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) file=__FILE__)) & return ! bail out - lbnd1 = lbound(dataPtr_t,1) - lbnd2 = lbound(dataPtr_t,2) - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - ! Use Adcroft's rule of reciprocals; it does the right thing here. call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -145,30 +144,31 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. ! The mask comes from "grid" that uses the usual MOM domain that has halos ! and does not use global indexing. - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + grid%isc - isc - dataPtr_omask(i1,j1) = grid%mask2dT(ig,jg) - dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(ig,jg) ! surface temp is in K - dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_bldepth(i1,j1) = ocean_public%OBLD(i,j) * grid%mask2dT(ig,jg) - ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 - if (ocean_public%frazil(i,j) > 0.0) then - ! Frazil: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int - else - ! Melt_potential: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(i1,j1) = -ocean_public%melt_potential(i,j) * grid%mask2dT(ig,jg) * I_time_int !* ncouple_per_day - ! make sure Melt_potential is always <= 0 - if (dataPtr_Fioo_q(i1,j1) > 0.0) dataPtr_Fioo_q(i1,j1) = 0.0 - end if - end do + n = 0 + do j=grid%jsc, grid%jec + jg = j + grid%jdg_offset + do i=grid%isc,grid%iec + ig = i + grid%idg_offset + n = n+1 + dataPtr_omask(n) = grid%mask2dT(i,j) + dataPtr_t(n) = ocean_public%t_surf(ig,jg) * grid%mask2dT(i,j) ! surface temp is in K + dataPtr_s(n) = ocean_public%s_surf(ig,jg) * grid%mask2dT(i,j) + dataPtr_u(n) = ocean_public%u_surf(ig,jg) * grid%mask2dT(i,j) + dataPtr_v(n) = ocean_public%v_surf(ig,jg) * grid%mask2dT(i,j) + dataPtr_bldepth(n) = ocean_public%OBLD(ig,jg) * grid%mask2dT(i,j) + ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 + if (ocean_public%frazil(ig,jg) > 0.0) then + ! Frazil: change from J/m^2 to W/m^2 + dataPtr_Fioo_q(n) = ocean_public%frazil(ig,jg) * grid%mask2dT(i,j) * I_time_int + else + ! Melt_potential: change from J/m^2 to W/m^2 + dataPtr_Fioo_q(n) = -ocean_public%melt_potential(ig,jg) * grid%mask2dT(i,j) * I_time_int !* ncouple_per_day + + ! make sure Melt_potential is always <= 0 + if (dataPtr_Fioo_q(n) > 0.0) dataPtr_Fioo_q(n) = 0.0 + end if + end do end do ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain @@ -185,87 +185,65 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) call pass_var(ssh, grid%domain) ! d/dx ssh - do jg = jsc, jec - j = jg + grid%jsc - jsc - j1 = jg + lbnd2 - jsc - do ig = isc,iec - i = ig + grid%isc - isc - i1 = ig + lbnd1 - isc - - ! This is a simple second-order difference - !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(i-1,j) - if (grid%mask2dCu(i-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(i,j) - if (grid%mask2dCu(i+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(i1,j1) = 0.0 - end do - end do + n = 0 + do j=grid%jsc, grid%jec + do i=grid%isc,grid%iec + n = n+1 + ! This is a simple second-order difference + ! dataPtr_dhdx(n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) + if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) + if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + endif + dataPtr_dhdx(n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(n) = 0.0 + enddo + enddo ! d/dy ssh - do jg = jsc, jec - j = jg + grid%jsc - jsc - j1 = jg + lbnd2 - jsc - do ig = isc,iec - i = ig + grid%isc - isc - i1 = ig + lbnd1 - isc - - ! This is a simple second-order difference - !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,j-1) - if (grid%mask2dCv(i,j-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,j) - if (grid%mask2dCv(i,j+1)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(i1,j1) = 0.0 - end do - end do - - if (debug .and. is_root_pe()) then - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - write(logunit,F01)'export: day, secs, j, i, t_surf = ',day,secs,j,i,dataPtr_t(i1,j1) - write(logunit,F01)'export: day, secs, j, i, s_surf = ',day,secs,j,i,dataPtr_s(i1,j1) - write(logunit,F01)'export: day, secs, j, i, u_surf = ',day,secs,j,i,dataPtr_u(i1,j1) - write(logunit,F01)'export: day, secs, j, i, v_surf = ',day,secs,j,i,dataPtr_v(i1,j1) - write(logunit,F01)'export: day, secs, j, i, dhdx = ',day,secs,j,i,dataPtr_dhdx(i1,j1) - write(logunit,F01)'export: day, secs, j, i, dhdy = ',day,secs,j,i,dataPtr_dhdy(i1,j1) - end do - end do - end if + n = 0 + do j=grid%jsc, grid%jec + do i=grid%isc,grid%iec + n = n+1 + ! This is a simple second-order difference + ! dataPtr_dhdy(n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) + if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. + + slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) + if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. + + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + endif + dataPtr_dhdy(n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(n) = 0.0 + enddo + enddo end subroutine mom_export_cesm @@ -290,33 +268,31 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, integer , intent(inout) :: rc ! Local Variables - integer :: i, j, i1, j1, ig, jg ! Grid indices - integer :: isc, iec, jsc, jec ! Grid indices - integer :: i0, j0, is, js, ie, je - integer :: lbnd1, lbnd2 - real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_taux(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_sen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lat(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_salt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:,:) + integer :: i, j, n + integer :: isc, iec, jsc, jec integer :: day, secs type(ESMF_time) :: currTime logical :: do_import + real(ESMF_KIND_R8), pointer :: dataPtr_p(:) + real(ESMF_KIND_R8), pointer :: dataPtr_taux(:) + real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:) + real(ESMF_KIND_R8), pointer :: dataPtr_sen(:) + real(ESMF_KIND_R8), pointer :: dataPtr_lat(:) + real(ESMF_KIND_R8), pointer :: dataPtr_evap(:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:) + real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:) + real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:) + real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:) + real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:) + real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:) + real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:) + real(ESMF_KIND_R8), pointer :: dataPtr_salt(:) + real(ESMF_KIND_R8), pointer :: dataPtr_rain(:) + real(ESMF_KIND_R8), pointer :: dataPtr_snow(:) + real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:) + real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:) + real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:) character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*), parameter :: subname = '(mom_import)' !----------------------------------------------------------------------- @@ -409,98 +385,39 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, file=__FILE__)) & return ! bail out - lbnd1 = lbound(dataPtr_p,1) - lbnd2 = lbound(dataPtr_p,2) - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - ! import_cnt is used to skip using the import state at the first count import_cnt = import_cnt + 1 - if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then - ! This will skip the first time import information is given - do_import = .false. + do_import = .false. ! This will skip the first time import information is given else - do_import = .true. + do_import = .true. end if if (do_import) then - do j = jsc, jec - j1 = j + lbnd2 - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) ! surface pressure - ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) ! zonal surface stress - taux - ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) ! meridional surface stress - tauy - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) ! liquid precipitation (rain) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) ! frozen precipitation (snow) - ice_ocean_boundary%t_flux(i,j) = dataPtr_sen(i1,j1) ! sensible heat flux (W/m2) - ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) ! latent heat flux (W/m^2) - ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(i1,j1) ! specific humidity flux - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) & - + dataPtr_lwdn(i1,j1) ! longwave radiation, sum up and down (W/m2) - ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) ! visible, direct shortwave (W/m2) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) ! visible, diffuse shortwave (W/m2) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) ! near-IR, direct shortwave (W/m2) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) ! near-IR, diffuse shortwave (W/m2) - ice_ocean_boundary%rofl_flux(i,j) = dataPtr_rofl(i1,j1) ! ice runoff - ice_ocean_boundary%rofi_flux(i,j) = dataPtr_rofi(i1,j1) ! liquid runoff - ice_ocean_boundary%salt_flux(i,j) = -dataPtr_salt(i1,j1) ! salt flux (minus sign needed here -GMM) + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + n = 0 + do j = jsc,jec + do i = isc,iec + n = n + 1 ! Increment position within gindex + ice_ocean_boundary%p(i,j) = dataPtr_p(n) ! surface pressure + ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(n) ! zonal surface stress - taux + ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(n) ! meridional surface stress - tauy + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(n) ! liquid precipitation (rain) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(n) ! frozen precipitation (snow) + ice_ocean_boundary%t_flux(i,j) = dataPtr_sen(n) ! sensible heat flux (W/m2) + ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(n) ! latent heat flux (W/m^2) + ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(n) ! specific humidity flux + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(n) & + + dataPtr_lwdn(n) ! longwave radiation, sum up and down (W/m2) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(n) ! visible, direct shortwave (W/m2) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(n) ! visible, diffuse shortwave (W/m2) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(n) ! near-IR, direct shortwave (W/m2) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(n) ! near-IR, diffuse shortwave (W/m2) + ice_ocean_boundary%rofl_flux(i,j) = dataPtr_rofl(n) ! ice runoff + ice_ocean_boundary%rofi_flux(i,j) = dataPtr_rofi(n) ! liquid runoff + ice_ocean_boundary%salt_flux(i,j) = -dataPtr_salt(n) ! salt flux (minus sign needed here -GMM) enddo enddo - - ! do j = jsc, jec - ! jg = j + grid%jsc - jsc - ! do i = isc, iec - ! ig = i + grid%jsc - isc - ! ice_ocean_boundary%u_flux(i,j) = & - ! GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) - ! ice_ocean_boundary%v_flux(i,j) = & - ! GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) - ! end do - ! end do - - end if - - ! debug output - if (do_import .and. debug .and. is_root_pe()) then - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) - - i0 = GRID%isc - isc - j0 = GRID%jsc - jsc - do j = GRID%jsc, GRID%jec - do i = GRID%isc, GRID%iec - write(logunit,F01)'import: day, secs, j, i, u_flux = '& - ,day,secs,j,i,ice_ocean_boundary%u_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, v_flux = '& - ,day,secs,j,i,ice_ocean_boundary%v_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, lprec = '& - ,day,secs,j,i,ice_ocean_boundary%lprec(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, lwrad = '& - ,day,secs,j,i,ice_ocean_boundary%lw_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, q_flux = '& - ,day,secs,j,i,ice_ocean_boundary%q_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, t_flux = '& - ,day,secs,j,i,ice_ocean_boundary%t_flux(i-i0,j-j0) - !write(logunit,F01)'import: day, secs, j, i, latent_flux = '& - ! ,day,secs,j,i,ice_ocean_boundary%latent_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, runoff = '& - ,day,secs,j,i,ice_ocean_boundary%runoff(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, psurf = '& - ,day,secs,j,i,ice_ocean_boundary%p(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, salt_flux = '& - ,day,secs,j,i,ice_ocean_boundary%salt_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = '& - ,day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = '& - ,day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = '& - ,day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = '& - ,day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i-i0,j-j0) - end do - end do end if end subroutine mom_import_cesm @@ -936,8 +853,36 @@ end subroutine mom_import_nems !=============================================================================== - subroutine State_GetFldPtr(ST, fldname, fldptr, rc) - type(ESMF_State) , intent(in) :: ST + subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) + type(ESMF_State) , intent(in) :: State + character(len=*) , intent(in) :: fldname + real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:) + integer, optional , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (present(rc)) rc = lrc + + end subroutine State_GetFldPtr_1d + +!=============================================================================== + + subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) + type(ESMF_State) , intent(in) :: State character(len=*) , intent(in) :: fldname real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:) integer, optional , intent(out) :: rc @@ -947,7 +892,7 @@ subroutine State_GetFldPtr(ST, fldname, fldptr, rc) integer :: lrc character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -960,6 +905,6 @@ subroutine State_GetFldPtr(ST, fldname, fldptr, rc) if (present(rc)) rc = lrc - end subroutine State_GetFldPtr + end subroutine State_GetFldPtr_2d end module mom_cap_methods From 893254f56074ad8b373c4e56c237bd7b02329248 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 12 Dec 2018 14:35:24 -0700 Subject: [PATCH 18/77] removed trailing whitespace --- config_src/nuopc_driver/mom_cap.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index dd7da83ebc..efe0c17672 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1364,9 +1364,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) allocate(gindex(lsize)) k = 0 do j = ocean_grid%jsc, ocean_grid%jec - jg = j + ocean_grid%jdg_offset + jg = j + ocean_grid%jdg_offset do i = ocean_grid%isc, ocean_grid%iec - ig = i + ocean_grid%idg_offset + ig = i + ocean_grid%idg_offset k = k + 1 ! Increment position within gindex gindex(k) = ni * (jg - 1) + ig enddo @@ -1393,7 +1393,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (localPet == 0) then write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) end if - + ! recreate the mesh using the above distGrid EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1418,9 +1418,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !--------------------------------- ! create a MOM6 grid !--------------------------------- - + ! generate delayout and dist_grid - + allocate(deBlockList(2,2,ntiles)) allocate(petMap(ntiles)) allocate(deLabelList(ntiles)) @@ -1781,13 +1781,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", grid=gridOut, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + end if !--------------------------------- @@ -1801,7 +1801,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1809,7 +1809,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out endif - + !--------------------------------- ! realize fields on grid !--------------------------------- From 02b4ae541ea57b08a8e580448ec0cb91adbe297a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 16 Dec 2018 18:46:40 -0700 Subject: [PATCH 19/77] changes for adding in fv3 --- config_src/nuopc_driver/mom_cap.F90 | 7 +- config_src/nuopc_driver/mom_cap_methods.F90 | 89 ++++++++++++++++++--- 2 files changed, 82 insertions(+), 14 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index efe0c17672..383cf09758 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1026,7 +1026,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr", "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr", "will provide") ! -> mean_net_sw_vis_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf", "will provide") ! -> mean_net_sw_ir_dir_flx @@ -1035,12 +1034,16 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface + ! when coupled to cam + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") ! -> mean long wave down + ! when coupled to fv3 + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx", "will_provide") ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index ac85e73491..753cd9e011 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -12,6 +12,8 @@ module mom_cap_methods use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE + use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND + use ESMF, only: operator(/=), operator(==) use MOM_ocean_model, only: ocean_public_type, ocean_state_type, ocean_model_data_get use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type @@ -258,6 +260,7 @@ end subroutine mom_export_cesm subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, & logunit, runtype, clock, rc) + ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid type(ESMF_State) , intent(inout) :: importState !< incoming data @@ -268,11 +271,19 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, integer , intent(inout) :: rc ! Local Variables + type(ESMF_StateItem_Flag) :: itemFlag integer :: i, j, n integer :: isc, iec, jsc, jec + integer :: lsize integer :: day, secs type(ESMF_time) :: currTime logical :: do_import + ! import fields that are different for cam and fv3 + logical :: isPresent_lwup + logical :: isPresent_lwdn + logical :: isPresent_lwnet + logical :: isPresent_evap + ! from atm real(ESMF_KIND_R8), pointer :: dataPtr_p(:) real(ESMF_KIND_R8), pointer :: dataPtr_taux(:) real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:) @@ -281,20 +292,25 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, real(ESMF_KIND_R8), pointer :: dataPtr_evap(:) real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:) real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwnet(:) + real(ESMF_KIND_R8), pointer :: dataPtr_rain(:) + real(ESMF_KIND_R8), pointer :: dataPtr_snow(:) real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:) real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:) real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:) real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:) + ! from river real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:) real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:) real(ESMF_KIND_R8), pointer :: dataPtr_salt(:) - real(ESMF_KIND_R8), pointer :: dataPtr_rain(:) - real(ESMF_KIND_R8), pointer :: dataPtr_snow(:) + ! from wave real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:) real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:) real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:) - character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" - character(len=*), parameter :: subname = '(mom_import)' + ! + real(ESMF_KIND_R8), parameter :: const_lhvap = 2.501e6_ESMF_KIND_R8 ! latent heat of evaporation ~ J/kg + character(len=*) , parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" + character(len=*) , parameter :: subname = '(mom_import)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -349,43 +365,88 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Faxa_lwdn" , dataPtr_lwdn, rc=rc) + call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Foxx_lwup" , dataPtr_lwup, rc=rc) + call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) + call State_getFldPtr(importState,"Fioi_salt" , dataPtr_salt, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) + call State_getFldPtr(importState,"Faxa_rain" , dataPtr_rain, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Fioi_salt" , dataPtr_salt, rc=rc) + call State_getFldPtr(importState,"Faxa_snow" , dataPtr_snow, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Faxa_rain" , dataPtr_rain, rc=rc) + + ! ------- + ! Different treatment of long wave dependent on if cam, datm or fv3 + ! ------- + ! When running with cam or datm - need Foxx_lwup and Faxa_lwdn + ! When running with fv3 - need mean_net_lw_flx + + call ESMF_StateGet(importState, 'Foxx_lwup', itemFlag, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Faxa_snow" , dataPtr_snow, rc=rc) + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + isPresent_lwup = .true. + call State_getFldPtr(importState,"Foxx_lwup", dataPtr_lwup, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + isPresent_lwup = .false. + end if + call ESMF_StateGet(importState, 'Faxa_lwdn', itemFlag, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + isPresent_lwdn = .true. + call State_getFldPtr(importState, "Faxa_lwdn", dataPtr_lwdn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + isPresent_lwdn = .false. + end if + call ESMF_StateGet(importState, "mean_net_lw_flx", itemFlag, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + isPresent_lwnet = .true. + call State_getFldPtr(importState,"mean_net_lw_flx" , dataPtr_lwnet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + isPresent_lwnet = .false. + end if + ! ------- ! import_cnt is used to skip using the import state at the first count + ! ------- + import_cnt = import_cnt + 1 if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then do_import = .false. ! This will skip the first time import information is given @@ -407,8 +468,12 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, ice_ocean_boundary%t_flux(i,j) = dataPtr_sen(n) ! sensible heat flux (W/m2) ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(n) ! latent heat flux (W/m^2) ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(n) ! specific humidity flux - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(n) & + if (isPresent_lwup .and. isPresent_lwdn) then + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(n) & + dataPtr_lwdn(n) ! longwave radiation, sum up and down (W/m2) + else if (isPresent_lwnet) then + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwnet(n) ! net longwave radiation, sum up and down (W/m2) + end if ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(n) ! visible, direct shortwave (W/m2) ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(n) ! visible, diffuse shortwave (W/m2) ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(n) ! near-IR, direct shortwave (W/m2) From c7206589f9f1ec197d2f01145bef30d3ae8d44f7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 16 Dec 2018 22:40:35 -0700 Subject: [PATCH 20/77] first step in putting in correct fields for swnet to ocean --- config_src/nuopc_driver/mom_cap.F90 | 34 ++++++++++++--------- config_src/nuopc_driver/mom_cap_methods.F90 | 26 +++++++++++++++- 2 files changed, 44 insertions(+), 16 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 383cf09758..ab05add936 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1024,21 +1024,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (len_trim(scalar_field_name) > 0) then call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC endif - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr", "will provide") ! -> mean_net_sw_ir_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr", "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf", "will provide") ! -> mean_net_sw_ir_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf", "will provide") ! -> mean_net_sw_vis_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! incorrect - remove + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! incorrect - remove + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! incorrect - remove + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! incorrect - remove + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") ! -> mean_net_sw_ir_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") ! -> mean_net_sw_vis_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") ! -> mean_net_sw_vis_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface ! when coupled to cam call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") ! -> mean long wave down diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 753cd9e011..edb600b535 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -308,7 +308,6 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:) real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:) ! - real(ESMF_KIND_R8), parameter :: const_lhvap = 2.501e6_ESMF_KIND_R8 ! latent heat of evaporation ~ J/kg character(len=*) , parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*) , parameter :: subname = '(mom_import)' !----------------------------------------------------------------------- @@ -320,6 +319,8 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, line=__LINE__, & file=__FILE__)) & return ! bail out + + ! TODO: remove these call State_getFldPtr(importState,"Faxa_swndr" , dataPtr_swndr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -340,6 +341,29 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, line=__LINE__, & file=__FILE__)) & return ! bail out + + ! TODO: add these + ! call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndr, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndf, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! call State_getFldPtr(importState,"mean_net_sw_vis_dir_flx" , dataPtr_swvdr, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! call State_getFldPtr(importState,"mean_net_sw_vis_dif_flx" , dataPtr_swvdf, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & From 4bdd6a43d9339dfff22c7da24f4fde9789439528 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 17 Dec 2018 21:20:30 -0700 Subject: [PATCH 21/77] fixed problem for netsw from mediator --- config_src/nuopc_driver/mom_cap.F90 | 4 --- config_src/nuopc_driver/mom_cap_methods.F90 | 32 +++------------------ 2 files changed, 4 insertions(+), 32 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index ab05add936..b04f493e05 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1026,10 +1026,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! incorrect - remove - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! incorrect - remove - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! incorrect - remove - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! incorrect - remove call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") ! -> mean_net_sw_vis_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") ! -> mean_net_sw_ir_dir_flx diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index edb600b535..d92406d6f2 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -319,51 +319,27 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, line=__LINE__, & file=__FILE__)) & return ! bail out - - ! TODO: remove these - call State_getFldPtr(importState,"Faxa_swndr" , dataPtr_swndr, rc=rc) + call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Faxa_swndf" , dataPtr_swndf, rc=rc) + call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndf, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Faxa_swvdr" , dataPtr_swvdr, rc=rc) + call State_getFldPtr(importState,"mean_net_sw_vis_dir_flx" , dataPtr_swvdr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Faxa_swvdf" , dataPtr_swvdf, rc=rc) + call State_getFldPtr(importState,"mean_net_sw_vis_dif_flx" , dataPtr_swvdf, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - ! TODO: add these - ! call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndr, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndf, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(importState,"mean_net_sw_vis_dir_flx" , dataPtr_swvdr, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(importState,"mean_net_sw_vis_dif_flx" , dataPtr_swvdf, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & From b308b2acd4b84e6bd98ed012fda964116913b1b7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 29 Dec 2018 09:28:46 -0700 Subject: [PATCH 22/77] new unified import method for grids or meshes --- .../nuopc_driver/MOM_surface_forcing.F90 | 21 +- config_src/nuopc_driver/mom_cap.F90 | 15 +- config_src/nuopc_driver/mom_cap_methods.F90 | 1113 ++++++++++------- 3 files changed, 654 insertions(+), 495 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 8b25fdf958..b652b5fc9e 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -445,18 +445,12 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & ! ice runoff flux if (associated(fluxes%frunoff)) & fluxes%frunoff(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0) - - ! GMM, cime does not not have an equivalent for heat_content_lrunoff and - ! heat_content_frunoff. I am seeting these to zero for now. - if (associated(IOB%runoff_hflx)) & - fluxes%heat_content_lrunoff(i,j) = 0.0 * G%mask2dT(i,j) - - if (associated(IOB%calving_hflx)) & - fluxes%heat_content_frunoff(i,j) = 0.0 * G%mask2dT(i,j) else if (associated(IOB%runoff)) & fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + end if + if (.not. cesm_coupled) then if (associated(IOB%calving)) & fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) @@ -469,13 +463,14 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & if (associated(IOB%mass_berg)) & fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%runoff_hflx)) & - fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%calving_hflx)) & - fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) end if + if (associated(IOB%runoff_hflx)) & + fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%calving_hflx)) & + fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%lw_flux)) & fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index b04f493e05..56bda62fdc 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -152,8 +152,7 @@ !! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently !! inactive, but may be modified to read in import data from file or from an external coupler !! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field -!! - mom_import_cesm or mom_import_nems is called -!! - the sign is reversed on `mean_evap_rate` and `mean_sensi_heat_flux` +!! - mom_import is called !! - momentum flux vectors are rotated to internal grid !! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` !! @@ -399,8 +398,7 @@ module mom_cap_mod use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel #endif - use mom_cap_methods, only: mom_import_cesm, mom_export_cesm - use mom_cap_methods, only: mom_import_nems, mom_export_nems + use mom_cap_methods, only: mom_import, mom_export_cesm, mom_export_nems use, intrinsic :: iso_fortran_env, only: output_unit @@ -1904,7 +1902,7 @@ subroutine DataInitialize(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) if (cesm_coupled) then - call mom_export_cesm(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) + call mom_export_cesm(ocean_public, ocean_grid, exportState, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -2099,14 +2097,13 @@ subroutine ModelAdvance(gcomp, rc) if (cesm_coupled) then call shr_file_setLogUnit (logunit) - call mom_import_cesm(ocean_public, ocean_grid, importState, ice_ocean_boundary, & - logunit, runtype, clock, rc=rc) + call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out else - call mom_import_nems(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc) + call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -2144,7 +2141,7 @@ subroutine ModelAdvance(gcomp, rc) !--------------- if (cesm_coupled) then - call mom_export_cesm(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) + call mom_export_cesm(ocean_public, ocean_grid, exportState, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index d92406d6f2..209e27130e 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -6,13 +6,21 @@ module mom_cap_methods ! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. + use NUOPC, only: NUOPC_Advertise, NUOPC_Realize, NUOPC_IsConnected + use NUOPC_Model, only: NUOPC_ModelGet use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF, only: ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + use ESMF, only: ESMF_State, ESMF_StateGet, ESMF_StateRemove + use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate + use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate + use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND + use ESMF, only: ESMF_GEOMTYPE_FLAG, ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH + use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT + use ESMF, only: ESMF_TYPEKIND_R8 use ESMF, only: operator(/=), operator(==) use MOM_ocean_model, only: ocean_public_type, ocean_state_type, ocean_model_data_get use MOM_surface_forcing, only: ice_ocean_boundary_type @@ -26,36 +34,443 @@ module mom_cap_methods private ! Public member functions + public :: mom_import public :: mom_export_cesm - public :: mom_import_cesm public :: mom_export_nems - public :: mom_import_nems + + private :: state_getimport interface State_GetFldPtr module procedure State_GetFldPtr_1d module procedure State_GetFldPtr_2d end interface +#ifdef CESMCOUPLED + logical :: cesm_coupled = .true. + type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH +#else + logical :: cesm_coupled = .false. + type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID +#endif + integer :: rc,dbrc integer :: import_cnt = 0 !=============================================================================== contains +!=============================================================================== + + !> This function has a few purposes: + !! (1) it imports surface fluxes using data from the mediator; and + !! (2) it can apply restoring in SST and SSS. + !! See \ref section_ocn_import for a summary of the surface fluxes that are + !! passed from MCT to MOM6, including fluxes that need to be included in the future. + + subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype, rc) + + ! Input/output variables + type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid + type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator + type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing + character(len=*), optional , intent(in) :: runtype !< For cesm only, type of run + integer , intent(inout) :: rc + + ! Local Variables + type(ESMF_StateItem_Flag) :: itemFlag + integer :: i, j, n + integer :: isc, iec, jsc, jec + logical :: do_import + logical :: isPresent_lwup + logical :: isPresent_lwdn + logical :: isPresent_lwnet + character(len=128) :: fldname + character(len=128) :: fldname_x + character(len=128) :: fldname_y + real(ESMF_KIND_R8), allocatable :: taux(:,:) + real(ESMF_KIND_R8), allocatable :: tauy(:,:) + character(len=*) , parameter :: subname = '(mom_import_cesm)' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! ------- + ! import_cnt is used to skip using the import state at the first count for cesm + ! ------- + + if (present(runtype)) then + import_cnt = import_cnt + 1 + if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then + do_import = .false. ! This will skip the first time import information is given + else + do_import = .true. + end if + else + do_import = .true. + end if + + if (do_import) then + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + + !---- + ! surface height pressure + !---- + if (cesm_coupled) then + fldname = 'Sa_pslv' + else + fldname = 'inst_pres_height_surface' + end if + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! near-IR, direct shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! near-IR, diffuse shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! visible, direct shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! visible, diffuse shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! ------- + ! Net longwave radiation (W/m2) + ! ------- + ! Different treatment of long wave dependent on atmosphere + ! When running with cam or datm - need Foxx_lwup and Faxa_lwdn + ! When running with fv3 - need mean_net_lw_flx + + call ESMF_StateGet(importState, 'Foxx_lwup', itemFlag, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + isPresent_lwup = .true. + else + isPresent_lwup = .false. + end if + call ESMF_StateGet(importState, 'Faxa_lwdn', itemFlag, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + isPresent_lwdn = .true. + else + isPresent_lwdn = .false. + end if + call ESMF_StateGet(importState, "mean_net_lw_flx", itemFlag, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + isPresent_lwnet = .true. + else + isPresent_lwnet = .false. + end if + + if (isPresent_lwup .and. isPresent_lwdn) then + ! longwave radiation, sum up and down (W/m2) + call state_getimport(importState, 'Foxx_lwup', & + isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call state_getimport(importState, 'Faxa_lwdn', & + isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, do_sum=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else if (isPresent_lwnet) then + ! net longwave radiation, sum up and down (W/m2) + call state_getimport(importState, 'mean_net_lw_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, do_sum=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + !---- + ! zonal and meridional surface stress + !---- + if (cesm_coupled) then + fldname_x = 'Foxx_taux' + fldname_y = 'Foxx_tauy' + else + fldname_x = 'mean_zonal_moment_flx' + fldname_y = 'mean_merid_moment_flx' + end if + + allocate (taux(isc:iec,jsc:jec)) + allocate (tauy(isc:iec,jsc:jec)) + call state_getimport(importState, trim(fldname_x), isc, iec, jsc, jec, taux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call state_getimport(importState, trim(fldname_y), isc, iec, jsc, jec, tauy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! rotate taux and tauy from true zonal/meridional to local coordinates + ! Note - this is the latest calculation from Gustavo - pointed out that the NEMS calculation is incorrect + if (cesm_coupled) then + do j = jsc, jec + do i = isc, iec + ! TODO (mvertens, 2018-12-28): create a new baseline with these changes + !ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(i,j) * taux(i,j) + ocean_grid%sin_rot(i,j) * tauy(i,j) + !ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(i,j) * tauy(i,j) - ocean_grid%sin_rot(i,j) * taux(i,j) + ice_ocean_boundary%u_flux(i,j) = taux(i,j) + ice_ocean_boundary%v_flux(i,j) = tauy(i,j) + end do + end do + else + do j = jsc, jec + do i = isc, iec + ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(i,j)*taux(i,j) - ocean_grid%sin_rot(i,j)*tauy(i,j) + ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(i,j)*tauy(i,j) + ocean_grid%sin_rot(1,j)*taux(i,j) + end do + end do + end if + + !---- + ! sensible heat flux (W/m2) + !---- + if (cesm_coupled) then + fldname = 'Foxx_sen' + else + fldname = 'mean_sensi_heat_flx' + end if + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! latent heat flux (W/m2) + !---- + if (cesm_coupled) then + ! Note - this field is not exported by the nems mediator + fldname = 'Foxx_lat' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%latent_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + !---- + ! specific humidity flux (W/m2) + !---- + if (cesm_coupled) then + fldname = 'Foxx_evap' + else + fldname = 'mean_evap_rate' + end if + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! liquid precipitation (rain) + !---- + if (cesm_coupled) then + fldname = 'Faxa_rain' + else + fldname = 'mean_prec_rate' + end if + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! frozen precipitation (snow) + !---- + if (cesm_coupled) then + fldname = 'Faxa_snow' + else + fldname = 'mean_fprec_rate' + end if + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! runoff and heat content of runoff + !---- + if (cesm_coupled) then + ! liquid runoff + fldname = 'Foxx_rofl' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! ice runoff + fldname = 'Foxx_rofi' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! GMM, cime does not not have an equivalent for heat_content_lrunoff and + ! heat_content_frunoff. Setting these to zero for now. + ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 + ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 + + else + ! total runoff + fldname = 'mean_runoff_rate' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! heat content of runoff + fldname = 'mean_runoff_heat_flux' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + !---- + ! calving rate and heat flux + !---- + if (.not. cesm_coupled) then + fldname = 'mean_calving_rate' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + fldname = 'mean_calving_heat_flux' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + !---- + ! salt flux from ice + !---- + if (cesm_coupled) then + fldname = 'Fioi_salt' + else + fldname = 'mean_salt_rate' + end if + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (cesm_coupled) then + ! salt flux (minus sign needed here -GMM) + ! TODO (mvertens, 2018-12-28): NEMS does not have a minus sign - which one is right? + do j = jsc,jec + do i = isc,iec + ice_ocean_boundary%salt_flux(i,j) = - ice_ocean_boundary%salt_flux(i,j) + enddo + enddo + end if + + !---- + ! mass of overlying ice + !---- + if (.not. cesm_coupled) then + fldname = 'mass_of_overlying_ice' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + end if + + end subroutine mom_import + !=============================================================================== !> Maps outgoing ocean data to ESMF State - subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) + subroutine mom_export_cesm(ocean_public, ocean_grid, exportState, clock, rc) ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid + type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid type(ESMF_State) , intent(inout) :: exportState !< outgoing data - integer , intent(in) :: logunit type(ESMF_Clock) , intent(in) :: clock integer , intent(inout) :: rc ! Local variables - real :: ssh(grid%isd:grid%ied,grid%jsd:grid%jed) !< Local copy of sea_lev with updated halo + real :: ssh(ocean_grid%isd:ocean_grid%ied, ocean_grid%jsd:ocean_grid%jed) !< Local copy of sea_lev with updated halo integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices integer :: n real :: slp_L, slp_R, slp_C, slope, u_min, u_max @@ -73,7 +488,6 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:) type(ESMF_TimeInterval) :: timeStep integer :: dt_int !< time over which to advance the ocean (ocean_coupling_time_step), in sec - character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*), parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- @@ -84,41 +498,49 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"So_t", dataPtr_t, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"So_s", dataPtr_s, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"So_u", dataPtr_u, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"So_v", dataPtr_v, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"Fioo_q", dataPtr_fioo_q, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"So_dhdx", dataPtr_dhdx, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"So_dhdy", dataPtr_dhdy, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + !TODO: need to add the So_bldepth since this is needed for the wave model call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -126,6 +548,8 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) file=__FILE__)) & return ! bail out + !---------------- + ! Use Adcroft's rule of reciprocals; it does the right thing here. call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -143,29 +567,30 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) I_time_int = 0.0 end if + ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. ! The mask comes from "grid" that uses the usual MOM domain that has halos ! and does not use global indexing. n = 0 - do j=grid%jsc, grid%jec - jg = j + grid%jdg_offset - do i=grid%isc,grid%iec - ig = i + grid%idg_offset + do j=ocean_grid%jsc, ocean_grid%jec + jg = j + ocean_grid%jdg_offset + do i=ocean_grid%isc,ocean_grid%iec + ig = i + ocean_grid%idg_offset n = n+1 - dataPtr_omask(n) = grid%mask2dT(i,j) - dataPtr_t(n) = ocean_public%t_surf(ig,jg) * grid%mask2dT(i,j) ! surface temp is in K - dataPtr_s(n) = ocean_public%s_surf(ig,jg) * grid%mask2dT(i,j) - dataPtr_u(n) = ocean_public%u_surf(ig,jg) * grid%mask2dT(i,j) - dataPtr_v(n) = ocean_public%v_surf(ig,jg) * grid%mask2dT(i,j) - dataPtr_bldepth(n) = ocean_public%OBLD(ig,jg) * grid%mask2dT(i,j) + dataPtr_omask(n) = ocean_grid%mask2dT(i,j) + dataPtr_t(n) = ocean_public%t_surf(ig,jg) * ocean_grid%mask2dT(i,j) ! surface temp is in K + dataPtr_s(n) = ocean_public%s_surf(ig,jg) * ocean_grid%mask2dT(i,j) + dataPtr_u(n) = ocean_public%u_surf(ig,jg) * ocean_grid%mask2dT(i,j) + dataPtr_v(n) = ocean_public%v_surf(ig,jg) * ocean_grid%mask2dT(i,j) + dataPtr_bldepth(n) = ocean_public%OBLD(ig,jg) * ocean_grid%mask2dT(i,j) ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 if (ocean_public%frazil(ig,jg) > 0.0) then ! Frazil: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(n) = ocean_public%frazil(ig,jg) * grid%mask2dT(i,j) * I_time_int + dataPtr_Fioo_q(n) = ocean_public%frazil(ig,jg) * ocean_grid%mask2dT(i,j) * I_time_int else ! Melt_potential: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(n) = -ocean_public%melt_potential(ig,jg) * grid%mask2dT(i,j) * I_time_int !* ncouple_per_day + dataPtr_Fioo_q(n) = -ocean_public%melt_potential(ig,jg) * ocean_grid%mask2dT(i,j) * I_time_int !* ncouple_per_day ! make sure Melt_potential is always <= 0 if (dataPtr_Fioo_q(n) > 0.0) dataPtr_Fioo_q(n) = 0.0 @@ -173,31 +598,32 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) end do end do - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - do j=grid%jsc, grid%jec - jg = j + grid%jdg_offset - do i=grid%isc,grid%iec - ig = i + grid%idg_offset + ! Make a copy of ssh in order to do a halo update. + ! ssh has global indexing with halos + + do j = ocean_grid%jsc, ocean_grid%jec + jg = j + ocean_grid%jdg_offset + do i = ocean_grid%isc,ocean_grid%iec + ig = i + ocean_grid%idg_offset ssh(i,j) = ocean_public%sea_lev(ig,jg) end do end do ! Update halo of ssh so we can calculate gradients - call pass_var(ssh, grid%domain) + call pass_var(ssh, ocean_grid%domain) ! d/dx ssh n = 0 - do j=grid%jsc, grid%jec - do i=grid%isc,grid%iec + do j=ocean_grid%jsc, ocean_grid%jec + do i=ocean_grid%isc,ocean_grid%iec n = n+1 ! This is a simple second-order difference - ! dataPtr_dhdx(n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) - if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) - if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. + ! dataPtr_dhdx(n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-ocean_grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(I-1,j) + if (ocean_grid%mask2dCu(I-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(I,j) + if (ocean_grid%mask2dCu(I+1,j)==0.) slp_R = 0. slp_C = 0.5 * (slp_L + slp_R) if ( (slp_L * slp_R) > 0.0 ) then ! This limits the slope so that the edge values are bounded by the @@ -210,24 +636,24 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) ! larger extreme values. slope = 0.0 endif - dataPtr_dhdx(n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(n) = 0.0 + dataPtr_dhdx(n) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dataPtr_dhdx(n) = 0.0 enddo enddo ! d/dy ssh n = 0 - do j=grid%jsc, grid%jec - do i=grid%isc,grid%iec + do j=ocean_grid%jsc, ocean_grid%jec + do i=ocean_grid%isc,ocean_grid%iec n = n+1 ! This is a simple second-order difference - ! dataPtr_dhdy(n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) - if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. + ! dataPtr_dhdy(n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-ocean_grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,J-1) + if (ocean_grid%mask2dCv(i,J-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) - if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,J) + if (ocean_grid%mask2dCv(i,J+1)==0.) slp_R = 0. slp_C = 0.5 * (slp_L + slp_R) !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R @@ -242,251 +668,13 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) ! larger extreme values. slope = 0.0 endif - dataPtr_dhdy(n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(n) = 0.0 + dataPtr_dhdy(n) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dataPtr_dhdy(n) = 0.0 enddo enddo end subroutine mom_export_cesm -!=============================================================================== - - !> This function has a few purposes: 1) it allocates and initializes the data - !! in the fluxes structure; 2) it imports surface fluxes using data from - !! the coupler; and 3) it can apply restoring in SST and SSS. - !! See \ref section_ocn_import for a summary of the surface fluxes that are - !! passed from MCT to MOM6, including fluxes that need to be included in - !! the future. - subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, & - logunit, runtype, clock, rc) - - ! Input/output variables - type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid - type(ESMF_State) , intent(inout) :: importState !< incoming data - type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing - type(ESMF_Clock) , intent(in) :: clock - integer , intent(in) :: logunit - character(len=*) , intent(in) :: runtype - integer , intent(inout) :: rc - - ! Local Variables - type(ESMF_StateItem_Flag) :: itemFlag - integer :: i, j, n - integer :: isc, iec, jsc, jec - integer :: lsize - integer :: day, secs - type(ESMF_time) :: currTime - logical :: do_import - ! import fields that are different for cam and fv3 - logical :: isPresent_lwup - logical :: isPresent_lwdn - logical :: isPresent_lwnet - logical :: isPresent_evap - ! from atm - real(ESMF_KIND_R8), pointer :: dataPtr_p(:) - real(ESMF_KIND_R8), pointer :: dataPtr_taux(:) - real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:) - real(ESMF_KIND_R8), pointer :: dataPtr_sen(:) - real(ESMF_KIND_R8), pointer :: dataPtr_lat(:) - real(ESMF_KIND_R8), pointer :: dataPtr_evap(:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwnet(:) - real(ESMF_KIND_R8), pointer :: dataPtr_rain(:) - real(ESMF_KIND_R8), pointer :: dataPtr_snow(:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:) - ! from river - real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:) - real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:) - real(ESMF_KIND_R8), pointer :: dataPtr_salt(:) - ! from wave - real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:) - real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:) - real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:) - ! - character(len=*) , parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" - character(len=*) , parameter :: subname = '(mom_import)' - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call State_getFldPtr(importState,'Sa_pslv', dataPtr_p,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_vis_dir_flx" , dataPtr_swvdr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_vis_dif_flx" , dataPtr_swvdf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_tauy" , dataPtr_tauy, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_sen" , dataPtr_sen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_lat" , dataPtr_lat, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_evap" , dataPtr_evap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Fioi_salt" , dataPtr_salt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Faxa_rain" , dataPtr_rain, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Faxa_snow" , dataPtr_snow, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! ------- - ! Different treatment of long wave dependent on if cam, datm or fv3 - ! ------- - ! When running with cam or datm - need Foxx_lwup and Faxa_lwdn - ! When running with fv3 - need mean_net_lw_flx - - call ESMF_StateGet(importState, 'Foxx_lwup', itemFlag, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - isPresent_lwup = .true. - call State_getFldPtr(importState,"Foxx_lwup", dataPtr_lwup, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - isPresent_lwup = .false. - end if - call ESMF_StateGet(importState, 'Faxa_lwdn', itemFlag, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - isPresent_lwdn = .true. - call State_getFldPtr(importState, "Faxa_lwdn", dataPtr_lwdn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - isPresent_lwdn = .false. - end if - call ESMF_StateGet(importState, "mean_net_lw_flx", itemFlag, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - isPresent_lwnet = .true. - call State_getFldPtr(importState,"mean_net_lw_flx" , dataPtr_lwnet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - isPresent_lwnet = .false. - end if - - ! ------- - ! import_cnt is used to skip using the import state at the first count - ! ------- - - import_cnt = import_cnt + 1 - if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then - do_import = .false. ! This will skip the first time import information is given - else - do_import = .true. - end if - - if (do_import) then - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - n = 0 - do j = jsc,jec - do i = isc,iec - n = n + 1 ! Increment position within gindex - ice_ocean_boundary%p(i,j) = dataPtr_p(n) ! surface pressure - ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(n) ! zonal surface stress - taux - ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(n) ! meridional surface stress - tauy - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(n) ! liquid precipitation (rain) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(n) ! frozen precipitation (snow) - ice_ocean_boundary%t_flux(i,j) = dataPtr_sen(n) ! sensible heat flux (W/m2) - ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(n) ! latent heat flux (W/m^2) - ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(n) ! specific humidity flux - if (isPresent_lwup .and. isPresent_lwdn) then - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(n) & - + dataPtr_lwdn(n) ! longwave radiation, sum up and down (W/m2) - else if (isPresent_lwnet) then - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwnet(n) ! net longwave radiation, sum up and down (W/m2) - end if - ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(n) ! visible, direct shortwave (W/m2) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(n) ! visible, diffuse shortwave (W/m2) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(n) ! near-IR, direct shortwave (W/m2) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(n) ! near-IR, diffuse shortwave (W/m2) - ice_ocean_boundary%rofl_flux(i,j) = dataPtr_rofl(n) ! ice runoff - ice_ocean_boundary%rofi_flux(i,j) = dataPtr_rofi(n) ! liquid runoff - ice_ocean_boundary%salt_flux(i,j) = -dataPtr_salt(n) ! salt flux (minus sign needed here -GMM) - enddo - enddo - end if - - end subroutine mom_import_cesm - !=============================================================================== subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, exportState, rc) @@ -527,37 +715,37 @@ subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, expor line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - !call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! fixfrzmlt !JW + call State_getFldPtr(exportState,'accum_heat_frazil',dataPtr_frazil,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,'inst_melt_potential',dataPtr_melt_potential,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frzmlt,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_zonal',dataPtr_dhdx,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_merid',dataPtr_dhdy,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -647,10 +835,17 @@ subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, expor if (ocean_grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 end do end do + ! rotate slopes from tripolar grid back to lat/lon grid (CCW) ! "grid" uses the usual MOM domain that has halos ! and does not use global indexing. ! x,y => latlon + + lbnd1 = lbound(dataPtr_dhdx,1) + ubnd1 = ubound(dataPtr_dhdx,1) + lbnd2 = lbound(dataPtr_dhdx,2) + ubnd2 = ubound(dataPtr_dhdx,2) + do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j + ocean_grid%jsc - lbnd2 @@ -734,188 +929,6 @@ subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, expor end subroutine mom_export_nems -!=============================================================================== - - subroutine mom_import_nems(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc) - - ! Input/output variables - type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid - type(ESMF_State) , intent(inout) :: importState !< incoming data - type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing - integer , intent(inout) :: rc - - ! Local Variables - integer :: lbnd1,ubnd1,lbnd2,ubnd2 - integer :: i, j, i1, j1, ig, jg ! Grid indices - integer :: isc, iec, jsc, jec ! Grid indices - integer :: i0, j0, is, js, ie, je ! Grid indices - real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_salt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwflux(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_runoff(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_calving(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_runoff_hflx(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_calving_hflx(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mi(:,:) - - real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) - integer :: day, secs - type(ESMF_time) :: currTime - logical :: do_import - character(len=*), parameter :: subname = '(mom_import_nems)' - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_merid_moment_flx',dataPtr_mmmf,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_evap_rate',dataPtr_evap,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_sensi_heat_flx',dataPtr_sensi,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_salt_rate" , dataPtr_salt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_vis_dir_flx" , dataPtr_swvdr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_vis_dif_flx" , dataPtr_swvdf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_prec_rate" , dataPtr_rain, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_fprec_rate" , dataPtr_snow, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_runoff_rate" , dataPtr_runoff, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_calving_rate" , dataPtr_calving, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_runoff_heat_flux" , dataPtr_runoff_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_calving_heat_flux" , dataPtr_calving_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'inst_pres_height_surface', dataPtr_p,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mass_of_overlying_ice" , dataPtr_mi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - - lbnd1 = lbound(dataPtr_p,1) - ubnd1 = ubound(dataPtr_p,1) - lbnd2 = lbound(dataPtr_p,2) - ubnd2 = ubound(dataPtr_p,2) - print *, 'lbnd1,ubnd1,lbnd2,ubnd2', lbnd1, ubnd1, lbnd2, ubnd2 - - allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j + ocean_grid%jsc - lbnd2 - i1 = i + ocean_grid%isc - lbnd1 - mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) - mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) - enddo - enddo - dataPtr_mzmf = mzmf - dataPtr_mmmf = mmmf - deallocate(mzmf, mmmf) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - - ice_ocean_boundary%u_flux(i,j) = dataPtr_mzmf(i1,j1) - ice_ocean_boundary%v_flux(i,j) = dataPtr_mmmf(i1,j1) - ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(i1,j1) - ice_ocean_boundary%t_flux(i,j) = dataPtr_sensi(i1,j1) - ice_ocean_boundary%salt_flux(i,j) = dataPtr_salt(i1,j1) - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwflux(i1,j1) - ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) - ice_ocean_boundary%runoff(i,j) = dataPtr_runoff(i1,j1) - ice_ocean_boundary%calving(i,j) = dataPtr_calving(i1,j1) - ice_ocean_boundary%runoff_hflx(i,j) = dataPtr_runoff_hflx(i1,j1) - ice_ocean_boundary%calving_hflx(i,j) = dataPtr_calving_hflx(i1,j1) - ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) - ice_ocean_boundary%mi(i,j) = dataPtr_mi(i1,j1) - enddo - enddo - - end subroutine mom_import_nems - !=============================================================================== subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) @@ -972,4 +985,158 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) end subroutine State_GetFldPtr_2d + !=============================================================================== + + subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, rc) + + ! ---------------------------------------------- + ! Map import state field to output array + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + integer , intent(in) :: isc + integer , intent(in) :: iec + integer , intent(in) :: jsc + integer , intent(in) :: jec + real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec) + logical, optional , intent(in) :: do_sum + integer , intent(out) :: rc + + ! local variables + integer :: n, i, j, i1, j1 + integer :: lbnd1,lbnd2 + real(ESMF_KIND_R8), pointer :: dataPtr1d(:) + real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) + character(len=*) , parameter :: subname='(mom_cap_methods:state_getimport)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (geomtype == ESMF_GEOMTYPE_MESH) then + + ! get field pointer + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! determine output array + n = 0 + do j = jsc,jec + do i = isc,iec + n = n + 1 + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr1d(n) + else + output(i,j) = dataPtr1d(n) + end if + end do + end do + + else if (geomtype == ESMF_GEOMTYPE_GRID) then + + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr2d(i1,j1) + else + output(i,j) = dataPtr2d(i1,j1) + end if + end do + end do + + end if + + end subroutine State_GetImport + + !=============================================================================== + + subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid, rc) + + ! ---------------------------------------------- + ! Map input array to export state + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(inout) :: state + character(len=*) , intent(in) :: fldname + integer , intent(in) :: isc + integer , intent(in) :: iec + integer , intent(in) :: jsc + integer , intent(in) :: jec + real (ESMF_KIND_R8) , intent(in) :: input(isc:iec,jsc:jec) + type(ocean_grid_type) , intent(in) :: ocean_grid + integer , intent(out) :: rc + + ! local variables + integer :: n, i, j, i1, j1, ig,jg + integer :: lbnd1,lbnd2 + real(ESMF_KIND_R8), pointer :: dataPtr1d(:) + real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) + character(len=*) , parameter :: subname='(mom_cap_methods_:state_setimport)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! Indexing notes: + ! input array from "ocean_public" uses local indexing without halos + ! mask from "ocean_grid" uses global indexing with halos + + if (geomtype == ESMF_GEOMTYPE_MESH) then + + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + n = 0 + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + n = n+1 + dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) + end do + end do + + else if (geomtype == ESMF_GEOMTYPE_GRID) then + + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) + end do + end do + + end if + + end subroutine State_SetExport + end module mom_cap_methods From 38751ddc672247f68e9c59c67f10c37785b8c7e6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 29 Dec 2018 19:15:53 -0700 Subject: [PATCH 23/77] updates to unify nems and cesm caps without separate import/export routines --- config_src/nuopc_driver/mom_cap.F90 | 165 ++--- config_src/nuopc_driver/mom_cap_methods.F90 | 716 +++++++++----------- 2 files changed, 383 insertions(+), 498 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 56bda62fdc..e7dfb579f5 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -157,7 +157,7 @@ !! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` !! !! After the call to `update_ocean_model()`, the cap performs these steps: -!! - mom_export_cesm or mom_export_nems is called +!! - mom_export is called !! - the `ocean_mask` export is set to match that of the internal MOM mask !! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval !! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid @@ -398,7 +398,7 @@ module mom_cap_mod use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel #endif - use mom_cap_methods, only: mom_import, mom_export_cesm, mom_export_nems + use mom_cap_methods, only: mom_import, mom_export use, intrinsic :: iso_fortran_env, only: output_unit @@ -1037,11 +1037,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - ! when coupled to cam - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") ! -> mean long wave down - ! when coupled to fv3 - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx", "will_provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up (coupled to cam) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") ! -> mean long wave down (coupled to cam) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will_provide") ! -> coupled to fv3 ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi @@ -1051,70 +1049,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not in CESM ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not in CESM - ! CESM currently not used - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphidry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphodry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphiwet" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet1" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet2" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet3" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet4" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry1" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry2" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry3" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry4" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcphi" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcpho" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_flxdst" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "So_duu10n" , "will provide") - - ! Optional CESM fields currently not used - ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) flds_co2a - ! call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) flds_co2c - ! call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! if (flds_co2a .or. flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2prog" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2diag" , "will provide") - ! end if - ! call NUOPC_CompAttributeGet(gcomp, name='ice_ncat', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) ice_ncat - ! call ESMF_LogWrite('ice_ncat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) flds_i2o_per_cat - ! call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! if (flds_i2o_per_cat) then - ! do num = 1, ice_ncat - ! name = 'Si_ifrac_' // cnum - ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") - ! name = 'PFioi_swpen_ifrac_' // cnum - ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") - ! end do - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afrac" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afracr" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_afracr", "will provide") - ! end if - ! do n = 1,shr_string_listGetNum(ndep_fields) - ! call shr_string_listGetName(ndep_fields, n, name) - ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") - ! end do + ! CESM currently not used + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") !--------- export fields ------------- if (len_trim(scalar_field_name) > 0) then @@ -1127,17 +1069,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! -> not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential - ! EMC fields not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") ! not in CESM + ! EMC fields not used in CESM + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") - ! Optional CESM fields currently not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") ! not in EMC - ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") - ! end if + ! CESM fields currently not used in EMC + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") else @@ -1162,22 +1101,17 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") !--------- export fields ------------- - ! This sets pointers of the fldsFrOcn to the ocean_public data (unlike the cesm copy paradigm) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide", data=ocean_public%t_surf) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=ocean_public%s_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide", data=ocean_public%u_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide", data=ocean_public%v_surf ) - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir" , "will provide") - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=ocean_public%sea_lev) - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=ocean_public%frazil) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide", data=Ocean_public%frazil) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide", data=Ocean_public%melt_potential) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=dataPtr_frzmlt) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide", data=ocean_public%frazil) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide", data=ocean_public%frazil) !JW - + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") end if do n = 1,fldsToOcn_num @@ -1878,6 +1812,7 @@ subroutine DataInitialize(gcomp, rc) type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString integer :: fieldCount, n + integer :: dt_cpld = 86400 type(ESMF_Field) :: field character(len=64),allocatable :: fieldNameList(:) character(len=*),parameter :: subname='(mom_cap:DataInitialize)' @@ -1902,7 +1837,7 @@ subroutine DataInitialize(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) if (cesm_coupled) then - call mom_export_cesm(ocean_public, ocean_grid, exportState, clock, rc=rc) + call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, dt_cpld, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -2069,7 +2004,7 @@ subroutine ModelAdvance(gcomp, rc) Time = esmf2fms_time(currTime) Time_step_coupled = esmf2fms_time(timeStep) - dt_cpld = dth*3600+dtm*60+dts + dt_cpld = dth*3600 + dtm*60 + dts !--------------- ! Write diagnostics for import @@ -2095,20 +2030,19 @@ subroutine ModelAdvance(gcomp, rc) ! Import data !--------------- +#ifdef CESMCOUPLED + call shr_file_setLogUnit (logunit) +#endif + if (cesm_coupled) then - call shr_file_setLogUnit (logunit) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out else call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out end if + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !--------------- ! Update MOM6 @@ -2140,24 +2074,17 @@ subroutine ModelAdvance(gcomp, rc) ! Export Data !--------------- - if (cesm_coupled) then - call mom_export_cesm(ocean_public, ocean_grid, exportState, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - call mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, dt_cpld, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - if (cesm_coupled) then +#ifdef CESM_COUPLED ! reset shr logging to my original values call shr_file_setLogUnit (output_unit) end if +#endif !--------------- ! If restart alarm is ringing - write restart file diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 209e27130e..98de08358b 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -10,7 +10,7 @@ module mom_cap_methods use NUOPC_Model, only: NUOPC_ModelGet use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF, only: ESMF_State, ESMF_StateGet, ESMF_StateRemove + use ESMF, only: ESMF_State, ESMF_StateGet use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate @@ -35,10 +35,10 @@ module mom_cap_methods ! Public member functions public :: mom_import - public :: mom_export_cesm - public :: mom_export_nems + public :: mom_export - private :: state_getimport + private :: State_getImport + private :: State_setExport interface State_GetFldPtr module procedure State_GetFldPtr_1d @@ -78,7 +78,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! Local Variables type(ESMF_StateItem_Flag) :: itemFlag - integer :: i, j, n + integer :: i, j, ig, jg, n integer :: isc, iec, jsc, jec logical :: do_import logical :: isPresent_lwup @@ -257,19 +257,27 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! Note - this is the latest calculation from Gustavo - pointed out that the NEMS calculation is incorrect if (cesm_coupled) then do j = jsc, jec + jg = j + ocean_grid%jsc - jsc do i = isc, iec + ig = i + ocean_grid%isc - isc ! TODO (mvertens, 2018-12-28): create a new baseline with these changes - !ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(i,j) * taux(i,j) + ocean_grid%sin_rot(i,j) * tauy(i,j) - !ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(i,j) * tauy(i,j) - ocean_grid%sin_rot(i,j) * taux(i,j) + ! ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg) * taux(i,j) & + ! + ocean_grid%sin_rot(ig,jg) * tauy(i,j) + ! ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg) * tauy(i,j) & + ! - ocean_grid%sin_rot(ig,jg) * taux(i,j) ice_ocean_boundary%u_flux(i,j) = taux(i,j) ice_ocean_boundary%v_flux(i,j) = tauy(i,j) end do end do else do j = jsc, jec + jg = j + ocean_grid%jsc - jsc do i = isc, iec - ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(i,j)*taux(i,j) - ocean_grid%sin_rot(i,j)*tauy(i,j) - ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(i,j)*tauy(i,j) + ocean_grid%sin_rot(1,j)*taux(i,j) + ig = i + ocean_grid%isc - isc + ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & + - ocean_grid%sin_rot(ig,jg)*tauy(i,j) + ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & + + ocean_grid%sin_rot(ig,jg)*taux(i,j) end do end do end if @@ -460,332 +468,331 @@ end subroutine mom_import !=============================================================================== !> Maps outgoing ocean data to ESMF State - subroutine mom_export_cesm(ocean_public, ocean_grid, exportState, clock, rc) + subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, dt_cpld, rc) ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid + type (ocean_state_type) , pointer :: ocean_state type(ESMF_State) , intent(inout) :: exportState !< outgoing data - type(ESMF_Clock) , intent(in) :: clock + type(ESMF_Clock) , intent(in) :: clock ! cesm + integer , intent(in) :: dt_cpld ! nems integer , intent(inout) :: rc ! Local variables - real :: ssh(ocean_grid%isd:ocean_grid%ied, ocean_grid%jsd:ocean_grid%jed) !< Local copy of sea_lev with updated halo - integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices - integer :: n - real :: slp_L, slp_R, slp_C, slope, u_min, u_max - real :: I_time_int !< The inverse of coupling time interval in s-1. - integer :: day, secs - type(ESMF_time) :: currTime - real(ESMF_KIND_R8), pointer :: dataPtr_omask(:) - real(ESMF_KIND_R8), pointer :: dataPtr_t(:) - real(ESMF_KIND_R8), pointer :: dataPtr_s(:) - real(ESMF_KIND_R8), pointer :: dataPtr_u(:) - real(ESMF_KIND_R8), pointer :: dataPtr_v(:) - real(ESMF_KIND_R8), pointer :: dataPtr_fioo_q(:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:) - real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:) - type(ESMF_TimeInterval) :: timeStep - integer :: dt_int !< time over which to advance the ocean (ocean_coupling_time_step), in sec + integer :: i, j, ig, jg ! grid indices + integer :: isc, iec, jsc, jec ! local indices + integer :: iloc, jloc ! local indices + integer :: n + real :: slp_L, slp_R, slp_C + real :: slope, u_min, u_max + integer :: day, secs + type(ESMF_TimeInterval) :: timeStep + integer :: dt_int + real :: inv_dt_int !< The inverse of coupling time interval in s-1. + character(len=128) :: fldname + character(len=128) :: fldname_x + character(len=128) :: fldname_y + real(ESMF_KIND_R8), allocatable :: omask(:,:) + real(ESMF_KIND_R8), allocatable :: melt_potential(:,:) + real(ESMF_KIND_R8), allocatable :: frazil(:,:) + real(ESMF_KIND_R8), allocatable :: frzmlt(:,:) + real(ESMF_KIND_R8), allocatable :: ocz(:,:), ocm(:,:) + real(ESMF_KIND_R8), allocatable :: ocz_rot(:,:), ocm_rot(:,:) + real(ESMF_KIND_R8), allocatable :: ssh(:,:) + real(ESMF_KIND_R8), allocatable :: dhdx(:,:), dhdy(:,:) + real(ESMF_KIND_R8), allocatable :: dhdx_rot(:,:), dhdy_rot(:,:) character(len=*), parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS - call State_getFldPtr(exportState,"So_omask", dataPtr_omask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_getFldPtr(exportState,"So_t", dataPtr_t, rc=rc) + ! Use Adcroft's rule of reciprocals; it does the right thing here. + call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - - call State_getFldPtr(exportState,"So_s", dataPtr_s, rc=rc) + call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + if (real(dt_int) > 0.0) then + inv_dt_int = 1.0 / real(dt_int) + else + inv_dt_int = 0.0 + end if - call State_getFldPtr(exportState,"So_u", dataPtr_u, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !---------------- + ! Copy from ocean_public to exportstate. + !---------------- - call State_getFldPtr(exportState,"So_v", dataPtr_v, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - call State_getFldPtr(exportState,"Fioo_q", dataPtr_fioo_q, rc=rc) + ! ------- + ! ocean mask + ! ------- + if (cesm_coupled) then + fldname = 'So_omask' + else + fldname = 'ocean_mask' + end if + allocate(omask(isc:iec, jsc:jec)) + ! TODO (mvertens, 2018-12-29): which is the correct formulation? + if (cesm_coupled) then + omask(:,:) = 1._ESMF_KIND_R8 + else + call ocean_model_data_get(ocean_state, ocean_public, 'mask', omask, isc, jsc) + do j = jsc,jec + do i = isc,iec + omask(i,j) = nint(omask(i,j)) + enddo + enddo + end if + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, omask, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call State_getFldPtr(exportState,"So_dhdx", dataPtr_dhdx, rc=rc) + ! ------- + ! Sea surface temperature + ! ------- + if (cesm_coupled) then + fldname = 'So_t' + else + fldname = 'sea_surface_temperature' + end if + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, ocean_public%t_surf, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call State_getFldPtr(exportState,"So_dhdy", dataPtr_dhdy, rc=rc) + ! ------- + ! Sea surface salinity + ! ------- + if (cesm_coupled) then + fldname = 'So_s' + else + fldname = 's_surf' + end if + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, ocean_public%s_surf, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out - !TODO: need to add the So_bldepth since this is needed for the wave model - call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! ------- + ! zonal and meridional currents + ! ------- + if (cesm_coupled) then + fldname_x = 'So_u' + fldname_y = 'So_v' + else + fldname_x = 'ocn_current_zonal' + fldname_y = 'ocn_current_merid' + end if - !---------------- + if (cesm_coupled) then + call State_SetExport(exportState, trim(fldname_x), & + isc, iec, jsc, jec, ocean_public%u_surf, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! Use Adcroft's rule of reciprocals; it does the right thing here. - call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (real(dt_int) > 0.0) then - I_time_int = 1.0 / real(dt_int) + call State_SetExport(exportState, trim(fldname_y), & + isc, iec, jsc, jec, ocean_public%v_surf, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out else - I_time_int = 0.0 - end if + ! rotate ocn current from tripolar grid back to lat/lon grid x,y => latlon (CCW) + ! "ocean_grid" has halos and uses global indexing. - ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. - ! The mask comes from "grid" that uses the usual MOM domain that has halos - ! and does not use global indexing. - - n = 0 - do j=ocean_grid%jsc, ocean_grid%jec - jg = j + ocean_grid%jdg_offset - do i=ocean_grid%isc,ocean_grid%iec - ig = i + ocean_grid%idg_offset - n = n+1 - dataPtr_omask(n) = ocean_grid%mask2dT(i,j) - dataPtr_t(n) = ocean_public%t_surf(ig,jg) * ocean_grid%mask2dT(i,j) ! surface temp is in K - dataPtr_s(n) = ocean_public%s_surf(ig,jg) * ocean_grid%mask2dT(i,j) - dataPtr_u(n) = ocean_public%u_surf(ig,jg) * ocean_grid%mask2dT(i,j) - dataPtr_v(n) = ocean_public%v_surf(ig,jg) * ocean_grid%mask2dT(i,j) - dataPtr_bldepth(n) = ocean_public%OBLD(ig,jg) * ocean_grid%mask2dT(i,j) - ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 - if (ocean_public%frazil(ig,jg) > 0.0) then - ! Frazil: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(n) = ocean_public%frazil(ig,jg) * ocean_grid%mask2dT(i,j) * I_time_int - else - ! Melt_potential: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(n) = -ocean_public%melt_potential(ig,jg) * ocean_grid%mask2dT(i,j) * I_time_int !* ncouple_per_day - - ! make sure Melt_potential is always <= 0 - if (dataPtr_Fioo_q(n) > 0.0) dataPtr_Fioo_q(n) = 0.0 - end if - end do - end do + allocate(ocz(isc:iec, jsc:jec)) + allocate(ocm(isc:iec, jsc:jec)) + allocate(ocz_rot(isc:iec, jsc:jec)) + allocate(ocm_rot(isc:iec, jsc:jec)) - ! Make a copy of ssh in order to do a halo update. - ! ssh has global indexing with halos + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ocz(i,j) = ocean_public%u_surf(i,j) + ocm(i,j) = ocean_public%v_surf(i,j) + ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) & + + ocean_grid%sin_rot(ig,jg)*ocm(i,j) + ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) & + - ocean_grid%sin_rot(ig,jg)*ocz(i,j) + end do + end do - do j = ocean_grid%jsc, ocean_grid%jec - jg = j + ocean_grid%jdg_offset - do i = ocean_grid%isc,ocean_grid%iec - ig = i + ocean_grid%idg_offset - ssh(i,j) = ocean_public%sea_lev(ig,jg) - end do - end do + call State_SetExport(exportState, trim(fldname_x), & + isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! Update halo of ssh so we can calculate gradients - call pass_var(ssh, ocean_grid%domain) + call State_SetExport(exportState, trim(fldname_y), & + isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! d/dx ssh - n = 0 - do j=ocean_grid%jsc, ocean_grid%jec - do i=ocean_grid%isc,ocean_grid%iec - n = n+1 - ! This is a simple second-order difference - ! dataPtr_dhdx(n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-ocean_grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(I-1,j) - if (ocean_grid%mask2dCu(I-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(I,j) - if (ocean_grid%mask2dCu(I+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - endif - dataPtr_dhdx(n) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) dataPtr_dhdx(n) = 0.0 - enddo - enddo + end if - ! d/dy ssh - n = 0 - do j=ocean_grid%jsc, ocean_grid%jec - do i=ocean_grid%isc,ocean_grid%iec - n = n+1 - ! This is a simple second-order difference - ! dataPtr_dhdy(n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-ocean_grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,J-1) - if (ocean_grid%mask2dCv(i,J-1)==0.) slp_L = 0. - - slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,J) - if (ocean_grid%mask2dCv(i,J+1)==0.) slp_R = 0. - - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - endif - dataPtr_dhdy(n) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) dataPtr_dhdy(n) = 0.0 - enddo - enddo + ! ------- + ! Boundary layer depth + ! ------- + if (cesm_coupled) then + fldname = 'So_bldepth' + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if - end subroutine mom_export_cesm + ! ------- + ! Oean melt and freeze potential + ! ------- + ! melt_potential, defined positive for T>Tfreeze, so need to change sign + ! Convert from J/m^2 to W/m^2 and make sure Melt_potential is always <= 0 -!=============================================================================== + if (cesm_coupled) then + fldname = 'Fioo_q' + else + fldname = 'inst_melt_potential' + end if + allocate(melt_potential(isc:iec, jsc:jec)) + if (cesm_coupled) then + do j = jsc,jec + do i = isc,iec + if (ocean_public%frazil(i,j) > 0.0) then + melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int + else + melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int + if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 + end if + end do + end do + else + do j = jsc,jec + do i = isc,iec + ! TODO (mvertens, 2018-12-29): use inv_dt_int from cesm - and not the original implementation? + melt_potential(i,j) = -melt_potential(i,j) / dt_cpld + if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 + end do + end do + end if + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, melt_potential, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, exportState, rc) + ! ------- + ! frazil and freezing melting potential (nems only) + ! ------- + if (.not. cesm_coupled) then + allocate(frazil(isc:iec, jsc:jec)) + allocate(frzmlt(isc:iec, jsc:jec)) - ! Input/output variables - type (ocean_state_type) , pointer :: ocean_state - type (ocean_public_type) , pointer :: ocean_public - type (ocean_grid_type) , pointer :: ocean_grid - integer , intent(in) :: dt_cpld - type(ESMF_State) , intent(inout) :: exportState !< outgoing data - integer , intent(out) :: rc + do j = jsc,jec + do i = isc,iec + !convert from J/m^2 to W/m^2 for CICE coupling + frazil(i,j) = ocean_public%frazil(i,j)/dt_cpld + if (frazil(i,j) == 0.0) then + frzmlt(i,j) = melt_potential(i,j) + else + frzmlt(i,j) = frazil(i,j) + endif + frzmlt(i,j) = max(-1000.0,min(1000.0,frzmlt(i,j))) + end do + end do - ! Local variables - integer :: lbnd1, lbnd2, ubnd1, ubnd2 - integer :: i, j, i1, j1, ig, jg !< Grid indices - integer :: isc, iec, jsc, jec !< Grid indices - real :: slp_L, slp_R, slp_C, slope, u_min, u_max !JW - real(ESMF_KIND_R8), allocatable :: ofld(:,:) - real(ESMF_KIND_R8), allocatable :: ocz(:,:) - real(ESMF_KIND_R8), allocatable :: ocm(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_melt_potential(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_frzmlt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) !JW - real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) !JW - real(ESMF_KIND_R8), allocatable :: ssh(:,:) - real(ESMF_KIND_R8), allocatable :: sshx(:,:) - real(ESMF_KIND_R8), allocatable :: sshy(:,:) - integer :: ijloc(2) - character(len=240) :: msgString - !-------------------------------- + fldname = 'accum_heat_frazil' + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, frazil, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + fldname = 'freezing_melting_potential' + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, frzmlt, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if - call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! ------- + ! Sea level (nems only) + ! ------- + if (.not. cesm_coupled) then + fldname = 'sea_level' - call State_getFldPtr(exportState,'accum_heat_frazil',dataPtr_frazil,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if - call State_getFldPtr(exportState,'inst_melt_potential',dataPtr_melt_potential,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !---------------- + ! Sea-surface zonal and meridional slopes + !---------------- - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frzmlt,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (cesm_coupled) then + fldname_x = 'So_dhdx' + fldname_y = 'So_dhdy' + else + fldname_x = 'sea_surface_slope_zonal' + fldname_x = 'sea_surface_slope_merid' + end if - call State_getFldPtr(exportState,'sea_surface_slope_zonal',dataPtr_dhdx,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + allocate(ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !global indices + allocate(dhdx(isc:iec, jsc:jec)) !local indices + allocate(dhdy(isc:iec, jsc:jec)) !local indices + ssh = 0.0_ESMF_KIND_R8 + dhdx = 0.0_ESMF_KIND_R8 + dhdy = 0.0_ESMF_KIND_R8 - call State_getFldPtr(exportState,'sea_surface_slope_merid',dataPtr_dhdy,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out !JW - - allocate( ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - allocate(sshx(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - allocate(sshy(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - ssh = 0.0_ESMF_KIND_R8 !JW - sshx = 0.0_ESMF_KIND_R8 !JW - sshy = 0.0_ESMF_KIND_R8 !JW - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! note: the following code is modified from NCAR nuopc driver mom_cap_methods - ! where is the rotation in that system? - ! - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - ! - ! here, isc,iec,jsc,jec are global indices on cap domain (no halos) - - do j=jsc,jec - do i=isc,iec - j1 = j - ocean_grid%jdg_offset - i1 = i - ocean_grid%idg_offset - ssh(i1,j1) = Ocean_public%sea_lev(i,j) - end do + ! Make a copy of ssh in order to do a halo update (ssh has global indexing with halos) + do j = ocean_grid%jsc, ocean_grid%jec + jloc = j + ocean_grid%jdg_offset + do i = ocean_grid%isc,ocean_grid%iec + iloc = i + ocean_grid%idg_offset + ssh(i,j) = ocean_public%sea_lev(iloc,jloc) + end do end do ! Update halo of ssh so we can calculate gradients call pass_var(ssh, ocean_grid%domain) - ! calculation of slope on native mom domains (local indexing, halos) - ! stay inside of halos (ie 2:79,2:97) ! d/dx ssh - do j = ocean_grid%jsd+1,ocean_grid%jed-1 - do i = ocean_grid%isd+1,ocean_grid%ied-1 - ! This is a simple second-order difference - !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + ! This is a simple second-order difference + ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + + do jloc = jsc, jec + j = jloc + ocean_grid%jsc - jsc + do iloc = isc,iec + i = iloc + ocean_grid%isc - isc ! This is a PLM slope which might be less prone to the A-grid null mode slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. @@ -803,23 +810,25 @@ subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, expor ! larger extreme values. slope = 0.0 end if - sshx(i,j) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 + dhdx(iloc,jloc) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dhdx(iloc,jloc) = 0.0 end do end do ! d/dy ssh - do j = ocean_grid%jsd+1,ocean_grid%jed-1 - do i = ocean_grid%isd+1,ocean_grid%ied-1 - ! This is a simple second-order difference - !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode + ! This is a simple second-order difference + ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) + + do jloc = jsc, jec + j = jloc + ocean_grid%jsc - jsc + do iloc = isc,iec + i = iloc + ocean_grid%isc - isc + ! This is a PLM slope which might be less prone to the A-ocean_grid null mode slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R if ((slp_L * slp_R) > 0.0) then ! This limits the slope so that the edge values are bounded by the ! two cell averages spanning the edge. @@ -831,103 +840,52 @@ subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, expor ! larger extreme values. slope = 0.0 end if - sshy(i,j) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 + dhdy(iloc,jloc) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dhdy(iloc,jloc) = 0.0 end do end do - ! rotate slopes from tripolar grid back to lat/lon grid (CCW) - ! "grid" uses the usual MOM domain that has halos - ! and does not use global indexing. - ! x,y => latlon - - lbnd1 = lbound(dataPtr_dhdx,1) - ubnd1 = ubound(dataPtr_dhdx,1) - lbnd2 = lbound(dataPtr_dhdx,2) - ubnd2 = ubound(dataPtr_dhdx,2) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j + ocean_grid%jsc - lbnd2 - i1 = i + ocean_grid%isc - lbnd1 - dataPtr_dhdx(i,j) = ocean_grid%cos_rot(i1,j1)*sshx(i1,j1) & - + ocean_grid%sin_rot(i1,j1)*sshy(i1,j1) - dataPtr_dhdy(i,j) = ocean_grid%cos_rot(i1,j1)*sshy(i1,j1) & - - ocean_grid%sin_rot(i1,j1)*sshx(i1,j1) - enddo - enddo - deallocate(ssh); deallocate(sshx); deallocate(sshy) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - - dataPtr_melt_potential = -dataPtr_melt_potential/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - !melt_potential, defined positive for T>Tfreeze - !so change sign - !testing - ijloc = maxloc(dataPtr_frazil) - if((sum(ijloc) .gt. 2) .and. (dataPtr_frazil(ijloc(1),ijloc(2)) .gt. 0.0))then - i1 = ijloc(1) - lbnd1 + isc - j1 = ijloc(2) - lbnd2 + jsc ! work around local vs global indexing - - write (msgString,*)' MOM6 dataPtr_frazil at maxloc ',i1,j1,& - real(dataPtr_frazil(ijloc(1),ijloc(2)),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - - write (msgString,*)' MOM6 dataPtr_melt_potential at maxloc ',i1,j1,& - real(dataPtr_melt_potential(ijloc(1),ijloc(2)),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - endif - !testing - - dataPtr_melt_potential = min(dataPtr_melt_potential,0.0) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - if(dataPtr_frazil(i,j) .eq. 0.0)then - dataPtr_frzmlt(i,j) = dataPtr_melt_potential(i,j) - else - dataPtr_frzmlt(i,j) = dataPtr_frazil(i,j) - endif - enddo - enddo - dataPtr_frzmlt = max(-1000.0,min(1000.0,dataPtr_frzmlt)) - - ! rotate ocn current from tripolar grid back to lat/lon grid (CCW) - ! "grid" uses the usual MOM domain that has halos and does not use global indexing. - ! x,y => latlon - - allocate(ofld(isc:iec,jsc:jec)) - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - deallocate(ofld) - - allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) - ocz = dataPtr_ocz - ocm = dataPtr_ocm - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j + ocean_grid%jsc - lbnd2 - i1 = i + ocean_grid%isc - lbnd1 - dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - + ocean_grid%sin_rot(i1,j1)*ocm(i,j) - dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - - ocean_grid%sin_rot(i1,j1)*ocz(i,j) - ! multiply by mask to zero out non-ocean points - dataPtr_ocz(i,j) = dataPtr_ocz(i,j) * dataPtr_mask(i,j) - dataPtr_ocm(i,j) = dataPtr_ocm(i,j) * dataPtr_mask(i,j) - enddo - enddo - deallocate(ocz, ocm) - - end subroutine mom_export_nems + if (cesm_coupled) then + ! TODO (mvertens, 2018-12-29): do we want to do the rotation like for nems? + ! and is the nems rotation correct (since GM pointed out that the NEMS taux, tauy rotation was not) + call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + else + ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) + ! "ocean_grid" uses has halos and uses global indexing. + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & + + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) + dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & + - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) + end do + end do + + call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + end subroutine mom_export !=============================================================================== From 8af6c8c3baa854383cba65beea271782a6777d7f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 30 Dec 2018 18:20:38 -0700 Subject: [PATCH 24/77] updates to set grid or mesh only in one place --- .../nuopc_driver/MOM_surface_forcing.F90 | 7 +--- config_src/nuopc_driver/mom_cap.F90 | 39 +++++++------------ config_src/nuopc_driver/mom_cap_methods.F90 | 12 +----- config_src/nuopc_driver/mom_cap_share.F90 | 34 ++++++++++++++++ 4 files changed, 51 insertions(+), 41 deletions(-) create mode 100644 config_src/nuopc_driver/mom_cap_share.F90 diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index b652b5fc9e..6528336402 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -40,6 +40,7 @@ module MOM_surface_forcing use mpp_mod, only : mpp_chksum use time_interp_external_mod, only : init_external_field, time_interp_external use time_interp_external_mod, only : time_interp_external_init +use mom_cap_share implicit none ; private @@ -196,12 +197,6 @@ module MOM_surface_forcing integer :: id_clock_forcing -#ifdef CESMCOUPLED - logical :: cesm_coupled = .true. -#else - logical :: cesm_coupled = .false. -#endif - !======================================================================= contains !======================================================================= diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index e7dfb579f5..bc409dbfd7 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -394,11 +394,8 @@ module mom_cap_mod use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid use mom_cap_time, only: AlarmInit -#ifdef CESMCOUPLED - use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit - use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel -#endif use mom_cap_methods, only: mom_import, mom_export + use mom_cap_share use, intrinsic :: iso_fortran_env, only: output_unit @@ -459,12 +456,6 @@ module mom_cap_mod character(len=*),parameter :: u_file_u = & __FILE__ -#ifdef CESMCOUPLED - logical :: cesm_coupled = .true. -#else - logical :: cesm_coupled = .false. -#endif - !======================================================================= contains !======================================================================= @@ -1195,9 +1186,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) rc = ESMF_SUCCESS -#ifdef CESMCOUPLED - call shr_file_setLogUnit (logunit) -#endif + if (cesm_coupled) then + call shr_file_setLogUnit (logunit) + end if !---------------------------------------------------------------------------- ! Get pointers to ocean internal state @@ -1284,7 +1275,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Create either a grid or a mesh !--------------------------------- - if (cesm_coupled) then + if (geomtype == ESMF_GEOMTYPE_MESH) then !--------------------------------- ! Create a MOM6 mesh @@ -1348,7 +1339,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - else + else if (geomtype == ESMF_GEOMTYPE_GRID) then !--------------------------------- ! create a MOM6 grid @@ -1936,9 +1927,9 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") -#ifdef CESMCOUPLED - call shr_file_setLogUnit (logunit) -#endif + if (cesm_coupled) then + call shr_file_setLogUnit (logunit) + end if ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & @@ -2030,9 +2021,9 @@ subroutine ModelAdvance(gcomp, rc) ! Import data !--------------- -#ifdef CESMCOUPLED - call shr_file_setLogUnit (logunit) -#endif + if (cesm_coupled) then + call shr_file_setLogUnit (logunit) + end if if (cesm_coupled) then call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) @@ -2080,11 +2071,9 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out -#ifdef CESM_COUPLED - ! reset shr logging to my original values - call shr_file_setLogUnit (output_unit) + if (cesm_coupled) then + call shr_file_setLogUnit (logunit) end if -#endif !--------------- ! If restart alarm is ringing - write restart file diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 98de08358b..a33dbf4c22 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -28,6 +28,7 @@ module mom_cap_methods use MOM_domains, only: pass_var use MOM_error_handler, only: is_root_pe use mpp_domains_mod, only: mpp_get_compute_domain + use mom_cap_share ! By default make data private implicit none @@ -45,16 +46,7 @@ module mom_cap_methods module procedure State_GetFldPtr_2d end interface -#ifdef CESMCOUPLED - logical :: cesm_coupled = .true. - type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH -#else - logical :: cesm_coupled = .false. - type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID -#endif - - integer :: rc,dbrc - integer :: import_cnt = 0 + integer :: import_cnt = 0 !=============================================================================== contains diff --git a/config_src/nuopc_driver/mom_cap_share.F90 b/config_src/nuopc_driver/mom_cap_share.F90 new file mode 100644 index 0000000000..59dc8ac0ba --- /dev/null +++ b/config_src/nuopc_driver/mom_cap_share.F90 @@ -0,0 +1,34 @@ +module mom_cap_share + ! Temporary module for sharing ccp defs and other settings + ! betwen NEMS and CMEPS + + use ESMF , only: ESMF_GeomType_Flag + use ESMF , only: ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID +#ifdef CESMCOUPLED + use shr_file_mod , only: shr_file_setLogUnit, shr_file_getLogUnit +#endif + + implicit none + public + + integer :: shrlogUnit + +#ifdef CESMCOUPLED + logical :: cesm_coupled = .true. + type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH +#else + logical :: cesm_coupled = .false. + type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID +#endif + +contains + +#ifndef CESMCOUPLED + subroutine shr_file_setLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_setLogUnit +#endif + +end module mom_cap_share From c9faeac64f2ae137b1b3c8d5858c1e4b56e77971 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 30 Dec 2018 18:21:37 -0700 Subject: [PATCH 25/77] removed trailing whitespace --- config_src/nuopc_driver/mom_cap.F90 | 2 +- config_src/nuopc_driver/mom_cap_methods.F90 | 26 ++++++++++----------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index bc409dbfd7..8c3f4ee982 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1040,7 +1040,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not in CESM ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not in CESM - ! CESM currently not used + ! CESM currently not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index a33dbf4c22..b108971dcd 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -52,8 +52,8 @@ module mom_cap_methods contains !=============================================================================== - !> This function has a few purposes: - !! (1) it imports surface fluxes using data from the mediator; and + !> This function has a few purposes: + !! (1) it imports surface fluxes using data from the mediator; and !! (2) it can apply restoring in SST and SSS. !! See \ref section_ocn_import for a summary of the surface fluxes that are !! passed from MCT to MOM6, including fluxes that need to be included in the future. @@ -162,7 +162,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! ------- ! Net longwave radiation (W/m2) ! ------- - ! Different treatment of long wave dependent on atmosphere + ! Different treatment of long wave dependent on atmosphere ! When running with cam or datm - need Foxx_lwup and Faxa_lwdn ! When running with fv3 - need mean_net_lw_flx @@ -431,7 +431,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, file=__FILE__)) & return ! bail out if (cesm_coupled) then - ! salt flux (minus sign needed here -GMM) + ! salt flux (minus sign needed here -GMM) ! TODO (mvertens, 2018-12-28): NEMS does not have a minus sign - which one is right? do j = jsc,jec do i = isc,iec @@ -439,7 +439,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, enddo enddo end if - + !---- ! mass of overlying ice !---- @@ -517,7 +517,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end if !---------------- - ! Copy from ocean_public to exportstate. + ! Copy from ocean_public to exportstate. !---------------- call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) @@ -675,7 +675,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int else melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int - if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 + if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 end if end do end do @@ -684,7 +684,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do i = isc,iec ! TODO (mvertens, 2018-12-29): use inv_dt_int from cesm - and not the original implementation? melt_potential(i,j) = -melt_potential(i,j) / dt_cpld - if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 + if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 end do end do end if @@ -705,7 +705,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do j = jsc,jec do i = isc,iec !convert from J/m^2 to W/m^2 for CICE coupling - frazil(i,j) = ocean_public%frazil(i,j)/dt_cpld + frazil(i,j) = ocean_public%frazil(i,j)/dt_cpld if (frazil(i,j) == 0.0) then frzmlt(i,j) = melt_potential(i,j) else @@ -876,7 +876,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, file=__FILE__)) & return ! bail out end if - + end subroutine mom_export !=============================================================================== @@ -977,7 +977,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r n = 0 do j = jsc,jec do i = isc,iec - n = n + 1 + n = n + 1 if (present(do_sum)) then output(i,j) = output(i,j) + dataPtr1d(n) else @@ -1076,12 +1076,12 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid lbnd2 = lbound(dataPtr2d,2) do j = jsc, jec - j1 = j + lbnd2 - jsc + j1 = j + lbnd2 - jsc jg = j + ocean_grid%jsc - jsc do i = isc, iec i1 = i + lbnd1 - isc ig = i + ocean_grid%isc - isc - dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) + dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) end do end do From 5a2dd8be0aaeb3a5aa4fba8aed120ee841ad553a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 31 Dec 2018 10:09:03 -0700 Subject: [PATCH 26/77] more unification --- config_src/nuopc_driver/mom_cap.F90 | 234 ++++++++------- config_src/nuopc_driver/mom_cap_methods.F90 | 303 +++++++++++--------- config_src/nuopc_driver/mom_cap_share.F90 | 8 + 3 files changed, 283 insertions(+), 262 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 8c3f4ee982..662a8bd011 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -429,8 +429,6 @@ module mom_cap_mod character(len=64) :: stdname character(len=64) :: shortname character(len=64) :: transferOffer - logical :: assoc ! is the farrayPtr associated with internal data - real(ESMF_KIND_R8), dimension(:,:), pointer :: farrayPtr end type fld_list_type integer,parameter :: fldsMax = 100 @@ -443,7 +441,6 @@ module mom_cap_mod integer :: import_slice = 1 integer :: export_slice = 1 character(len=256) :: tmpstr - type(ESMF_Grid) :: mom_grid_i logical :: write_diagnostics = .false. character(len=32) :: runtype ! run type integer :: logunit ! stdout logging unit number @@ -763,9 +760,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: userRc character(len=512) :: restartfile ! Path/Name of restart file character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' - real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_frzmlt - real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdx - real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdy !-------------------------------- rc = ESMF_SUCCESS @@ -1167,7 +1161,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: nblocks_tot logical :: found real(ESMF_KIND_R8), allocatable :: ofld(:,:), gfld(:,:) - real(ESMF_KIND_R8), pointer :: t_surf(:,:) + real(ESMF_KIND_R8), pointer :: t_surf1d(:,:) + real(ESMF_KIND_R8), pointer :: t_surf2d(:,:) integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) @@ -1180,6 +1175,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: lsize integer :: ig,jg, ni,nj,k integer, allocatable :: gindex(:) ! global index space + character(len=128) :: fldname character(len=256) :: cvalue character(len=*), parameter :: subname='(mom_cap:InitializeRealize)' !-------------------------------- @@ -1333,6 +1329,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out + call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", mesh=Emesh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1450,8 +1447,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - mom_grid_i = gridIn - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1737,46 +1732,58 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) endif !--------------------------------- - ! realize fields on grid + ! set surface temperature to 0 if ocean mask is 0 !--------------------------------- - call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) + ! TODO (mvertens, 2018-12-30): is this really necessary? for now only do this for grid + + if (cesm_coupled) then + fldname = 'So_t' + else + fldname = 'sea_surface_temperature' + end if + + call ESMF_StateGet(exportState, itemSearch=trim(fldname), itemCount=icount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out ! Do sst initialization if it's part of export state - if(icount /= 0) then - - call ESMF_StateGet(exportState, itemName='sea_surface_temperature', field=field_t_surf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - - lbnd1 = lbound(t_surf,1) - ubnd1 = ubound(t_surf,1) - lbnd2 = lbound(t_surf,2) - ubnd2 = ubound(t_surf,2) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - if (ofld(i1,j1) == 0.) t_surf(i,j) = 0.0 - enddo - enddo + if (icount /= 0) then + call ESMF_StateGet(exportState, itemName=trim(fldname), field=field_t_surf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(t_surf2d,1) + ubnd1 = ubound(t_surf2d,1) + lbnd2 = lbound(t_surf2d,2) + ubnd2 = ubound(t_surf2d,2) + + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + if (ofld(i1,j1) == 0.) t_surf2d(i,j) = 0.0 + enddo + enddo + end if + end if - deallocate(ofld) - endif + !--------------------------------- + ! write out diagnostics + !--------------------------------- !call NUOPC_Write(exportState, fileNamePrefix='post_realize_field_ocn_export_', & ! timeslice=1, relaxedFlag=.true., rc=rc) @@ -1784,7 +1791,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out - + end subroutine InitializeRealize !=============================================================================== @@ -2409,6 +2416,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ ! ---------------------------------------------- ! Set scalar data from State for a particular name ! ---------------------------------------------- + real(ESMF_KIND_R8),intent(in) :: value integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State @@ -2418,10 +2426,10 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(inout) :: rc ! local variables - integer :: ierr, len type(ESMF_Field) :: field real(ESMF_KIND_R8), pointer :: farrayptr(:,:) character(len=*), parameter :: subname='(mom_cap:State_SetScalar)' + !-------------------------------------------------------- rc = ESMF_SUCCESS @@ -2448,6 +2456,7 @@ end subroutine State_SetScalar subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) + ! input/output variables type(ESMF_State) , intent(inout) :: state integer , intent(in) :: nfields type(fld_list_type) , intent(inout) :: field_defs(:) @@ -2456,13 +2465,13 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) type(ESMF_Mesh) , intent(in), optional :: mesh integer , intent(inout) :: rc - integer :: i - type(ESMF_Field) :: field - integer :: npet, nx, ny, pet - integer :: elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) - type(ESMF_VM) :: vm - real(ESMF_KIND_R8), pointer :: fldptr(:,:) + ! local variables + integer :: i + type(ESMF_Field) :: field + real(ESMF_KIND_R8), pointer :: fldptr1d(:) ! for mesh + real(ESMF_KIND_R8), pointer :: fldptr2d(:,:) ! for grid character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' + !-------------------------------------------------------- rc = ESMF_SUCCESS @@ -2471,45 +2480,18 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then if (field_defs(i)%shortname == scalar_field_name) then + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & rc=rc) + call SetScalarField(field, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - elseif (field_defs(i)%assoc) then - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname)& - // " is connected and associated.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) - write(tmpstr,'(a,4i12)') subname//trim(tag)//' Field '//trim(field_defs(i)%shortname)//':', & - lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & - lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) - call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=rc) - - if (present(grid)) then - field = ESMF_FieldCreate(grid=grid, & - farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & - !farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else if (present(mesh)) then - field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if else @@ -2518,6 +2500,7 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) line=__LINE__, & file=__FILE__, & rc=rc) + if (present(grid)) then field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & @@ -2527,13 +2510,13 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) file=__FILE__)) & return ! bail out - ! initialize to zero - call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - fldptr = 0.0 + fldptr2d(:,:) = 0.0 else if (present(mesh)) then @@ -2543,16 +2526,28 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) line=__LINE__, & file=__FILE__)) & return ! bail out + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr1d(:) = 0.0 + end if endif + ! Realize connected field call NUOPC_Realize(state, field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - else + + else ! field is not connected + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & ESMF_LOGMSG_INFO, & line=__LINE__, & @@ -2564,63 +2559,67 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) line=__LINE__, & file=__FILE__)) & return ! bail out + endif enddo - end subroutine MOM_RealizeFields + contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -!=============================================================================== + subroutine SetScalarField(field, rc) - subroutine SetScalarField(field, rc) - ! ---------------------------------------------- - ! create a field with scalar data on the root pe - ! ---------------------------------------------- - type(ESMF_Field), intent(inout) :: field - integer, intent(inout) :: rc + ! create a field with scalar data on the root pe + type(ESMF_Field), intent(inout) :: field + integer, intent(inout) :: rc - ! local variables - type(ESMF_Distgrid) :: distgrid - type(ESMF_Grid) :: grid - character(len=*), parameter :: subname='(mom_cap:SetScalarField)' + ! local variables + type(ESMF_Distgrid) :: distgrid + type(ESMF_Grid) :: grid + character(len=*), parameter :: subname='(mom_cap:SetScalarField)' - rc = ESMF_SUCCESS + rc = ESMF_SUCCESS - ! create a DistGrid with a single index space element, which gets mapped onto DE 0. - distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! create a DistGrid with a single index space element, which gets mapped onto DE 0. + distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - grid = ESMF_GridCreate(distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + grid = ESMF_GridCreate(distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, & - typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), & - ungriddedUBound=(/scalar_field_count/), & ! num of scalar values - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), rc=rc) ! num of scalar values + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - end subroutine SetScalarField + end subroutine SetScalarField + + end subroutine MOM_RealizeFields !=============================================================================== - subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) + subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) ! ---------------------------------------------- ! Set up a list of field information ! ---------------------------------------------- - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname - character(len=*), intent(in) :: transferOffer - real(ESMF_KIND_R8), dimension(:,:), optional, target :: data - character(len=*), intent(in),optional :: shortname + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + character(len=*), intent(in) :: transferOffer + character(len=*), optional, intent(in) :: shortname ! local variables integer :: rc character(len=*), parameter :: subname='(mom_cap:fld_list_add)' ! fill in the new entry - num = num + 1 if (num > fldsMax) then call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & @@ -2636,13 +2635,6 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) fldlist(num)%shortname = trim(stdname) endif fldlist(num)%transferOffer = trim(transferOffer) - if (present(data)) then - fldlist(num)%assoc = .true. - ! The following sets up the data pointer that will be used in the realize call - fldlist(num)%farrayPtr => data - else - fldlist(num)%assoc = .false. - endif end subroutine fld_list_add diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index b108971dcd..19e4c01251 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -5,9 +5,6 @@ module mom_cap_methods ! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` ! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. - - use NUOPC, only: NUOPC_Advertise, NUOPC_Realize, NUOPC_IsConnected - use NUOPC_Model, only: NUOPC_ModelGet use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet use ESMF, only: ESMF_State, ESMF_StateGet @@ -430,6 +427,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, line=__LINE__, & file=__FILE__)) & return ! bail out + if (cesm_coupled) then ! salt flux (minus sign needed here -GMM) ! TODO (mvertens, 2018-12-28): NEMS does not have a minus sign - which one is right? @@ -443,8 +441,9 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! mass of overlying ice !---- - if (.not. cesm_coupled) then - fldname = 'mass_of_overlying_ice' + fldname = 'mass_of_overlying_ice' + call ESMF_StateGet(importState, trim(fldname), itemFlag) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then call state_getimport(importState, trim(fldname), & isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -476,12 +475,16 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, integer :: isc, iec, jsc, jec ! local indices integer :: iloc, jloc ! local indices integer :: n + integer :: icount real :: slp_L, slp_R, slp_C real :: slope, u_min, u_max integer :: day, secs type(ESMF_TimeInterval) :: timeStep integer :: dt_int real :: inv_dt_int !< The inverse of coupling time interval in s-1. + type(ESMF_StateItem_Flag) :: itemFlag + type(ESMF_StateItem_Flag) :: itemFlag1 + type(ESMF_StateItem_Flag) :: itemFlag2 character(len=128) :: fldname character(len=128) :: fldname_x character(len=128) :: fldname_y @@ -590,30 +593,31 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, fldname_y = 'ocn_current_merid' end if - if (cesm_coupled) then - call State_SetExport(exportState, trim(fldname_x), & - isc, iec, jsc, jec, ocean_public%u_surf, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_SetExport(exportState, trim(fldname_y), & - isc, iec, jsc, jec, ocean_public%v_surf, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else + ! rotate ocn current from tripolar grid back to lat/lon grid x,y => latlon (CCW) + ! "ocean_grid" has halos and uses global indexing. - ! rotate ocn current from tripolar grid back to lat/lon grid x,y => latlon (CCW) - ! "ocean_grid" has halos and uses global indexing. + ! TODO (mvertens, 2018-12-30): Only one of these is correct - the cesm_coupled one is the + ! latest and is the one that GM feels is the correct one - allocate(ocz(isc:iec, jsc:jec)) - allocate(ocm(isc:iec, jsc:jec)) - allocate(ocz_rot(isc:iec, jsc:jec)) - allocate(ocm_rot(isc:iec, jsc:jec)) + allocate(ocz(isc:iec, jsc:jec)) + allocate(ocm(isc:iec, jsc:jec)) + allocate(ocz_rot(isc:iec, jsc:jec)) + allocate(ocm_rot(isc:iec, jsc:jec)) + if (cesm_coupled) then + ! do j = jsc, jec + ! jg = j + ocean_grid%jsc - jsc + ! do i = isc, iec + ! ig = i + ocean_grid%isc - isc + ! ocz(i,j) = ocean_public%u_surf(i,j) + ! ocm(i,j) = ocean_public%v_surf(i,j) + ! ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) & + ! - ocean_grid%sin_rot(ig,jg)*ocm(i,j) + ! ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) & + ! + ocean_grid%sin_rot(ig,jg)*ocz(i,j) + ! end do + ! end do + else do j = jsc, jec jg = j + ocean_grid%jsc - jsc do i = isc, iec @@ -626,28 +630,28 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, - ocean_grid%sin_rot(ig,jg)*ocz(i,j) end do end do - - call State_SetExport(exportState, trim(fldname_x), & - isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_SetExport(exportState, trim(fldname_y), & - isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + call State_SetExport(exportState, trim(fldname_x), & + isc, iec, jsc, jec, ocean_public%u_surf, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call State_SetExport(exportState, trim(fldname_y), & + isc, iec, jsc, jec, ocean_public%v_surf, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! ------- ! Boundary layer depth ! ------- - if (cesm_coupled) then - fldname = 'So_bldepth' + fldname = 'So_bldepth' + call ESMF_StateGet(exportState, trim(fldname), itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then call State_SetExport(exportState, trim(fldname), & isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -696,9 +700,13 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, return ! bail out ! ------- - ! frazil and freezing melting potential (nems only) + ! frazil and freezing melting potential ! ------- - if (.not. cesm_coupled) then + + call ESMF_StateGet(exportState, 'accum_heat_frazil' , itemFlag1) + call ESMF_StateGet(exportState, 'freezing_melting_potential', itemFlag2) + if (itemFlag1 /= ESMF_STATEITEM_NOTFOUND .and. itemFlag2 /= ESMF_STATEITEM_NOTFOUND) then + allocate(frazil(isc:iec, jsc:jec)) allocate(frzmlt(isc:iec, jsc:jec)) @@ -733,11 +741,11 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end if ! ------- - ! Sea level (nems only) + ! Sea level ! ------- - if (.not. cesm_coupled) then - fldname = 'sea_level' - + fldname = 'sea_level' + call ESMF_StateGet(exportState, trim(fldname), itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then call State_SetExport(exportState, trim(fldname), & isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -837,23 +845,23 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end do end do - if (cesm_coupled) then - ! TODO (mvertens, 2018-12-29): do we want to do the rotation like for nems? - ! and is the nems rotation correct (since GM pointed out that the NEMS taux, tauy rotation was not) - call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) + ! "ocean_grid" uses has halos and uses global indexing. + ! TODO (mvertens, 2018-12-30): Only one of these is correct - the cesm_coupled one is the + ! latest and is the one that GM feels is the correct one + if (cesm_coupled) then + ! do j = jsc, jec + ! jg = j + ocean_grid%jsc - jsc + ! do i = isc, iec + ! ig = i + ocean_grid%isc - isc + ! dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & + ! - ocean_grid%sin_rot(ig,jg)*dhdy(i,j) + ! dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & + ! + ocean_grid%sin_rot(ig,jg)*dhdx(i,j) + ! end do + ! end do else - ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) - ! "ocean_grid" uses has halos and uses global indexing. do j = jsc, jec jg = j + ocean_grid%jsc - jsc do i = isc, iec @@ -864,19 +872,20 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) end do end do - - call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out end if + call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end subroutine mom_export !=============================================================================== @@ -955,6 +964,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r integer , intent(out) :: rc ! local variables + type(ESMF_StateItem_Flag) :: itemFlag integer :: n, i, j, i1, j1 integer :: lbnd1,lbnd2 real(ESMF_KIND_R8), pointer :: dataPtr1d(:) @@ -964,50 +974,55 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r rc = ESMF_SUCCESS - if (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - ! get field pointer - call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (geomtype == ESMF_GEOMTYPE_MESH) then - ! determine output array - n = 0 - do j = jsc,jec - do i = isc,iec - n = n + 1 - if (present(do_sum)) then - output(i,j) = output(i,j) + dataPtr1d(n) - else - output(i,j) = dataPtr1d(n) - end if + ! get field pointer + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! determine output array + n = 0 + do j = jsc,jec + do i = isc,iec + n = n + 1 + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr1d(n) + else + output(i,j) = dataPtr1d(n) + end if + end do end do - end do - else if (geomtype == ESMF_GEOMTYPE_GRID) then + else if (geomtype == ESMF_GEOMTYPE_GRID) then - call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - lbnd1 = lbound(dataPtr2d,1) - lbnd2 = lbound(dataPtr2d,2) + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) - do j = jsc, jec - j1 = j + lbnd2 - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - if (present(do_sum)) then - output(i,j) = output(i,j) + dataPtr2d(i1,j1) - else - output(i,j) = dataPtr2d(i1,j1) - end if + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr2d(i1,j1) + else + output(i,j) = dataPtr2d(i1,j1) + end if + end do end do - end do + + end if end if @@ -1033,6 +1048,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid integer , intent(out) :: rc ! local variables + type(ESMF_StateItem_Flag) :: itemFlag integer :: n, i, j, i1, j1, ig,jg integer :: lbnd1,lbnd2 real(ESMF_KIND_R8), pointer :: dataPtr1d(:) @@ -1046,44 +1062,49 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid ! input array from "ocean_public" uses local indexing without halos ! mask from "ocean_grid" uses global indexing with halos - if (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (geomtype == ESMF_GEOMTYPE_MESH) then - n = 0 - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - n = n+1 - dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + n = 0 + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + n = n+1 + dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) + end do end do - end do - else if (geomtype == ESMF_GEOMTYPE_GRID) then + else if (geomtype == ESMF_GEOMTYPE_GRID) then - call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - lbnd1 = lbound(dataPtr2d,1) - lbnd2 = lbound(dataPtr2d,2) + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + ocean_grid%isc - isc - dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) + end do end do - end do + + end if end if diff --git a/config_src/nuopc_driver/mom_cap_share.F90 b/config_src/nuopc_driver/mom_cap_share.F90 index 59dc8ac0ba..cc13f39548 100644 --- a/config_src/nuopc_driver/mom_cap_share.F90 +++ b/config_src/nuopc_driver/mom_cap_share.F90 @@ -21,7 +21,9 @@ module mom_cap_share type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID #endif +!======================================================================= contains +!======================================================================= #ifndef CESMCOUPLED subroutine shr_file_setLogUnit(nunit) @@ -29,6 +31,12 @@ subroutine shr_file_setLogUnit(nunit) ! do nothing for this stub - its just here to replace ! having cppdefs in the main program end subroutine shr_file_setLogUnit + + subroutine shr_file_getLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_getLogUnit #endif end module mom_cap_share From 9deec5d14a2a316f6177a53a81d57a8fc9727b39 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 31 Dec 2018 10:09:44 -0700 Subject: [PATCH 27/77] removed trailing whitespace --- config_src/nuopc_driver/mom_cap.F90 | 12 ++++++------ config_src/nuopc_driver/mom_cap_methods.F90 | 6 +++--- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 662a8bd011..515131178e 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1732,7 +1732,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) endif !--------------------------------- - ! set surface temperature to 0 if ocean mask is 0 + ! set surface temperature to 0 if ocean mask is 0 !--------------------------------- ! TODO (mvertens, 2018-12-30): is this really necessary? for now only do this for grid @@ -1756,21 +1756,21 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - + if (geomtype == ESMF_GEOMTYPE_GRID) then call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + lbnd1 = lbound(t_surf2d,1) ubnd1 = ubound(t_surf2d,1) lbnd2 = lbound(t_surf2d,2) ubnd2 = ubound(t_surf2d,2) - + do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1791,7 +1791,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out - + end subroutine InitializeRealize !=============================================================================== diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 19e4c01251..5eb719fcea 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -638,7 +638,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetExport(exportState, trim(fldname_y), & isc, iec, jsc, jec, ocean_public%v_surf, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -700,7 +700,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, return ! bail out ! ------- - ! frazil and freezing melting potential + ! frazil and freezing melting potential ! ------- call ESMF_StateGet(exportState, 'accum_heat_frazil' , itemFlag1) @@ -741,7 +741,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end if ! ------- - ! Sea level + ! Sea level ! ------- fldname = 'sea_level' call ESMF_StateGet(exportState, trim(fldname), itemFlag, rc=rc) From 1d61f0aa21d6d1b5c1ee1c00a2026dde9dc17321 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 31 Dec 2018 19:46:01 -0700 Subject: [PATCH 28/77] rename import swnet fluxes for cesm --- config_src/nuopc_driver/mom_cap.F90 | 43 ++++++++++----------- config_src/nuopc_driver/mom_cap_methods.F90 | 30 ++++++++++++-- 2 files changed, 47 insertions(+), 26 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 515131178e..964e758c1d 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1007,39 +1007,38 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (len_trim(scalar_field_name) > 0) then call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC endif - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") ! -> mean_net_sw_ir_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") ! -> mean_net_sw_ir_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") ! -> mean_net_sw_vis_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up (coupled to cam) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") ! -> mean long wave down (coupled to cam) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will_provide") ! -> coupled to fv3 + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdr" , "will provide") ! -> mean_net_sw_ir_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdf" , "will provide") ! -> mean_net_sw_vis_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idr" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idf" , "will provide") ! -> mean_net_sw_vis_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") ! -> liquid runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") ! -> ice runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up (coupled to cam) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") ! -> mean long wave down (coupled to cam) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will_provide") ! -> coupled to fv3 ! EMC fields not used - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not in CESM ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not in CESM ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not in CESM - ! CESM currently not used + ! CESM fields currently not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 5eb719fcea..68ea03a8bf 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -119,7 +119,12 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! near-IR, direct shortwave (W/m2) !---- - call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & + if (cesm_coupled) then + fldname = 'Foxx_swnet_idr' + else + fldname = 'mean_net_sw_ir_dir_flx' + end if + call state_getimport(importState, trim(fldname), & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -129,7 +134,12 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! near-IR, diffuse shortwave (W/m2) !---- - call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & + if (cesm_coupled) then + fldname = 'Foxx_swnet_idf' + else + fldname = 'mean_net_sw_ir_dif_flx' + end if + call state_getimport(importState, trim(fldname), & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -139,7 +149,12 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! visible, direct shortwave (W/m2) !---- - call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & + if (cesm_coupled) then + fldname = 'Foxx_swnet_vdr' + else + fldname = 'mean_net_sw_vis_dir_flx' + end if + call state_getimport(importState, trim(fldname), & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -149,7 +164,12 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! visible, diffuse shortwave (W/m2) !---- - call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & + if (cesm_coupled) then + fldname = 'Foxx_swnet_vdf' + else + fldname = 'mean_net_sw_vis_dif_flx' + end if + call state_getimport(importState, trim(fldname), & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -173,6 +193,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, else isPresent_lwup = .false. end if + call ESMF_StateGet(importState, 'Faxa_lwdn', itemFlag, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -183,6 +204,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, else isPresent_lwdn = .false. end if + call ESMF_StateGet(importState, "mean_net_lw_flx", itemFlag, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & From a3ab66e858a3c324ce740300eea8c7dd3fda3ea0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 31 Dec 2018 20:30:13 -0700 Subject: [PATCH 29/77] turned on rotations of stress, current and slope deriv in cesm mode --- config_src/nuopc_driver/mom_cap_methods.F90 | 56 ++++++++++----------- 1 file changed, 26 insertions(+), 30 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 68ea03a8bf..ff33b4418d 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -23,7 +23,6 @@ module mom_cap_methods use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type use MOM_domains, only: pass_var - use MOM_error_handler, only: is_root_pe use mpp_domains_mod, only: mpp_get_compute_domain use mom_cap_share @@ -271,13 +270,10 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, jg = j + ocean_grid%jsc - jsc do i = isc, iec ig = i + ocean_grid%isc - isc - ! TODO (mvertens, 2018-12-28): create a new baseline with these changes - ! ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg) * taux(i,j) & - ! + ocean_grid%sin_rot(ig,jg) * tauy(i,j) - ! ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg) * tauy(i,j) & - ! - ocean_grid%sin_rot(ig,jg) * taux(i,j) - ice_ocean_boundary%u_flux(i,j) = taux(i,j) - ice_ocean_boundary%v_flux(i,j) = tauy(i,j) + ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg) * taux(i,j) & + + ocean_grid%sin_rot(ig,jg) * tauy(i,j) + ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg) * tauy(i,j) & + - ocean_grid%sin_rot(ig,jg) * taux(i,j) end do end do else @@ -627,18 +623,18 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, allocate(ocm_rot(isc:iec, jsc:jec)) if (cesm_coupled) then - ! do j = jsc, jec - ! jg = j + ocean_grid%jsc - jsc - ! do i = isc, iec - ! ig = i + ocean_grid%isc - isc - ! ocz(i,j) = ocean_public%u_surf(i,j) - ! ocm(i,j) = ocean_public%v_surf(i,j) - ! ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) & - ! - ocean_grid%sin_rot(ig,jg)*ocm(i,j) - ! ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) & - ! + ocean_grid%sin_rot(ig,jg)*ocz(i,j) - ! end do - ! end do + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ocz(i,j) = ocean_public%u_surf(i,j) + ocm(i,j) = ocean_public%v_surf(i,j) + ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) & + - ocean_grid%sin_rot(ig,jg)*ocm(i,j) + ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) & + + ocean_grid%sin_rot(ig,jg)*ocz(i,j) + end do + end do else do j = jsc, jec jg = j + ocean_grid%jsc - jsc @@ -873,16 +869,16 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! TODO (mvertens, 2018-12-30): Only one of these is correct - the cesm_coupled one is the ! latest and is the one that GM feels is the correct one if (cesm_coupled) then - ! do j = jsc, jec - ! jg = j + ocean_grid%jsc - jsc - ! do i = isc, iec - ! ig = i + ocean_grid%isc - isc - ! dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & - ! - ocean_grid%sin_rot(ig,jg)*dhdy(i,j) - ! dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & - ! + ocean_grid%sin_rot(ig,jg)*dhdx(i,j) - ! end do - ! end do + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & + - ocean_grid%sin_rot(ig,jg)*dhdy(i,j) + dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & + + ocean_grid%sin_rot(ig,jg)*dhdx(i,j) + end do + end do else do j = jsc, jec jg = j + ocean_grid%jsc - jsc From a22a7ef7e19db9a4a6bf4606ffa6397a76bfd13e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 31 Dec 2018 21:05:17 -0700 Subject: [PATCH 30/77] added required allocatable --- config_src/nuopc_driver/mom_cap_methods.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index ff33b4418d..9632189c46 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -785,8 +785,10 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end if allocate(ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !global indices - allocate(dhdx(isc:iec, jsc:jec)) !local indices - allocate(dhdy(isc:iec, jsc:jec)) !local indices + allocate(dhdx(isc:iec, jsc:jec)) !local indices + allocate(dhdy(isc:iec, jsc:jec)) !local indices + allocate(dhdx_rot(isc:iec, jsc:jec)) !local indices + allocate(dhdy_rot(isc:iec, jsc:jec)) !local indices ssh = 0.0_ESMF_KIND_R8 dhdx = 0.0_ESMF_KIND_R8 dhdy = 0.0_ESMF_KIND_R8 From fe0aedbf7a8da06384b582075d76bb7d3b436663 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 1 Jan 2019 18:58:43 -0700 Subject: [PATCH 31/77] removed separate receive of lwup and lwdn to compute lwnet for cesm_coupled mode --- .../nuopc_driver/MOM_surface_forcing.F90 | 67 ++++----- config_src/nuopc_driver/mom_cap.F90 | 137 ++++++++---------- config_src/nuopc_driver/mom_cap_methods.F90 | 62 +------- 3 files changed, 97 insertions(+), 169 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 6528336402..a21b00f839 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -185,14 +185,14 @@ module MOM_surface_forcing !! ice-shelves, expressed as a coefficient !! for divergence damping, as determined !! outside of the ocean model in (m3/s) - integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT - type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of - !! named fields used for passive tracer fluxes. - integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of - !! wind stresses. This flag may be set by the - !! flux-exchange code, based on what the sea-ice - !! model is providing. Otherwise, the value from - !! the surface_forcing_CS is used. + integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT + type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of + !! named fields used for passive tracer fluxes. + integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of + !! wind stresses. This flag may be set by the + !! flux-exchange code, based on what the sea-ice + !! model is providing. Otherwise, the value from + !! the surface_forcing_CS is used. end type ice_ocean_boundary_type integer :: id_clock_forcing @@ -417,7 +417,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & enddo ; enddo endif - ! obtain fluxes from IOB; note the staggering of indices i0 = is - isc_bnd ; j0 = js - jsc_bnd do j=js,je ; do i=is,ie @@ -431,34 +430,28 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & if (associated(IOB%q_flux)) & fluxes%evap(i,j) = IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) - ! Note: currently runoff is treated differently for nems and cesm coupling - if (cesm_coupled) then - ! liquid runoff flux - if (associated(fluxes%lrunoff)) & - fluxes%lrunoff(i,j) = G%mask2dT(i,j) * IOB%rofl_flux(i-i0,j-j0) - - ! ice runoff flux - if (associated(fluxes%frunoff)) & - fluxes%frunoff(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0) - else - if (associated(IOB%runoff)) & - fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + ! liquid runoff flux + if (associated(IOB%rofl_flux)) then + fluxes%lrunoff(i,j) = IOB%rofl_flux(i-i0,j-j0) * G%mask2dT(i,j) + else if (associated(IOB%runoff)) then + fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) end if - if (.not. cesm_coupled) then - if (associated(IOB%calving)) & - fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + ! ice runoff flux + if (associated(IOB%rofi_flux)) then + fluxes%frunoff(i,j) = IOB%rofi_flux(i-i0,j-j0) * G%mask2dT(i,j) + else if (associated(IOB%calving)) then + fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + end if - if (associated(IOB%area_berg)) & - fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%ustar_berg)) & + fluxes%ustar_berg(i,j) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%mass_berg)) & - fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%area_berg)) & + fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) - end if + if (associated(IOB%mass_berg)) & + fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%runoff_hflx)) & fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) @@ -473,9 +466,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) ! Note: currently latent heat flux is treated differently for nems and cesm - if (cesm_coupled) then - if (associated(IOB%latent_flux)) & - fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) + if (associated(IOB%latent_flux)) then + fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) else fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then @@ -490,18 +482,21 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor endif - fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) end if if (associated(IOB%sw_flux_vis_dir)) & fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0) + if (associated(IOB%sw_flux_vis_dif)) & fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dif(i-i0,j-j0) + if (associated(IOB%sw_flux_nir_dir)) & fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dir(i-i0,j-j0) + if (associated(IOB%sw_flux_nir_dif)) & fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dif(i-i0,j-j0) + fluxes%sw(i,j) = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + & fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 964e758c1d..b03ee9c0d3 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -222,28 +222,28 @@ !! !! @subsection ImportFields Import Fields !! -!! Standard Name | Units | Model Variable | Description | Notes +!! Standard Name | Units | Model Variable | Description | Notes !! --------------------------|------------|-----------------|---------------------------------------|------------------- !! inst_pres_height_surface | Pa | p | pressure of overlying sea ice and atmosphere -!! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | +!! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | !! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean -!! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | -!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) -!! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | +!! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | +!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) +!! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | !! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean -!! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar -!! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | +!! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | !! mean_net_sw_ir_dif_flx | W m-2 | sw_flux_nir_dif | diffuse near IR shortwave radiation| | -!! mean_net_sw_ir_dir_flx | W m-2 | sw_flux_nir_dir | direct near IR shortwave radiation| | +!! mean_net_sw_ir_dir_flx | W m-2 | sw_flux_nir_dir | direct near IR shortwave radiation | | !! mean_net_sw_vis_dif_flx | W m-2 | sw_flux_vis_dif | diffuse visible shortware radiation| | -!! mean_net_sw_vis_dir_flx | W m-2 | sw_flux_vis_dir | direct visible shortware radiation| | -!! mean_prec_rate | kg m-2 s-1 | lprec | mass flux of liquid precip | | +!! mean_net_sw_vis_dir_flx | W m-2 | sw_flux_vis_dir | direct visible shortware radiation | | +!! mean_prec_rate | kg m-2 s-1 | lprec | mass flux of liquid precip | | !! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean -!! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | -!! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | -!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) +!! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | +!! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | +!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) !! mean_zonal_moment_flx | Pa | u_flux | j-directed wind stress into ocean -!! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar !! !! !! @subsection ExportField Export Fields @@ -254,15 +254,15 @@ !! Standard Name | Units | Model Variable | Description | Notes !! ---------------------------|-------|----------------|-------------------------------------------|-------------------- !! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation -!! | cap converts model units (J m-2) to (W m-2) for export +!! | cap converts model units (J m-2) to (W m-2) for export !! ocean_mask | | | ocean mask | | !! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell -!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon !! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell -!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon !! s_surf | psu | s_surf | sea surface salinity on t-cell | | !! sea_lev | m | sea_lev | sea level -!! | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide +!! | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide !! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | !! !! @subsection MemoryManagement Memory Management @@ -1001,66 +1001,51 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out + ! CESM fields currently not used in cesm_coupled + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") + if (cesm_coupled) then !--------- import fields ------------- if (len_trim(scalar_field_name) > 0) then call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC endif - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdr" , "will provide") ! -> mean_net_sw_ir_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdf" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idr" , "will provide") ! -> mean_net_sw_ir_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idf" , "will provide") ! -> mean_net_sw_vis_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") ! -> liquid runoff - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") ! -> ice runoff - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up (coupled to cam) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") ! -> mean long wave down (coupled to cam) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will_provide") ! -> coupled to fv3 - - ! EMC fields not used - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") ! not in CESM - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not in CESM - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not in CESM - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not in CESM - - ! CESM fields currently not used - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwnet" , "will_provide") ! -> mean net lwnet + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdr" , "will provide") ! -> mean_net_sw_ir_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdf" , "will provide") ! -> mean_net_sw_vis_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idr" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idf" , "will provide") ! -> mean_net_sw_vis_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") ! -> liquid runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") ! -> ice runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface !--------- export fields ------------- if (len_trim(scalar_field_name) > 0) then call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") ! not in EMC endif - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! -> not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential - - ! EMC fields not used in CESM - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") - - ! CESM fields currently not used in EMC - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! -> not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential else @@ -1077,12 +1062,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! not used in NEMS + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not used in NEMS + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") ! not used in NEMS + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not used in NEMS + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not used in NEMS !--------- export fields ------------- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") @@ -1090,12 +1075,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide") ! not used in NEMS + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide") ! not used in NEMS + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") ! not used in NEMS end if do n = 1,fldsToOcn_num diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 9632189c46..c1de995004 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -69,9 +69,6 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, integer :: i, j, ig, jg, n integer :: isc, iec, jsc, jec logical :: do_import - logical :: isPresent_lwup - logical :: isPresent_lwdn - logical :: isPresent_lwnet character(len=128) :: fldname character(len=128) :: fldname_x character(len=128) :: fldname_y @@ -178,66 +175,17 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! ------- ! Net longwave radiation (W/m2) ! ------- - ! Different treatment of long wave dependent on atmosphere - ! When running with cam or datm - need Foxx_lwup and Faxa_lwdn - ! When running with fv3 - need mean_net_lw_flx - - call ESMF_StateGet(importState, 'Foxx_lwup', itemFlag, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - isPresent_lwup = .true. - else - isPresent_lwup = .false. - end if - - call ESMF_StateGet(importState, 'Faxa_lwdn', itemFlag, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - isPresent_lwdn = .true. + if (cesm_coupled) then + fldname = 'Foxx_lwnet' else - isPresent_lwdn = .false. + fldname = 'mean_net_lw_flx' end if - - call ESMF_StateGet(importState, "mean_net_lw_flx", itemFlag, rc=rc) + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - isPresent_lwnet = .true. - else - isPresent_lwnet = .false. - end if - - if (isPresent_lwup .and. isPresent_lwdn) then - ! longwave radiation, sum up and down (W/m2) - call state_getimport(importState, 'Foxx_lwup', & - isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call state_getimport(importState, 'Faxa_lwdn', & - isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, do_sum=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else if (isPresent_lwnet) then - ! net longwave radiation, sum up and down (W/m2) - call state_getimport(importState, 'mean_net_lw_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, do_sum=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if !---- ! zonal and meridional surface stress From e472d93d11086e9a21a11e261b791714a500a7e1 Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Thu, 24 Jan 2019 14:10:36 -0700 Subject: [PATCH 32/77] Do not end diag manager. This seems to be needed in order for the coupled system with FV3 and MOM to finalize. --- config_src/nuopc_driver/MOM_ocean_model.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 28ae82750a..0e962bfdc1 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -741,7 +741,7 @@ subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time, write_restart) logical, intent(in) :: write_restart !< true => write restart file call ocean_model_save_restart(Ocean_state, Time) - call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.true.) + call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.false.) call MOM_end(Ocean_state%MOM_CSp) if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp) end subroutine ocean_model_end From c1f804b777b64232d05b0f8777761d3d47568c7e Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Wed, 30 Jan 2019 21:50:32 +0000 Subject: [PATCH 33/77] Move statement that should be inside an if block --- config_src/nuopc_driver/mom_cap.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index b03ee9c0d3..8e55795b9a 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1741,9 +1741,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - if (geomtype == ESMF_GEOMTYPE_GRID) then + + call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) + call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & From 91933c1b573a49d16aeb9f40ece36120274f0cec Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Wed, 30 Jan 2019 21:53:52 +0000 Subject: [PATCH 34/77] Revert "Do not end diag manager. This seems to be needed in order for the coupled system with FV3 and MOM to finalize." This reverts commit e472d93d11086e9a21a11e261b791714a500a7e1. --- config_src/nuopc_driver/MOM_ocean_model.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 0e962bfdc1..28ae82750a 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -741,7 +741,7 @@ subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time, write_restart) logical, intent(in) :: write_restart !< true => write restart file call ocean_model_save_restart(Ocean_state, Time) - call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.false.) + call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.true.) call MOM_end(Ocean_state%MOM_CSp) if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp) end subroutine ocean_model_end From 5a5fc420c27c1382245d0e0541b434027474e654 Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Thu, 31 Jan 2019 15:48:42 -0600 Subject: [PATCH 35/77] Added check to allow running MOM with debug flags on --- src/core/MOM.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1a590bb5b8..8ff49c628c 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1153,7 +1153,10 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & call enable_averaging(dtdia, Time_end_thermo, CS%diag) - call apply_oda_tracer_increments(dtdia,G,tv,h,CS%odaCS) + ! added check in order to run MOM with debug flags + if (CS%ensemble_ocean) then + call apply_oda_tracer_increments(dtdia,G,tv,h,CS%odaCS) + end if if (update_BBL) then ! Calculate the BBL properties and store them inside visc (u,h). From 501b90bf23390247aa39b6e23aa2791e18bd8428 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 5 Feb 2019 13:20:33 -0700 Subject: [PATCH 36/77] removed mom_cap_share.F90 --- .../nuopc_driver/MOM_surface_forcing.F90 | 7 +++- config_src/nuopc_driver/mom_cap.F90 | 38 +++++++++++++++-- config_src/nuopc_driver/mom_cap_methods.F90 | 19 ++++++++- config_src/nuopc_driver/mom_cap_share.F90 | 42 ------------------- 4 files changed, 57 insertions(+), 49 deletions(-) delete mode 100644 config_src/nuopc_driver/mom_cap_share.F90 diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index a21b00f839..68355a79a3 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -40,7 +40,6 @@ module MOM_surface_forcing use mpp_mod, only : mpp_chksum use time_interp_external_mod, only : init_external_field, time_interp_external use time_interp_external_mod, only : time_interp_external_init -use mom_cap_share implicit none ; private @@ -197,6 +196,12 @@ module MOM_surface_forcing integer :: id_clock_forcing +#ifdef CESMCOUPLED + logical :: cesm_coupled = .true. +#else + logical :: cesm_coupled = .false. +#endif + !======================================================================= contains !======================================================================= diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 8e55795b9a..5a44f3d6e4 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -394,8 +394,11 @@ module mom_cap_mod use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid use mom_cap_time, only: AlarmInit - use mom_cap_methods, only: mom_import, mom_export - use mom_cap_share + use mom_cap_methods, only: mom_import, mom_export, mom_set_geomtype +#ifdef CESMCOUPLED + use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit +#endif + use time_utils_mod, only: esmf2fms_time use, intrinsic :: iso_fortran_env, only: output_unit @@ -408,8 +411,6 @@ module mom_cap_mod model_label_SetRunClock => label_SetRunClock, & model_label_Finalize => label_Finalize - use time_utils_mod, only: esmf2fms_time - implicit none private @@ -453,6 +454,14 @@ module mom_cap_mod character(len=*),parameter :: u_file_u = & __FILE__ +#ifdef CESMCOUPLED + logical :: cesm_coupled = .true. + type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH +#else + logical :: cesm_coupled = .false. + type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID +#endif + !======================================================================= contains !======================================================================= @@ -1766,6 +1775,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if end if + !--------------------------------- + ! Set module variable geomtype in mom_cap_methods + !--------------------------------- + call mom_set_geomtype(geomtype, cesm_coupled) + !--------------------------------- ! write out diagnostics !--------------------------------- @@ -2623,4 +2637,20 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) end subroutine fld_list_add +!======================================================================= + +#ifndef CESMCOUPLED + subroutine shr_file_setLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_setLogUnit + + subroutine shr_file_getLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_getLogUnit +#endif + end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index c1de995004..f428c09d4e 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -24,13 +24,13 @@ module mom_cap_methods use MOM_grid, only: ocean_grid_type use MOM_domains, only: pass_var use mpp_domains_mod, only: mpp_get_compute_domain - use mom_cap_share ! By default make data private implicit none private ! Public member functions + public :: mom_set_geomtype public :: mom_import public :: mom_export @@ -42,10 +42,25 @@ module mom_cap_methods module procedure State_GetFldPtr_2d end interface - integer :: import_cnt = 0 + integer :: import_cnt = 0 + type(ESMF_GeomType_Flag) :: geomtype + logical :: cesm_coupled !=============================================================================== contains +!=============================================================================== + + subroutine mom_set_geomtype(geomtype_in, cesm_coupled_in) + ! Set module variable geomtype and cesm_coupled + + type(ESMF_GeomType_Flag), intent(in) :: geomtype_in !< mesh or grid + logical , intent(in) :: cesm_coupled_in !< nems or cmeps + + geomtype = geomtype_in + cesm_coupled = cesm_coupled_in + + end subroutine mom_set_geomtype + !=============================================================================== !> This function has a few purposes: diff --git a/config_src/nuopc_driver/mom_cap_share.F90 b/config_src/nuopc_driver/mom_cap_share.F90 deleted file mode 100644 index cc13f39548..0000000000 --- a/config_src/nuopc_driver/mom_cap_share.F90 +++ /dev/null @@ -1,42 +0,0 @@ -module mom_cap_share - ! Temporary module for sharing ccp defs and other settings - ! betwen NEMS and CMEPS - - use ESMF , only: ESMF_GeomType_Flag - use ESMF , only: ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID -#ifdef CESMCOUPLED - use shr_file_mod , only: shr_file_setLogUnit, shr_file_getLogUnit -#endif - - implicit none - public - - integer :: shrlogUnit - -#ifdef CESMCOUPLED - logical :: cesm_coupled = .true. - type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH -#else - logical :: cesm_coupled = .false. - type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID -#endif - -!======================================================================= -contains -!======================================================================= - -#ifndef CESMCOUPLED - subroutine shr_file_setLogUnit(nunit) - integer, intent(in) :: nunit - ! do nothing for this stub - its just here to replace - ! having cppdefs in the main program - end subroutine shr_file_setLogUnit - - subroutine shr_file_getLogUnit(nunit) - integer, intent(in) :: nunit - ! do nothing for this stub - its just here to replace - ! having cppdefs in the main program - end subroutine shr_file_getLogUnit -#endif - -end module mom_cap_share From dc54281b97fd984b865a379e4cedad99e35d0ea6 Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Wed, 6 Feb 2019 12:15:39 -0700 Subject: [PATCH 37/77] Workaround for scalar field tranfer error - requires changes in CIME and CICE --- config_src/nuopc_driver/mom_cap.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 8e55795b9a..79c8486766 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -2432,7 +2432,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ return endif - farrayptr(1,scalar_id) = value + farrayptr(scalar_id,1) = value endif end subroutine State_SetScalar @@ -2578,7 +2578,7 @@ subroutine SetScalarField(field, rc) return ! bail out field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), rc=rc) ! num of scalar values + ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) ! num of scalar values if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & From e95bbe39853b32d7a48d979683a2ac1ec76effda Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 14 Feb 2019 20:04:45 +0000 Subject: [PATCH 38/77] Fixes of typos/bugs for unifyMOM2019 cap --- config_src/nuopc_driver/mom_cap_methods.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index f428c09d4e..38ef24c94f 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -614,14 +614,14 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end if call State_SetExport(exportState, trim(fldname_x), & - isc, iec, jsc, jec, ocean_public%u_surf, ocean_grid, rc=rc) + isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out call State_SetExport(exportState, trim(fldname_y), & - isc, iec, jsc, jec, ocean_public%v_surf, ocean_grid, rc=rc) + isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -840,7 +840,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ig = i + ocean_grid%isc - isc dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & - ocean_grid%sin_rot(ig,jg)*dhdy(i,j) - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & + dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & + ocean_grid%sin_rot(ig,jg)*dhdx(i,j) end do end do @@ -851,19 +851,19 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ig = i + ocean_grid%isc - isc dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & + dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) end do end do end if - call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx, ocean_grid, rc=rc) + call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy, ocean_grid, rc=rc) + call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1036,7 +1036,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid integer :: lbnd1,lbnd2 real(ESMF_KIND_R8), pointer :: dataPtr1d(:) real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) - character(len=*) , parameter :: subname='(mom_cap_methods_:state_setimport)' + character(len=*) , parameter :: subname='(mom_cap_methods_:state_setexport)' ! ---------------------------------------------- rc = ESMF_SUCCESS From 3c4624da014ce56342ce5303a1d17384fa3c4442 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 17 Feb 2019 12:30:45 +0000 Subject: [PATCH 39/77] Two typo fixes; next round will contain resolution of rotations, removal of unneeded EMC code, fixed comments regarding local/global indices --- config_src/nuopc_driver/mom_cap_methods.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 38ef24c94f..16a13b0d27 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -744,7 +744,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, fldname_y = 'So_dhdy' else fldname_x = 'sea_surface_slope_zonal' - fldname_x = 'sea_surface_slope_merid' + fldname_y = 'sea_surface_slope_merid' end if allocate(ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !global indices @@ -1036,7 +1036,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid integer :: lbnd1,lbnd2 real(ESMF_KIND_R8), pointer :: dataPtr1d(:) real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) - character(len=*) , parameter :: subname='(mom_cap_methods_:state_setexport)' + character(len=*) , parameter :: subname='(mom_cap_methods:state_setexport)' ! ---------------------------------------------- rc = ESMF_SUCCESS From b1bdecfa2cbea4303e54d1a27556a90ce7dda9b7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 18 Feb 2019 12:50:49 -0700 Subject: [PATCH 40/77] major cleanup of mom_cap_methods.F90 and mom_cap.F90 to unify cap further - this will NOT be bfb --- .../nuopc_driver/MOM_surface_forcing.F90 | 50 +- config_src/nuopc_driver/mom_cap.F90 | 221 +++---- config_src/nuopc_driver/mom_cap_methods.F90 | 598 ++++++------------ 3 files changed, 282 insertions(+), 587 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 68355a79a3..17aa40de6d 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -155,7 +155,6 @@ module MOM_surface_forcing ! the elements, units, and conventions that exactly conform to the use for ! MOM-based coupled models. type, public :: ice_ocean_boundary_type - real, pointer, dimension(:,:) :: latent_flux =>NULL() !< latent flux (W/m2) real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff (W/m2) real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff (W/m2) real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress (Pa) @@ -293,15 +292,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) - if (.not. cesm_coupled) then - call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) - if (CS%use_limited_P_SSH) then - fluxes%p_surf_SSH => fluxes%p_surf - else - fluxes%p_surf_SSH => fluxes%p_surf_full - endif - end if + call safe_alloc_ptr(fluxes%p_surf ,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) + if (CS%use_limited_P_SSH) then + fluxes%p_surf_SSH => fluxes%p_surf + else + fluxes%p_surf_SSH => fluxes%p_surf_full + endif call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) @@ -470,25 +467,20 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & if (associated(IOB%t_flux)) & fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - ! Note: currently latent heat flux is treated differently for nems and cesm - if (associated(IOB%latent_flux)) then - fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) - else - fluxes%latent(i,j) = 0.0 - if (associated(IOB%fprec)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_fprec_diag(i,j) = -G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion - endif - if (associated(IOB%calving)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - endif - if (associated(IOB%q_flux)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - endif - fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) - end if + fluxes%latent(i,j) = 0.0 + if (associated(IOB%fprec)) then + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent_fprec_diag(i,j) = -G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion + endif + if (associated(IOB%calving)) then + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + endif + if (associated(IOB%q_flux)) then + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + endif + fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) if (associated(IOB%sw_flux_vis_dir)) & fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 5a44f3d6e4..a41ca3ed3a 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -34,15 +34,13 @@ !! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_howtodoc/) !! how-to document. !! -!! The MOM cap package includes the cap itself (mom_cap.F90, a Fortran module), a +!! The MOM cap package includes the cap code itself (mom_cap.F90 and mom_cap_methods.F90), a !! set of time utilities (time_utils.F90) for converting between ESMF and FMS -!! time types, and two makefiles. Also included are self-describing dependency -!! makefile fragments (mom.mk and mom.mk.template), although these can be generated -!! by the makefiles for specific installations of the MOM cap. +!! time type and two modules MOM_ocean_model.F90 and MOM_surface_forcing.F90. !! !! @subsection CapSubroutines Cap Subroutines !! -!! The MOM cap Fortran module contains a set of subroutines that are required +!! The MOM cap Fortran modules contains a set of subroutines that are required !! by NUOPC. These subroutines are called by the NUOPC infrastructure according !! to a predefined calling sequence. Some subroutines are called during !! initialization of the coupled system, some during the run of the coupled @@ -447,10 +445,10 @@ module mom_cap_mod integer :: logunit ! stdout logging unit number logical :: profile_memory = .true. logical :: grid_attach_area = .false. - character(len=128) :: scalar_field_name - integer :: scalar_field_count - integer :: scalar_field_idx_grid_nx - integer :: scalar_field_idx_grid_ny + character(len=128) :: scalar_field_name = '' + integer :: scalar_field_count = 0 + integer :: scalar_field_idx_grid_nx = 0 + integer :: scalar_field_idx_grid_ny = 0 character(len=*),parameter :: u_file_u = & __FILE__ @@ -755,7 +753,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) type(time_type) :: DT integer :: DT_OCEAN integer :: isc,iec,jsc,jec - integer :: dt_cpld = 86400 integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 integer :: mpi_comm_mom integer :: i,n @@ -824,7 +821,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call diag_manager_init ! this ocean connector will be driven at set interval - dt_cpld = DT_OCEAN DT = set_time (DT_OCEAN, 0) Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) @@ -946,8 +942,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ocean_public%is_ocean_pe = .true. if (len_trim(restartfile) > 0) then - call ocean_model_init(ocean_public, ocean_state, Time, Time, & - input_restart_file=trim(restartfile)) + call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file=trim(restartfile)) else call ocean_model_init(ocean_public, ocean_state, Time, Time) endif @@ -955,6 +950,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ocean_model_init_sfc(ocean_state, ocean_public) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & @@ -967,17 +963,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% mi (isc:iec,jsc:jec), & + Ice_ocean_boundary% p (isc:iec,jsc:jec), & Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & Ice_ocean_boundary% calving (isc:iec,jsc:jec), & Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% mi (isc:iec,jsc:jec), & - Ice_ocean_boundary% p (isc:iec,jsc:jec)) - if (cesm_coupled) then - allocate( Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% latent_flux (isc:iec,jsc:jec)) - end if + Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec)) Ice_ocean_boundary%u_flux = 0.0 Ice_ocean_boundary%v_flux = 0.0 @@ -991,17 +984,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary%sw_flux_nir_dif = 0.0 Ice_ocean_boundary%lprec = 0.0 Ice_ocean_boundary%fprec = 0.0 + Ice_ocean_boundary%mi = 0.0 + Ice_ocean_boundary%p = 0.0 Ice_ocean_boundary%runoff = 0.0 Ice_ocean_boundary%calving = 0.0 Ice_ocean_boundary%runoff_hflx = 0.0 Ice_ocean_boundary%calving_hflx = 0.0 - Ice_ocean_boundary%mi = 0.0 - Ice_ocean_boundary%p = 0.0 - if (cesm_coupled) then - Ice_ocean_boundary%rofl_flux = 0.0 - Ice_ocean_boundary%rofi_flux = 0.0 - Ice_ocean_boundary%latent_flux = 0.0 - end if + Ice_ocean_boundary%rofl_flux = 0.0 + Ice_ocean_boundary%rofi_flux = 0.0 ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) @@ -1010,88 +1000,55 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - ! CESM fields currently not used in cesm_coupled - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") - if (cesm_coupled) then - - !--------- import fields ------------- - if (len_trim(scalar_field_name) > 0) then - call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC - endif - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwnet" , "will_provide") ! -> mean net lwnet - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdr" , "will provide") ! -> mean_net_sw_ir_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdf" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idr" , "will provide") ! -> mean_net_sw_ir_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idf" , "will provide") ! -> mean_net_sw_vis_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") ! -> liquid runoff - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") ! -> ice runoff - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - - !--------- export fields ------------- if (len_trim(scalar_field_name) > 0) then - call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") ! not in EMC + call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") endif - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! -> not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential - + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") else - - !--------- import fields ------------- - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! not used in NEMS - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not used in NEMS - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") ! not used in NEMS - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not used in NEMS - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not used in NEMS - - !--------- export fields ------------- - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide") ! not used in NEMS - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide") ! not used in NEMS - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") ! not used in NEMS + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") end if + !--------- import fields ------------- + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide") ! from ice + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") + + !--------- export fields ------------- + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") + do n = 1,fldsToOcn_num call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1134,6 +1091,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_DeLayout) :: delayout type(ESMF_Distgrid) :: Distgrid type(ESMF_DistGridConnection), allocatable :: connectionList(:) + type(ESMF_StateItem_Flag) :: itemFlag type (ocean_public_type), pointer :: ocean_public => NULL() type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() @@ -1148,7 +1106,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, allocatable :: deLabelList(:) integer, allocatable :: indexList(:) integer :: ioff, joff - integer :: i, j, n, i1, j1, n1, icount + integer :: i, j, n, i1, j1, n1 integer :: lbnd1,ubnd1,lbnd2,ubnd2 integer :: lbnd3,ubnd3,lbnd4,ubnd4 integer :: nblocks_tot @@ -1175,9 +1133,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) rc = ESMF_SUCCESS - if (cesm_coupled) then - call shr_file_setLogUnit (logunit) - end if + call shr_file_setLogUnit (logunit) !---------------------------------------------------------------------------- ! Get pointers to ocean internal state @@ -1730,28 +1686,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! TODO (mvertens, 2018-12-30): is this really necessary? for now only do this for grid - if (cesm_coupled) then - fldname = 'So_t' - else - fldname = 'sea_surface_temperature' - end if - - call ESMF_StateGet(exportState, itemSearch=trim(fldname), itemCount=icount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! Do sst initialization if it's part of export state - if (icount /= 0) then - call ESMF_StateGet(exportState, itemName=trim(fldname), field=field_t_surf, rc=rc) + call ESMF_StateGet(exportState, 'sea_surface_temperature', itemFlag) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then + + call ESMF_StateGet(exportState, 'sea_surface_temperature', field=field_t_surf, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out if (geomtype == ESMF_GEOMTYPE_GRID) then - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf2d, rc=rc) @@ -1778,7 +1723,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !--------------------------------- ! Set module variable geomtype in mom_cap_methods !--------------------------------- - call mom_set_geomtype(geomtype, cesm_coupled) + call mom_set_geomtype(geomtype) !--------------------------------- ! write out diagnostics @@ -1809,7 +1754,6 @@ subroutine DataInitialize(gcomp, rc) type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString integer :: fieldCount, n - integer :: dt_cpld = 86400 type(ESMF_Field) :: field character(len=64),allocatable :: fieldNameList(:) character(len=*),parameter :: subname='(mom_cap:DataInitialize)' @@ -1834,7 +1778,7 @@ subroutine DataInitialize(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) if (cesm_coupled) then - call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, dt_cpld, rc=rc) + call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1921,7 +1865,7 @@ subroutine ModelAdvance(gcomp, rc) type(time_type) :: Time type(time_type) :: Time_step_coupled type(time_type) :: Time_restart_current - integer :: dth, dtm, dts, dt_cpld = 86400 + integer :: dth, dtm, dts integer :: nc type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute @@ -1933,9 +1877,7 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") - if (cesm_coupled) then - call shr_file_setLogUnit (logunit) - end if + call shr_file_setLogUnit (logunit) ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & @@ -1989,19 +1931,8 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out - !--------------- - ! Determine dt_cpld (needed for export) - !--------------- - - call ESMF_TimeIntervalGet(timeStep, h=dth, m=dtm, s=dts, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - Time = esmf2fms_time(currTime) Time_step_coupled = esmf2fms_time(timeStep) - dt_cpld = dth*3600 + dtm*60 + dts !--------------- ! Write diagnostics for import @@ -2027,9 +1958,7 @@ subroutine ModelAdvance(gcomp, rc) ! Import data !--------------- - if (cesm_coupled) then - call shr_file_setLogUnit (logunit) - end if + call shr_file_setLogUnit (logunit) if (cesm_coupled) then call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) @@ -2071,15 +2000,13 @@ subroutine ModelAdvance(gcomp, rc) ! Export Data !--------------- - call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, dt_cpld, rc=rc) + call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - if (cesm_coupled) then - call shr_file_setLogUnit (logunit) - end if + call shr_file_setLogUnit (logunit) !--------------- ! If restart alarm is ringing - write restart file diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index f428c09d4e..1b5a963b51 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -43,21 +43,18 @@ module mom_cap_methods end interface integer :: import_cnt = 0 - type(ESMF_GeomType_Flag) :: geomtype - logical :: cesm_coupled + type(ESMF_GeomType_Flag) :: geomtype !=============================================================================== contains !=============================================================================== - subroutine mom_set_geomtype(geomtype_in, cesm_coupled_in) - ! Set module variable geomtype and cesm_coupled + subroutine mom_set_geomtype(geomtype_in) + ! Set module variable geomtype type(ESMF_GeomType_Flag), intent(in) :: geomtype_in !< mesh or grid - logical , intent(in) :: cesm_coupled_in !< nems or cmeps geomtype = geomtype_in - cesm_coupled = cesm_coupled_in end subroutine mom_set_geomtype @@ -66,8 +63,6 @@ end subroutine mom_set_geomtype !> This function has a few purposes: !! (1) it imports surface fluxes using data from the mediator; and !! (2) it can apply restoring in SST and SSS. - !! See \ref section_ocn_import for a summary of the surface fluxes that are - !! passed from MCT to MOM6, including fluxes that need to be included in the future. subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype, rc) @@ -80,16 +75,13 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, integer , intent(inout) :: rc ! Local Variables - type(ESMF_StateItem_Flag) :: itemFlag integer :: i, j, ig, jg, n integer :: isc, iec, jsc, jec logical :: do_import character(len=128) :: fldname - character(len=128) :: fldname_x - character(len=128) :: fldname_y real(ESMF_KIND_R8), allocatable :: taux(:,:) real(ESMF_KIND_R8), allocatable :: tauy(:,:) - character(len=*) , parameter :: subname = '(mom_import_cesm)' + character(len=*) , parameter :: subname = '(mom_import)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -110,17 +102,13 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, end if if (do_import) then + ! The following are global indices without halos call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) !---- ! surface height pressure !---- - if (cesm_coupled) then - fldname = 'Sa_pslv' - else - fldname = 'inst_pres_height_surface' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'inst_pres_height_surface', & isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -130,12 +118,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! near-IR, direct shortwave (W/m2) !---- - if (cesm_coupled) then - fldname = 'Foxx_swnet_idr' - else - fldname = 'mean_net_sw_ir_dir_flx' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -145,12 +128,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! near-IR, diffuse shortwave (W/m2) !---- - if (cesm_coupled) then - fldname = 'Foxx_swnet_idf' - else - fldname = 'mean_net_sw_ir_dif_flx' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -160,12 +138,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! visible, direct shortwave (W/m2) !---- - if (cesm_coupled) then - fldname = 'Foxx_swnet_vdr' - else - fldname = 'mean_net_sw_vis_dir_flx' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -175,12 +148,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! visible, diffuse shortwave (W/m2) !---- - if (cesm_coupled) then - fldname = 'Foxx_swnet_vdf' - else - fldname = 'mean_net_sw_vis_dif_flx' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -190,12 +158,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! ------- ! Net longwave radiation (W/m2) ! ------- - if (cesm_coupled) then - fldname = 'Foxx_lwnet' - else - fldname = 'mean_net_lw_flx' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_net_lw_flx', & isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -205,62 +168,38 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! zonal and meridional surface stress !---- - if (cesm_coupled) then - fldname_x = 'Foxx_taux' - fldname_y = 'Foxx_tauy' - else - fldname_x = 'mean_zonal_moment_flx' - fldname_y = 'mean_merid_moment_flx' - end if - allocate (taux(isc:iec,jsc:jec)) allocate (tauy(isc:iec,jsc:jec)) - call state_getimport(importState, trim(fldname_x), isc, iec, jsc, jec, taux, rc=rc) + + call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call state_getimport(importState, trim(fldname_y), isc, iec, jsc, jec, tauy, rc=rc) + call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out ! rotate taux and tauy from true zonal/meridional to local coordinates - ! Note - this is the latest calculation from Gustavo - pointed out that the NEMS calculation is incorrect - if (cesm_coupled) then - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg) * taux(i,j) & - + ocean_grid%sin_rot(ig,jg) * tauy(i,j) - ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg) * tauy(i,j) & - - ocean_grid%sin_rot(ig,jg) * taux(i,j) - end do - end do - else - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & - - ocean_grid%sin_rot(ig,jg)*tauy(i,j) - ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & - + ocean_grid%sin_rot(ig,jg)*taux(i,j) - end do + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & + - ocean_grid%sin_rot(ig,jg)*tauy(i,j) + ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & + + ocean_grid%sin_rot(ig,jg)*taux(i,j) end do - end if + end do + + deallocate(taux, tauy) !---- ! sensible heat flux (W/m2) !---- - if (cesm_coupled) then - fldname = 'Foxx_sen' - else - fldname = 'mean_sensi_heat_flx' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_sensi_heat_flx', & isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -268,28 +207,9 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, return ! bail out !---- - ! latent heat flux (W/m2) + ! evaporation flux (W/m2) !---- - if (cesm_coupled) then - ! Note - this field is not exported by the nems mediator - fldname = 'Foxx_lat' - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%latent_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if - - !---- - ! specific humidity flux (W/m2) - !---- - if (cesm_coupled) then - fldname = 'Foxx_evap' - else - fldname = 'mean_evap_rate' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_evap_rate', & isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -299,12 +219,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! liquid precipitation (rain) !---- - if (cesm_coupled) then - fldname = 'Faxa_rain' - else - fldname = 'mean_prec_rate' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_prec_rate', & isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -314,12 +229,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! frozen precipitation (snow) !---- - if (cesm_coupled) then - fldname = 'Faxa_snow' - else - fldname = 'mean_fprec_rate' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_fprec_rate', & isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -329,109 +239,97 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! runoff and heat content of runoff !---- - if (cesm_coupled) then - ! liquid runoff - fldname = 'Foxx_rofl' - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used - ! ice runoff - fldname = 'Foxx_rofi' - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! liquid runoff + ice_ocean_boundary%rofl_flux (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'Foxx_rofl', & + isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! GMM, cime does not not have an equivalent for heat_content_lrunoff and - ! heat_content_frunoff. Setting these to zero for now. - ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 - ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 + ! ice runoff + ice_ocean_boundary%rofi_flux (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'Foxx_rofi', & + isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - else - ! total runoff - fldname = 'mean_runoff_rate' - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! total runoff + ice_ocean_boundary%runoff (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_runoff_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! heat content of runoff - fldname = 'mean_runoff_heat_flux' - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + ! heat content of runoff + ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_runoff_heat_flux', & + isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! calving rate and heat flux !---- - if (.not. cesm_coupled) then - fldname = 'mean_calving_rate' - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used - fldname = 'mean_calving_heat_flux' - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + ice_ocean_boundary%calving(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_calving_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_calving_heat_flux', & + isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! salt flux from ice !---- - if (cesm_coupled) then - fldname = 'Fioi_salt' - else - fldname = 'mean_salt_rate' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_salt_rate', & isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - if (cesm_coupled) then - ! salt flux (minus sign needed here -GMM) - ! TODO (mvertens, 2018-12-28): NEMS does not have a minus sign - which one is right? - do j = jsc,jec - do i = isc,iec - ice_ocean_boundary%salt_flux(i,j) = - ice_ocean_boundary%salt_flux(i,j) - enddo + ! TODO: salt flux (minus sign needed here -GMM) - this does not match either NEMS or MCT - so not put in below + do j = jsc,jec + do i = isc,iec + ice_ocean_boundary%salt_flux(i,j) = ice_ocean_boundary%salt_flux(i,j) enddo - end if + enddo !---- ! mass of overlying ice !---- - fldname = 'mass_of_overlying_ice' - call ESMF_StateGet(importState, trim(fldname), itemFlag) - if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used + + ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mass_of_overlying_ice', & + isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out end if @@ -440,21 +338,21 @@ end subroutine mom_import !=============================================================================== !> Maps outgoing ocean data to ESMF State - subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, dt_cpld, rc) + subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc) ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid - type (ocean_state_type) , pointer :: ocean_state + type(ocean_state_type) , pointer :: ocean_state type(ESMF_State) , intent(inout) :: exportState !< outgoing data - type(ESMF_Clock) , intent(in) :: clock ! cesm - integer , intent(in) :: dt_cpld ! nems + type(ESMF_Clock) , intent(in) :: clock integer , intent(inout) :: rc ! Local variables - integer :: i, j, ig, jg ! grid indices - integer :: isc, iec, jsc, jec ! local indices - integer :: iloc, jloc ! local indices + integer :: i, j, ig, jg ! indices + integer :: isc, iec, jsc, jec ! indices + integer :: iloc, jloc ! indices + integer :: iglob, jglob ! indices integer :: n integer :: icount real :: slp_L, slp_R, slp_C @@ -464,21 +362,14 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, integer :: dt_int real :: inv_dt_int !< The inverse of coupling time interval in s-1. type(ESMF_StateItem_Flag) :: itemFlag - type(ESMF_StateItem_Flag) :: itemFlag1 - type(ESMF_StateItem_Flag) :: itemFlag2 - character(len=128) :: fldname - character(len=128) :: fldname_x - character(len=128) :: fldname_y real(ESMF_KIND_R8), allocatable :: omask(:,:) real(ESMF_KIND_R8), allocatable :: melt_potential(:,:) - real(ESMF_KIND_R8), allocatable :: frazil(:,:) - real(ESMF_KIND_R8), allocatable :: frzmlt(:,:) real(ESMF_KIND_R8), allocatable :: ocz(:,:), ocm(:,:) real(ESMF_KIND_R8), allocatable :: ocz_rot(:,:), ocm_rot(:,:) real(ESMF_KIND_R8), allocatable :: ssh(:,:) real(ESMF_KIND_R8), allocatable :: dhdx(:,:), dhdy(:,:) real(ESMF_KIND_R8), allocatable :: dhdx_rot(:,:), dhdy_rot(:,:) - character(len=*), parameter :: subname = '(mom_export)' + character(len=*) , parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -489,11 +380,13 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, line=__LINE__, & file=__FILE__)) & return ! bail out + call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + if (real(dt_int) > 0.0) then inv_dt_int = 1.0 / real(dt_int) else @@ -509,39 +402,27 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ------- ! ocean mask ! ------- - if (cesm_coupled) then - fldname = 'So_omask' - else - fldname = 'ocean_mask' - end if allocate(omask(isc:iec, jsc:jec)) - ! TODO (mvertens, 2018-12-29): which is the correct formulation? - if (cesm_coupled) then - omask(:,:) = 1._ESMF_KIND_R8 - else - call ocean_model_data_get(ocean_state, ocean_public, 'mask', omask, isc, jsc) - do j = jsc,jec - do i = isc,iec - omask(i,j) = nint(omask(i,j)) - enddo + call ocean_model_data_get(ocean_state, ocean_public, 'mask', omask, isc, jsc) + do j = jsc,jec + do i = isc,iec + omask(i,j) = nint(omask(i,j)) enddo - end if - call State_SetExport(exportState, trim(fldname), & + enddo + + call State_SetExport(exportState, 'ocean_mask', & isc, iec, jsc, jec, omask, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + deallocate(omask) + ! ------- ! Sea surface temperature ! ------- - if (cesm_coupled) then - fldname = 'So_t' - else - fldname = 'sea_surface_temperature' - end if - call State_SetExport(exportState, trim(fldname), & + call State_SetExport(exportState, 'sea_surface_temperature', & isc, iec, jsc, jec, ocean_public%t_surf, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -551,12 +432,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ------- ! Sea surface salinity ! ------- - if (cesm_coupled) then - fldname = 'So_s' - else - fldname = 's_surf' - end if - call State_SetExport(exportState, trim(fldname), & + call State_SetExport(exportState, 's_surf', & isc, iec, jsc, jec, ocean_public%s_surf, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -566,74 +442,47 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ------- ! zonal and meridional currents ! ------- - if (cesm_coupled) then - fldname_x = 'So_u' - fldname_y = 'So_v' - else - fldname_x = 'ocn_current_zonal' - fldname_y = 'ocn_current_merid' - end if ! rotate ocn current from tripolar grid back to lat/lon grid x,y => latlon (CCW) - ! "ocean_grid" has halos and uses global indexing. - - ! TODO (mvertens, 2018-12-30): Only one of these is correct - the cesm_coupled one is the - ! latest and is the one that GM feels is the correct one + ! "ocean_grid%isc" has no halos and uses local indexing. allocate(ocz(isc:iec, jsc:jec)) allocate(ocm(isc:iec, jsc:jec)) allocate(ocz_rot(isc:iec, jsc:jec)) allocate(ocm_rot(isc:iec, jsc:jec)) - if (cesm_coupled) then - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ocz(i,j) = ocean_public%u_surf(i,j) - ocm(i,j) = ocean_public%v_surf(i,j) - ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) & - - ocean_grid%sin_rot(ig,jg)*ocm(i,j) - ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) & - + ocean_grid%sin_rot(ig,jg)*ocz(i,j) - end do + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ocz(i,j) = ocean_public%u_surf(i,j) + ocm(i,j) = ocean_public%v_surf(i,j) + ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) + ocean_grid%sin_rot(ig,jg)*ocm(i,j) + ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) - ocean_grid%sin_rot(ig,jg)*ocz(i,j) end do - else - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ocz(i,j) = ocean_public%u_surf(i,j) - ocm(i,j) = ocean_public%v_surf(i,j) - ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) & - + ocean_grid%sin_rot(ig,jg)*ocm(i,j) - ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) & - - ocean_grid%sin_rot(ig,jg)*ocz(i,j) - end do - end do - end if + end do - call State_SetExport(exportState, trim(fldname_x), & - isc, iec, jsc, jec, ocean_public%u_surf, ocean_grid, rc=rc) + call State_SetExport(exportState, 'ocn_current_zonal', & + isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - - call State_SetExport(exportState, trim(fldname_y), & - isc, iec, jsc, jec, ocean_public%v_surf, ocean_grid, rc=rc) + call State_SetExport(exportState, 'ocn_current_merid', & + isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + deallocate(ocz, ocm, ocz_rot, ocm_rot) + ! ------- ! Boundary layer depth ! ------- - fldname = 'So_bldepth' - call ESMF_StateGet(exportState, trim(fldname), itemFlag, rc=rc) + call ESMF_StateGet(exportState, 'So_bldepth', itemFlag, rc=rc) if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - call State_SetExport(exportState, trim(fldname), & + call State_SetExport(exportState, 'So_bldepth', & isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -642,92 +491,39 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end if ! ------- - ! Oean melt and freeze potential + ! Freezing melting potential ! ------- ! melt_potential, defined positive for T>Tfreeze, so need to change sign ! Convert from J/m^2 to W/m^2 and make sure Melt_potential is always <= 0 - if (cesm_coupled) then - fldname = 'Fioo_q' - else - fldname = 'inst_melt_potential' - end if allocate(melt_potential(isc:iec, jsc:jec)) - if (cesm_coupled) then - do j = jsc,jec - do i = isc,iec - if (ocean_public%frazil(i,j) > 0.0) then - melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int - else - melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int - if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 - end if - end do - end do - else - do j = jsc,jec - do i = isc,iec - ! TODO (mvertens, 2018-12-29): use inv_dt_int from cesm - and not the original implementation? - melt_potential(i,j) = -melt_potential(i,j) / dt_cpld + + do j = jsc,jec + do i = isc,iec + if (ocean_public%frazil(i,j) > 0.0) then + melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int + else + melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 - end do + end if end do - end if - call State_SetExport(exportState, trim(fldname), & + end do + + call State_SetExport(exportState, 'freezing_melting_potential', & isc, iec, jsc, jec, melt_potential, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - ! ------- - ! frazil and freezing melting potential - ! ------- - - call ESMF_StateGet(exportState, 'accum_heat_frazil' , itemFlag1) - call ESMF_StateGet(exportState, 'freezing_melting_potential', itemFlag2) - if (itemFlag1 /= ESMF_STATEITEM_NOTFOUND .and. itemFlag2 /= ESMF_STATEITEM_NOTFOUND) then - - allocate(frazil(isc:iec, jsc:jec)) - allocate(frzmlt(isc:iec, jsc:jec)) - - do j = jsc,jec - do i = isc,iec - !convert from J/m^2 to W/m^2 for CICE coupling - frazil(i,j) = ocean_public%frazil(i,j)/dt_cpld - if (frazil(i,j) == 0.0) then - frzmlt(i,j) = melt_potential(i,j) - else - frzmlt(i,j) = frazil(i,j) - endif - frzmlt(i,j) = max(-1000.0,min(1000.0,frzmlt(i,j))) - end do - end do - - fldname = 'accum_heat_frazil' - call State_SetExport(exportState, trim(fldname), & - isc, iec, jsc, jec, frazil, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - fldname = 'freezing_melting_potential' - call State_SetExport(exportState, trim(fldname), & - isc, iec, jsc, jec, frzmlt, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + deallocate(melt_potential) ! ------- ! Sea level ! ------- - fldname = 'sea_level' - call ESMF_StateGet(exportState, trim(fldname), itemFlag, rc=rc) + call ESMF_StateGet(exportState, 'sea_level', itemFlag, rc=rc) if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - call State_SetExport(exportState, trim(fldname), & + call State_SetExport(exportState, 'sea_level', & isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -739,24 +535,17 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! Sea-surface zonal and meridional slopes !---------------- - if (cesm_coupled) then - fldname_x = 'So_dhdx' - fldname_y = 'So_dhdy' - else - fldname_x = 'sea_surface_slope_zonal' - fldname_x = 'sea_surface_slope_merid' - end if + allocate(ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) ! local indices with halos + allocate(dhdx(isc:iec, jsc:jec)) !global indices without halos + allocate(dhdy(isc:iec, jsc:jec)) !global indices without halos + allocate(dhdx_rot(isc:iec, jsc:jec)) !global indices without halos + allocate(dhdy_rot(isc:iec, jsc:jec)) !global indices without halos - allocate(ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !global indices - allocate(dhdx(isc:iec, jsc:jec)) !local indices - allocate(dhdy(isc:iec, jsc:jec)) !local indices - allocate(dhdx_rot(isc:iec, jsc:jec)) !local indices - allocate(dhdy_rot(isc:iec, jsc:jec)) !local indices ssh = 0.0_ESMF_KIND_R8 dhdx = 0.0_ESMF_KIND_R8 dhdy = 0.0_ESMF_KIND_R8 - ! Make a copy of ssh in order to do a halo update (ssh has global indexing with halos) + ! Make a copy of ssh in order to do a halo update (ssh has local indexing with halos) do j = ocean_grid%jsc, ocean_grid%jec jloc = j + ocean_grid%jdg_offset do i = ocean_grid%isc,ocean_grid%iec @@ -765,17 +554,17 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end do end do - ! Update halo of ssh so we can calculate gradients + ! Update halo of ssh so we can calculate gradients (local indexing) call pass_var(ssh, ocean_grid%domain) ! d/dx ssh ! This is a simple second-order difference ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) - do jloc = jsc, jec - j = jloc + ocean_grid%jsc - jsc - do iloc = isc,iec - i = iloc + ocean_grid%isc - isc + do jglob = jsc, jec + j = jglob + ocean_grid%jsc - jsc + do iglob = isc,iec + i = iglob + ocean_grid%isc - isc ! This is a PLM slope which might be less prone to the A-grid null mode slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. @@ -793,8 +582,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! larger extreme values. slope = 0.0 end if - dhdx(iloc,jloc) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) dhdx(iloc,jloc) = 0.0 + dhdx(iglob,jglob) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dhdx(iglob,jglob) = 0.0 end do end do @@ -802,10 +591,10 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! This is a simple second-order difference ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) - do jloc = jsc, jec - j = jloc + ocean_grid%jsc - jsc - do iloc = isc,iec - i = iloc + ocean_grid%isc - isc + do jglob = jsc, jec + j = jglob + ocean_grid%jsc - jsc + do iglob = isc,iec + i = iglob + ocean_grid%isc - isc ! This is a PLM slope which might be less prone to the A-ocean_grid null mode slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. @@ -823,52 +612,39 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! larger extreme values. slope = 0.0 end if - dhdy(iloc,jloc) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) dhdy(iloc,jloc) = 0.0 + dhdy(iglob,jglob) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dhdy(iglob,jglob) = 0.0 end do end do ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) ! "ocean_grid" uses has halos and uses global indexing. - ! TODO (mvertens, 2018-12-30): Only one of these is correct - the cesm_coupled one is the - ! latest and is the one that GM feels is the correct one - if (cesm_coupled) then - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & - - ocean_grid%sin_rot(ig,jg)*dhdy(i,j) - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & - + ocean_grid%sin_rot(ig,jg)*dhdx(i,j) - end do + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) + dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) end do - else - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & - + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & - - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) - end do - end do - end if + end do - call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx, ocean_grid, rc=rc) + call State_SetExport(exportState, 'sea_surface_slope_zonal', & + isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy, ocean_grid, rc=rc) + call State_SetExport(exportState, 'sea_surface_slope_merid', & + isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + deallocate(ssh, dhdx, dhdy, dhdx_rot, dhdy_rot) + end subroutine mom_export !=============================================================================== From 7a6ff0b0c5acc97fb7619c1500835533c9f27bba Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 18 Feb 2019 12:53:58 -0700 Subject: [PATCH 41/77] changes for restart --- config_src/nuopc_driver/mom_cap.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index a41ca3ed3a..bf5a2d4eac 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -2373,7 +2373,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ return endif - farrayptr(1,scalar_id) = value + farrayptr(scalar_id,1) = value endif end subroutine State_SetScalar @@ -2519,7 +2519,7 @@ subroutine SetScalarField(field, rc) return ! bail out field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), rc=rc) ! num of scalar values + ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) ! num of scalar values if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & From 794a632ef98342cc153c200fec0a0f5a1b309b29 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 21 Feb 2019 18:06:46 +0000 Subject: [PATCH 42/77] Commenting out unused fields not in the Nems field dictionary. --- config_src/nuopc_driver/mom_cap.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index bf5a2d4eac..1124715a4f 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1031,8 +1031,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") @@ -1047,7 +1047,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") do n = 1,fldsToOcn_num call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) From 1cf399bf24bbac05938902c1a934d55ace354df1 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 21 Feb 2019 19:53:23 +0000 Subject: [PATCH 43/77] dumpMOMinternal is added behind ifdef flag --- config_src/nuopc_driver/mom_cap.F90 | 62 +++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 1124715a4f..c1baa99a1a 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -439,6 +439,7 @@ module mom_cap_mod integer :: debug = 0 integer :: import_slice = 1 integer :: export_slice = 1 + integer :: internal_slice = 1 character(len=256) :: tmpstr logical :: write_diagnostics = .false. character(len=32) :: runtype ! run type @@ -458,6 +459,8 @@ module mom_cap_mod #else logical :: cesm_coupled = .false. type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID + ! for internal field dumps + type(ESMF_Grid), save :: mom_grid_i #endif !======================================================================= @@ -1396,6 +1399,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out + ! save a copy to dump internal fields + mom_grid_i = gridIn + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2108,6 +2114,17 @@ subroutine ModelAdvance(gcomp, rc) export_slice = export_slice + 1 endif +#ifndef CESMCOUPLED + ! dump specified internal files; uncommentd lines will dump fields even if mediator dumps are turned off + !call dumpMomInternal(mom_grid_i, internal_slice, "mean_zonal_moment_flx", Ice_ocean_boundary%u_flux) + !call dumpMomInternal(mom_grid_i, internal_slice, "mean_merid_moment_flx", Ice_ocean_boundary%v_flux) + call dumpMomInternal(mom_grid_i, internal_slice, "mean_sensi_heat_flx" , Ice_ocean_boundary%t_flux) + call dumpMomInternal(mom_grid_i, internal_slice, "mean_evap_rate" , Ice_ocean_boundary%q_flux) + call dumpMomInternal(mom_grid_i, internal_slice, "mean_salt_rate" , Ice_ocean_boundary%salt_flux) + !call dumpMomInternal(mom_grid_i, internal_slice, "mean_prec_rate" , Ice_ocean_boundary%lprec ) + !call dumpMomInternal(mom_grid_i, internal_slice, "mean_fprec_rate" , Ice_ocean_boundary%fprec ) + internal_slice = internal_slice + 1 +#endif if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") end subroutine ModelAdvance @@ -2580,4 +2597,49 @@ subroutine shr_file_getLogUnit(nunit) end subroutine shr_file_getLogUnit #endif +!======================================================================= + +#ifndef CESMCOUPLED + subroutine dumpMomInternal(grid, slice, stdname, farray) + + type(ESMF_Grid) :: grid + integer, intent(in) :: slice + character(len=*) :: stdname + real(ESMF_KIND_R8), dimension(:,:), target :: farray + + type(ESMF_Field) :: field + real(ESMF_KIND_R8), dimension(:,:), pointer :: f2d + integer :: rc + + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, & + indexflag=ESMF_INDEX_DELOCAL, & + name=stdname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldGet(field, farrayPtr=f2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + f2d(:,:) = farray(:,:) + + call ESMF_FieldWrite(field, fileName='field_ocn_internal_'//trim(stdname)//'.nc', & + timeslice=slice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldDestroy(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine dumpMomInternal +#endif end module mom_cap_mod From f7cfc94da9d9319c3321cfafeb6007b03280cc5d Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 24 Feb 2019 16:59:21 +0000 Subject: [PATCH 44/77] Remove code relating to dump internal. This has been moved to separate branch unifyMOA2019withDump --- config_src/nuopc_driver/mom_cap.F90 | 69 ++------------------- config_src/nuopc_driver/mom_cap_methods.F90 | 18 +++--- 2 files changed, 16 insertions(+), 71 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index c1baa99a1a..d0acf3e219 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -439,7 +439,6 @@ module mom_cap_mod integer :: debug = 0 integer :: import_slice = 1 integer :: export_slice = 1 - integer :: internal_slice = 1 character(len=256) :: tmpstr logical :: write_diagnostics = .false. character(len=32) :: runtype ! run type @@ -459,8 +458,6 @@ module mom_cap_mod #else logical :: cesm_coupled = .false. type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID - ! for internal field dumps - type(ESMF_Grid), save :: mom_grid_i #endif !======================================================================= @@ -1399,9 +1396,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - ! save a copy to dump internal fields - mom_grid_i = gridIn - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1476,7 +1470,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out endif - + ! TODO: This should be cleaned up now that the ocean_grid is available. + ! Mask, area, center and corner positions are all available. The mask + ! area and center points can be placed in the grid using the same scheme + ! as all other ocean_grid variables are used. The corner points require + ! special treatment to reproduce the original ESMF grid (DLW) + ! load up area, mask, center and corner values ! area, mask, and centers should be same size in mom and esmf grid ! corner points may not be, need to offset corner points by 1 in i and j @@ -2114,17 +2113,6 @@ subroutine ModelAdvance(gcomp, rc) export_slice = export_slice + 1 endif -#ifndef CESMCOUPLED - ! dump specified internal files; uncommentd lines will dump fields even if mediator dumps are turned off - !call dumpMomInternal(mom_grid_i, internal_slice, "mean_zonal_moment_flx", Ice_ocean_boundary%u_flux) - !call dumpMomInternal(mom_grid_i, internal_slice, "mean_merid_moment_flx", Ice_ocean_boundary%v_flux) - call dumpMomInternal(mom_grid_i, internal_slice, "mean_sensi_heat_flx" , Ice_ocean_boundary%t_flux) - call dumpMomInternal(mom_grid_i, internal_slice, "mean_evap_rate" , Ice_ocean_boundary%q_flux) - call dumpMomInternal(mom_grid_i, internal_slice, "mean_salt_rate" , Ice_ocean_boundary%salt_flux) - !call dumpMomInternal(mom_grid_i, internal_slice, "mean_prec_rate" , Ice_ocean_boundary%lprec ) - !call dumpMomInternal(mom_grid_i, internal_slice, "mean_fprec_rate" , Ice_ocean_boundary%fprec ) - internal_slice = internal_slice + 1 -#endif if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") end subroutine ModelAdvance @@ -2597,49 +2585,4 @@ subroutine shr_file_getLogUnit(nunit) end subroutine shr_file_getLogUnit #endif -!======================================================================= - -#ifndef CESMCOUPLED - subroutine dumpMomInternal(grid, slice, stdname, farray) - - type(ESMF_Grid) :: grid - integer, intent(in) :: slice - character(len=*) :: stdname - real(ESMF_KIND_R8), dimension(:,:), target :: farray - - type(ESMF_Field) :: field - real(ESMF_KIND_R8), dimension(:,:), pointer :: f2d - integer :: rc - - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, & - indexflag=ESMF_INDEX_DELOCAL, & - name=stdname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldGet(field, farrayPtr=f2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - f2d(:,:) = farray(:,:) - - call ESMF_FieldWrite(field, fileName='field_ocn_internal_'//trim(stdname)//'.nc', & - timeslice=slice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldDestroy(field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine dumpMomInternal -#endif end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 615752177a..1383af5155 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -2,9 +2,6 @@ module mom_cap_methods ! Cap import/export methods for both NEMS and CMEPS - ! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` - ! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. - use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet use ESMF, only: ESMF_State, ESMF_StateGet @@ -19,7 +16,8 @@ module mom_cap_methods use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT use ESMF, only: ESMF_TYPEKIND_R8 use ESMF, only: operator(/=), operator(==) - use MOM_ocean_model, only: ocean_public_type, ocean_state_type, ocean_model_data_get + !DLW + use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type use MOM_domains, only: pass_var @@ -82,6 +80,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, real(ESMF_KIND_R8), allocatable :: taux(:,:) real(ESMF_KIND_R8), allocatable :: tauy(:,:) character(len=*) , parameter :: subname = '(mom_import)' + !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -402,11 +401,14 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ------- ! ocean mask ! ------- + + !DLW: Retrieve omask from ocean_grid, as for other grid variables allocate(omask(isc:iec, jsc:jec)) - call ocean_model_data_get(ocean_state, ocean_public, 'mask', omask, isc, jsc) - do j = jsc,jec - do i = isc,iec - omask(i,j) = nint(omask(i,j)) + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + omask(i,j) = nint(ocean_grid%mask2dT(ig,jg)) enddo enddo From a8c5699aa7dbd2601ca04b02951c7d0400a45d85 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 24 Feb 2019 20:18:29 -0700 Subject: [PATCH 45/77] fixed IOB%salt_flux sign in MOM_surface_forcing and added hooks for seaice_melt_heat and seaice_melt_water --- .../nuopc_driver/MOM_surface_forcing.F90 | 165 +++++++++--------- config_src/nuopc_driver/mom_cap.F90 | 3 + config_src/nuopc_driver/mom_cap_methods.F90 | 25 ++- 3 files changed, 108 insertions(+), 85 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 17aa40de6d..0facbd43e8 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -155,52 +155,48 @@ module MOM_surface_forcing ! the elements, units, and conventions that exactly conform to the use for ! MOM-based coupled models. type, public :: ice_ocean_boundary_type - real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff (W/m2) - real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff (W/m2) - real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress (Pa) - real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress (Pa) - real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux (W/m2) - real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux (kg/m2/s) - real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux (kg/m2/s) - real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation (W/m2) - real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip (kg/m2/s) - real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip (kg/m2/s) - real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff (kg/m2/s) - real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff (kg/m2/s) - real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs (m/s) - real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs(m2/m2) - real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2) - real, pointer, dimension(:,:) :: runoff_hflx =>NULL() !< heat content of liquid runoff (W/m2) - real, pointer, dimension(:,:) :: calving_hflx =>NULL() !< heat content of frozen runoff (W/m2) - real, pointer, dimension(:,:) :: p =>NULL() !< pressure of overlying ice and atmosphere - !< on ocean surface (Pa) - real, pointer, dimension(:,:) :: mi =>NULL() !< mass of ice (kg/m2) - real, pointer, dimension(:,:) :: ice_rigidity =>NULL() !< rigidity of the sea ice, sea-ice and - !! ice-shelves, expressed as a coefficient - !! for divergence damping, as determined - !! outside of the ocean model in (m3/s) - integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT - type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of - !! named fields used for passive tracer fluxes. - integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of - !! wind stresses. This flag may be set by the - !! flux-exchange code, based on what the sea-ice - !! model is providing. Otherwise, the value from - !! the surface_forcing_CS is used. + real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff (W/m2) + real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff (W/m2) + real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress (Pa) + real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress (Pa) + real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux (W/m2) + real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux (kg/m2/s) + real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux (kg/m2/s) + real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux (W/m2) + real, pointer, dimension(:,:) :: seaice_melt_water =>NULL() !< water flux due to sea ice and snow melting (kg/m2/s) + real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation (W/m2) + real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation (W/m2) + real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation (W/m2) + real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation (W/m2) + real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation (W/m2) + real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip (kg/m2/s) + real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip (kg/m2/s) + real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff (kg/m2/s) + real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff (kg/m2/s) + real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs (m/s) + real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs(m2/m2) + real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2) + real, pointer, dimension(:,:) :: runoff_hflx =>NULL() !< heat content of liquid runoff (W/m2) + real, pointer, dimension(:,:) :: calving_hflx =>NULL() !< heat content of frozen runoff (W/m2) + real, pointer, dimension(:,:) :: p =>NULL() !< pressure of overlying ice and atmosphere + !< on ocean surface (Pa) + real, pointer, dimension(:,:) :: mi =>NULL() !< mass of ice (kg/m2) + real, pointer, dimension(:,:) :: ice_rigidity =>NULL() !< rigidity of the sea ice, sea-ice and + !! ice-shelves, expressed as a coefficient + !! for divergence damping, as determined + !! outside of the ocean model in (m3/s) + integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT + type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of + !! named fields used for passive tracer fluxes. + integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of + !! wind stresses. This flag may be set by the + !! flux-exchange code, based on what the sea-ice + !! model is providing. Otherwise, the value from + !! the surface_forcing_CS is used. end type ice_ocean_boundary_type integer :: id_clock_forcing -#ifdef CESMCOUPLED - logical :: cesm_coupled = .true. -#else - logical :: cesm_coupled = .false. -#endif - !======================================================================= contains !======================================================================= @@ -467,6 +463,14 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & if (associated(IOB%t_flux)) & fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) + ! ! sea ice and snow melt heat flux (W/m2) + ! if (associated(fluxes%seaice_melt_heat)) & + ! fluxes%seaice_melt_heat(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0) + + ! ! water flux due to sea ice and snow melt (kg/m2/s) + ! if (associated(fluxes%seaice_melt)) & + ! fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) + fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion @@ -499,29 +503,26 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & enddo ; enddo - if (.not. cesm_coupled) then - ! applied surface pressure from atmosphere and cryosphere - if (associated(IOB%p)) then - if (CS%max_p_surf >= 0.0) then - do j=js,je ; do i=is,ie - fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) - fluxes%p_surf(i,j) = MIN(fluxes%p_surf_full(i,j),CS%max_p_surf) - enddo; enddo - else - do j=js,je ; do i=is,ie - fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) - fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) - enddo; enddo - endif - fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. + ! applied surface pressure from atmosphere and cryosphere + if (associated(IOB%p)) then + if (CS%max_p_surf >= 0.0) then + do j=js,je ; do i=is,ie + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf(i,j) = MIN(fluxes%p_surf_full(i,j),CS%max_p_surf) + enddo; enddo + else + do j=js,je ; do i=is,ie + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) + enddo; enddo endif - end if + fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. + endif - ! more salt restoring logic if (associated(IOB%salt_flux)) then do j=js,je ; do i=is,ie - fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) - IOB%salt_flux(i-i0,j-j0)) - fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*( -IOB%salt_flux(i-i0,j-j0) ) + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) + IOB%salt_flux(i-i0,j-j0)) + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*( IOB%salt_flux(i-i0,j-j0) ) enddo ; enddo endif @@ -543,12 +544,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) + ! net_FW(i,j) = netFW(i,j) + fluxes%seaice_melt(i,j) * G%areaT(i,j) + ! The following contribution appears to be calculating the volume flux of sea-ice ! melt. This calculation is clearly WRONG if either sea-ice has variable ! salinity or the sea-ice is completely fresh. ! Bob thinks this is trying ensure the net fresh-water of the ocean + sea-ice system ! is constant. ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA + ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and + ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) @@ -1369,27 +1374,29 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) outunit = stdout() write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep - write(outunit,100) 'iobt%u_flux ', mpp_chksum( iobt%u_flux ) - write(outunit,100) 'iobt%v_flux ', mpp_chksum( iobt%v_flux ) - write(outunit,100) 'iobt%t_flux ', mpp_chksum( iobt%t_flux ) - write(outunit,100) 'iobt%q_flux ', mpp_chksum( iobt%q_flux ) - write(outunit,100) 'iobt%salt_flux ', mpp_chksum( iobt%salt_flux ) - write(outunit,100) 'iobt%lw_flux ', mpp_chksum( iobt%lw_flux ) - write(outunit,100) 'iobt%sw_flux_vis_dir', mpp_chksum( iobt%sw_flux_vis_dir) - write(outunit,100) 'iobt%sw_flux_vis_dif', mpp_chksum( iobt%sw_flux_vis_dif) - write(outunit,100) 'iobt%sw_flux_nir_dir', mpp_chksum( iobt%sw_flux_nir_dir) - write(outunit,100) 'iobt%sw_flux_nir_dif', mpp_chksum( iobt%sw_flux_nir_dif) - write(outunit,100) 'iobt%lprec ', mpp_chksum( iobt%lprec ) - write(outunit,100) 'iobt%fprec ', mpp_chksum( iobt%fprec ) - write(outunit,100) 'iobt%runoff ', mpp_chksum( iobt%runoff ) - write(outunit,100) 'iobt%calving ', mpp_chksum( iobt%calving ) - write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p ) + write(outunit,100) 'iobt%u_flux ' , mpp_chksum( iobt%u_flux ) + write(outunit,100) 'iobt%v_flux ' , mpp_chksum( iobt%v_flux ) + write(outunit,100) 'iobt%t_flux ' , mpp_chksum( iobt%t_flux ) + write(outunit,100) 'iobt%q_flux ' , mpp_chksum( iobt%q_flux ) + write(outunit,100) 'iobt%salt_flux ' , mpp_chksum( iobt%salt_flux ) + !write(outunit,100) 'iobt%seaice_melt_heat' , mpp_chksum( iobt%seaice_melt_heat) + !write(outunit,100) 'iobt%seaice_melt_water' , mpp_chksum( iobt%seaice_melt_water) + write(outunit,100) 'iobt%lw_flux ' , mpp_chksum( iobt%lw_flux ) + write(outunit,100) 'iobt%sw_flux_vis_dir' , mpp_chksum( iobt%sw_flux_vis_dir) + write(outunit,100) 'iobt%sw_flux_vis_dif' , mpp_chksum( iobt%sw_flux_vis_dif) + write(outunit,100) 'iobt%sw_flux_nir_dir' , mpp_chksum( iobt%sw_flux_nir_dir) + write(outunit,100) 'iobt%sw_flux_nir_dif' , mpp_chksum( iobt%sw_flux_nir_dif) + write(outunit,100) 'iobt%lprec ' , mpp_chksum( iobt%lprec ) + write(outunit,100) 'iobt%fprec ' , mpp_chksum( iobt%fprec ) + write(outunit,100) 'iobt%runoff ' , mpp_chksum( iobt%runoff ) + write(outunit,100) 'iobt%calving ' , mpp_chksum( iobt%calving ) + write(outunit,100) 'iobt%p ' , mpp_chksum( iobt%p ) if (associated(iobt%ustar_berg)) & - write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg ) + write(outunit,100) 'iobt%ustar_berg ' , mpp_chksum( iobt%ustar_berg ) if (associated(iobt%area_berg)) & - write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg ) + write(outunit,100) 'iobt%area_berg ' , mpp_chksum( iobt%area_berg ) if (associated(iobt%mass_berg)) & - write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg ) + write(outunit,100) 'iobt%mass_berg ' , mpp_chksum( iobt%mass_berg ) 100 FORMAT(" CHECKSUM::",A20," = ",Z20) call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index bf5a2d4eac..fce60ab01a 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1033,6 +1033,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff + !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_water" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_heat" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 1b5a963b51..bf9851a01b 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -310,12 +310,25 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, file=__FILE__)) & return ! bail out - ! TODO: salt flux (minus sign needed here -GMM) - this does not match either NEMS or MCT - so not put in below - do j = jsc,jec - do i = isc,iec - ice_ocean_boundary%salt_flux(i,j) = ice_ocean_boundary%salt_flux(i,j) - enddo - enddo + ! !---- + ! ! snow&ice melt heat flux (W/m^2) + ! !---- + ! call state_getimport(importState, 'seaice_melt_heat', & + ! isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat,rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + + ! !---- + ! ! snow&ice melt water flux (W/m^2) + ! !---- + ! call state_getimport(importState, 'seaice_melt_water', & + ! isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_water,rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out !---- ! mass of overlying ice From 8447a7d3835bac0a642e7b1de226859c3719aca0 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 25 Feb 2019 16:08:10 +0000 Subject: [PATCH 46/77] Simplify creation of ESMF grid using halo values available from ocean_grid. Remove ocean_model_data_get from cap since no longer required --- config_src/nuopc_driver/mom_cap.F90 | 192 +++++--------------- config_src/nuopc_driver/mom_cap_methods.F90 | 2 - 2 files changed, 45 insertions(+), 149 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index d0acf3e219..e3e3e9175b 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -366,7 +366,7 @@ module mom_cap_mod use fms_io_mod, only: fms_io_exit use mpp_domains_mod, only: domain2d, mpp_get_compute_domain, mpp_get_compute_domains use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain - use mpp_domains_mod, only: mpp_get_domain_npes, mpp_global_field + use mpp_domains_mod, only: mpp_get_domain_npes use mpp_io_mod, only: mpp_open, MPP_RDONLY, MPP_ASCII, MPP_OVERWR, MPP_APPEND, mpp_close, MPP_SINGLE use mpp_mod, only: input_nml_file, mpp_error, FATAL, NOTE, mpp_pe, mpp_npes, mpp_set_current_pelist use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id @@ -389,7 +389,7 @@ module mom_cap_mod use MOM_ocean_model, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type, get_global_grid_size use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type - use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc + use MOM_ocean_model, only: ocean_model_init_sfc use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid use mom_cap_time, only: AlarmInit use mom_cap_methods, only: mom_import, mom_export, mom_set_geomtype @@ -1106,13 +1106,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, allocatable :: deLabelList(:) integer, allocatable :: indexList(:) integer :: ioff, joff - integer :: i, j, n, i1, j1, n1 + integer :: i, j, n, i1, j1, n1, jlast integer :: lbnd1,ubnd1,lbnd2,ubnd2 integer :: lbnd3,ubnd3,lbnd4,ubnd4 integer :: nblocks_tot logical :: found - real(ESMF_KIND_R8), allocatable :: ofld(:,:), gfld(:,:) - real(ESMF_KIND_R8), pointer :: t_surf1d(:,:) real(ESMF_KIND_R8), pointer :: t_surf2d(:,:) integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) @@ -1220,14 +1218,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Create either a grid or a mesh !--------------------------------- + !Get the ocean grid and sizes of global and computational domains + call get_ocean_grid(ocean_state, ocean_grid) + if (geomtype == ESMF_GEOMTYPE_MESH) then !--------------------------------- ! Create a MOM6 mesh !--------------------------------- - ! Get the ocean grid and sizes of global and computational domains - call get_ocean_grid(ocean_state, ocean_grid) call get_global_grid_size(ocean_grid, ni, nj) lsize = ( ocean_grid%iec - ocean_grid%isc + 1 ) * ( ocean_grid%jec - ocean_grid%jsc + 1 ) @@ -1470,17 +1469,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out endif - ! TODO: This should be cleaned up now that the ocean_grid is available. - ! Mask, area, center and corner positions are all available. The mask - ! area and center points can be placed in the grid using the same scheme - ! as all other ocean_grid variables are used. The corner points require - ! special treatment to reproduce the original ESMF grid (DLW) - ! load up area, mask, center and corner values ! area, mask, and centers should be same size in mom and esmf grid ! corner points may not be, need to offset corner points by 1 in i and j - ! for esmf and also need to "make up" j=1 values. use wraparound in i - + ! retrieve these values directly from ocean_grid, which contains halos + ! values for j=1 and wrap-around in i. on tripole seam, decomposition + ! domains are 1 larger in j; to load corner values need to loop one extra row + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) lbnd1 = lbound(dataPtr_mask,1) @@ -1509,123 +1504,31 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return endif - allocate(ofld(isc:iec,jsc:jec)) - allocate(gfld(nxg,nyg)) - - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - - if(grid_attach_area) then - call ocean_model_data_get(ocean_state, ocean_public, 'area', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_area(i,j) = ofld(i1,j1) - enddo - enddo - endif - - call ocean_model_data_get(ocean_state, ocean_public, 'tlon', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_xcen(i,j) = ofld(i1,j1) - dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - enddo - enddo - - call ocean_model_data_get(ocean_state, ocean_public, 'tlat', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_ycen(i,j) = ofld(i1,j1) - enddo - enddo - - call ocean_model_data_get(ocean_state, ocean_public, 'geoLonBu', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd4, ubnd4 - do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) - ! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. - ! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_xcor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in xu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - enddo - enddo - - ! MOM6 runs on C-Grid. - call ocean_model_data_get(ocean_state, ocean_public, 'geoLatBu', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd4, ubnd4 - do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_ycor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in yu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - enddo - enddo + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + dataPtr_mask(i1,j1) = ocean_grid%mask2dT(ig,jg) + dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) + dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) + end do + end do + + jlast = jec + if(jec .eq. nyg)jlast = jec+1 + + do j = jsc, jlast + j1 = j + lbnd4 - jsc + jg = j + ocean_grid%jsc - jsc - 1 + do i = isc, iec + i1 = i + lbnd3 - isc + ig = i + ocean_grid%isc - isc - 1 + dataPtr_xcor(i1,j1) = ocean_grid%geolonBu(ig,jg) + dataPtr_ycor(i1,j1) = ocean_grid%geolatBu(ig,jg) + end do + end do write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) @@ -1647,8 +1550,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - deallocate(gfld) - gridOut = gridIn ! for now out same as in call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", grid=gridIn, rc=rc) @@ -1702,7 +1603,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out if (geomtype == ESMF_GEOMTYPE_GRID) then - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1710,18 +1610,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - lbnd1 = lbound(t_surf2d,1) - ubnd1 = ubound(t_surf2d,1) - lbnd2 = lbound(t_surf2d,2) - ubnd2 = ubound(t_surf2d,2) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - if (ofld(i1,j1) == 0.) t_surf2d(i,j) = 0.0 - enddo - enddo + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + if(ocean_grid%mask2dT(ig,jg) == 0.)t_surf2d(i1,j1) = 0.0 + end do + end do + end if end if diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 1383af5155..57fb0c4efe 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -16,7 +16,6 @@ module mom_cap_methods use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT use ESMF, only: ESMF_TYPEKIND_R8 use ESMF, only: operator(/=), operator(==) - !DLW use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type @@ -402,7 +401,6 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ocean mask ! ------- - !DLW: Retrieve omask from ocean_grid, as for other grid variables allocate(omask(isc:iec, jsc:jec)) do j = jsc, jec jg = j + ocean_grid%jsc - jsc From 319bf81aaf68a5369c2cf68b46cc827106ac523b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 26 Feb 2019 09:23:58 -0700 Subject: [PATCH 47/77] fixed minus signs --- config_src/nuopc_driver/MOM_ocean_model.F90 | 3 --- config_src/nuopc_driver/MOM_surface_forcing.F90 | 14 +++++++------- 2 files changed, 7 insertions(+), 10 deletions(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 28ae82750a..71a8933fbc 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -657,9 +657,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call enable_averaging(dt_coupling, OS%Time, OS%diag) call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles) - !TODO: this came in for the merge and is not consistent with the MOA branch - !call mech_forcing_diags(OS%forces, OS%fluxes, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles) - call disable_averaging(OS%diag) if (OS%fluxes%fluxes_used) then diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 0facbd43e8..eb4a7a5771 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -469,20 +469,20 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & ! ! water flux due to sea ice and snow melt (kg/m2/s) ! if (associated(fluxes%seaice_melt)) & - ! fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) + ! fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_water(i-i0,j-j0) fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_fprec_diag(i,j) = -G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent_fprec_diag(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion endif if (associated(IOB%calving)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion endif if (associated(IOB%q_flux)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + fluxes%latent_evap_diag(i,j) = G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor endif fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) From 76b0f4d62a517cf2edada476086a5fc0a82ef282 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 26 Feb 2019 16:34:32 +0000 Subject: [PATCH 48/77] add code for dataPtr_area when creating the grid and attaching area to grid --- config_src/nuopc_driver/mom_cap.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index e3e3e9175b..53b9920060 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1513,11 +1513,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) dataPtr_mask(i1,j1) = ocean_grid%mask2dT(ig,jg) dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) + if(grid_attach_area) then + dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) + end if end do end do - jlast = jec - if(jec .eq. nyg)jlast = jec+1 + jlast = jec + if(jec == nyg)jlast = jec+1 do j = jsc, jlast j1 = j + lbnd4 - jsc From 7a392f70600b68a324d575267bce88315e74da95 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 27 Feb 2019 19:06:14 +0000 Subject: [PATCH 49/77] Final changes for unified cap. Removed t_surf initialization since not required. A few textural changes. --- config_src/nuopc_driver/mom_cap.F90 | 53 +++------------------ config_src/nuopc_driver/mom_cap_methods.F90 | 6 +-- 2 files changed, 10 insertions(+), 49 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 2d7005ebc1..c8ee4668c7 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1031,10 +1031,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff - !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_water" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_heat" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff + !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_water" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_heat" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") @@ -1050,7 +1050,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") do n = 1,fldsToOcn_num call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) @@ -1114,14 +1114,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: lbnd3,ubnd3,lbnd4,ubnd4 integer :: nblocks_tot logical :: found - real(ESMF_KIND_R8), pointer :: t_surf2d(:,:) integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) - type(ESMF_Field) :: field_t_surf integer :: mpicom integer :: localPet integer :: lsize @@ -1475,8 +1473,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! load up area, mask, center and corner values ! area, mask, and centers should be same size in mom and esmf grid ! corner points may not be, need to offset corner points by 1 in i and j - ! retrieve these values directly from ocean_grid, which contains halos - ! values for j=1 and wrap-around in i. on tripole seam, decomposition + ! retrieve these values directly from ocean_grid, which contains halo + ! values for j=0 and wrap-around in i. on tripole seam, decomposition ! domains are 1 larger in j; to load corner values need to loop one extra row call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) @@ -1592,43 +1590,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out endif - !--------------------------------- - ! set surface temperature to 0 if ocean mask is 0 - !--------------------------------- - - ! TODO (mvertens, 2018-12-30): is this really necessary? for now only do this for grid - - ! Do sst initialization if it's part of export state - call ESMF_StateGet(exportState, 'sea_surface_temperature', itemFlag) - if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - - call ESMF_StateGet(exportState, 'sea_surface_temperature', field=field_t_surf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (geomtype == ESMF_GEOMTYPE_GRID) then - - call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + ocean_grid%isc - isc - if(ocean_grid%mask2dT(ig,jg) == 0.)t_surf2d(i1,j1) = 0.0 - end do - end do - - end if - end if - !--------------------------------- ! Set module variable geomtype in mom_cap_methods !--------------------------------- diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 40fba4b654..65360abeee 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -457,7 +457,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ------- ! rotate ocn current from tripolar grid back to lat/lon grid x,y => latlon (CCW) - ! "ocean_grid%isc" has no halos and uses local indexing. + ! "ocean_grid" has halos and uses local indexing. allocate(ocz(isc:iec, jsc:jec)) allocate(ocm(isc:iec, jsc:jec)) @@ -632,7 +632,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end do ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) - ! "ocean_grid" uses has halos and uses global indexing. + ! "ocean_grid" uses has halos and uses local indexing. do j = jsc, jec jg = j + ocean_grid%jsc - jsc @@ -833,7 +833,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid ! Indexing notes: ! input array from "ocean_public" uses local indexing without halos - ! mask from "ocean_grid" uses global indexing with halos + ! mask from "ocean_grid" uses local indexing with halos call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then From b43284b3d2fde78faca467e7fa91314d4efbe694 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 28 Feb 2019 09:52:11 -0700 Subject: [PATCH 50/77] updated documentation --- config_src/nuopc_driver/mom_cap.F90 | 199 +++++++++++----------------- 1 file changed, 74 insertions(+), 125 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index c8ee4668c7..3fda902d3c 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -4,6 +4,7 @@ !! @date 5/10/13 Original documentation !! @author Rocky Dunlap (rocky.dunlap@noaa.gov) !! @date 1/12/17 Moved to doxygen +!! @date 2/28/19 Rewrote for unified cap !! !! @tableofcontents !! @@ -11,11 +12,13 @@ !! !! **This MOM cap has been tested with MOM6.** !! -!! This document describes the MOM "cap", which is a small software layer that is -!! required when the [MOM ocean model] (http://mom-ocean.org/web) +!! This document describes the MOM NUOPC "cap", which is a light weight software layer that is +!! required when the [MOM ocean model](https://github.com/NOAA-GFDL/MOM6/tree/dev/master) !! is used in [National Unified Operation Prediction Capability] -!! (http://www.earthsystemcog.org/projects/nuopc) (NUOPC) coupled systems. -!! The NUOPC Layer is a software layer built on top of the [Earth System Modeling +!! (http://www.earthsystemcog.org/projects/nuopc) (NUOPC) coupled systems. Also see the +!! [MOM wiki](https://github.com/NOAA-GFDL/MOM6-Examples/wiki) for more documentation. +!! +!! NUOPC is a software layer built on top of the [Earth System Modeling !! Framework] (https://www.earthsystemcog.org/projects/esmf) (ESMF). !! ESMF is a high-performance modeling framework that provides !! data structures, interfaces, and operations suited for building coupled models @@ -25,63 +28,31 @@ !! Layer software is designed to work with typical high-performance models in the !! Earth sciences domain, most of which are written in Fortran and are based on a !! distributed memory model of parallelism (MPI). +!! !! A NUOPC "cap" is a Fortran module that serves as the interface to a model !! when it's used in a NUOPC-based coupled system. -!! The term "cap" is used because it is a small software layer that sits on top +!! The term "cap" is used because it is a light weight software layer that sits on top !! of model code, making calls into it and exposing model data structures in a -!! standard way. For more information about creating NUOPC caps in general, please -!! see the [Building a NUOPC Model] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_howtodoc/) -!! how-to document. +!! standard way. !! -!! The MOM cap package includes the cap code itself (mom_cap.F90 and mom_cap_methods.F90), a -!! set of time utilities (time_utils.F90) for converting between ESMF and FMS -!! time type and two modules MOM_ocean_model.F90 and MOM_surface_forcing.F90. +!! The MOM cap package includes the cap code itself (mom_cap.F90, mom_cap_methods.F90 +!! and mom_cap_time.F90), a set of time utilities (time_utils.F90) for converting between ESMF and FMS +!! time type and two modules MOM_ocean_model.F90 and MOM_surface_forcing.F90. MOM_surface_forcing.F90 +!! converts the input ESMF data (import data) to a MOM-specific data type (surface_forcing_CS). +!! MOM_ocean_model.F90 contains routines for initialization, update and finalization of the ocean model state. !! !! @subsection CapSubroutines Cap Subroutines !! -!! The MOM cap Fortran modules contains a set of subroutines that are required +!! The MOM cap modules contains a set of subroutines that are required !! by NUOPC. These subroutines are called by the NUOPC infrastructure according !! to a predefined calling sequence. Some subroutines are called during !! initialization of the coupled system, some during the run of the coupled -!! system, and some during finalization of the coupled system. The initialization -!! sequence is the most complex and is governed by the NUOPC technical rules. -!! Details about the initialization sequence can be found in the [NUOPC Reference Manual] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html -!! #SECTION00034000000000000000). +!! system, and some during finalization of the coupled system. !! -!! A particularly important part of the NUOPC intialization sequence is to establish -!! field connections between models. Simply put, a field connection is established -!! when a field output by one model can be consumed by another. As an example, the -!! MOM model is able to accept a precipitation rate when coupled to an atmosphere -!! model. In this case a field connection will be established between the precipitation -!! rate exported from the atmosphere and the precipitation rate imported into the -!! MOM model. Because models may uses different variable names for physical -!! quantities, NUOPC relies on a set of standard names and a built-in, extensible -!! standard name dictionary to match fields between models. More information about -!! the use of standard names can be found in the [NUOPC Reference Manual] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html -!! #SECTION00032000000000000000). -!! -!! Two key initialization phases that appear in every NUOPC cap, including this MOM -!! cap are the field "advertise" and field "realize" phases. *Advertise* is a special -!! NUOPC term that refers to a model participating in a coupled system -!! providing a list of standard names of required import fields and available export -!! fields. In other words, each model will advertise to the other models which physical fields -!! it needs and which fields it can provide when coupled. NUOPC compares all of the advertised -!! standard names and creates a set of unidirectional links, each from one export field -!! in a model to one import field in another model. When these connections have been established, -!! all models in the coupled system need to provide a description of their geographic -!! grid (e.g., lat-lon, tri-polar, cubed sphere, etc.) and allocate their connected -!! fields on that grid. In NUOPC terms, this is refered to as *realizing* a set of -!! fields. NUOPC relies on ESMF data types for this, such as the [ESMF_Grid] -!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05080000000000000000) -!! type, which describes logically rectangular grids and the [ESMF_Field] -!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05030000000000000000) -!! type, which wraps a models data arrays and provides basic metadata. Because ESMF supports -!! interpolation between different grids (sometimes called "regridding" or "grid remapping"), -!! it is not necessary that models share a grid. As you will see below -!! the *advertise* and *realize* phases each have a subroutine in the HYCOM cap. +!! The initialization sequence is the most complex and is governed by the NUOPC technical rules. +!! Details about the initialization sequence can be found in the [NUOPC Reference Manual] +!! (http://www.earthsystemmodeling.org/esmf_releases/last_built/NUOPC_refdoc/). +!! The cap requires beta snapshot ESMF v8.0.0bs16 or later. !! !! The following table summarizes the NUOPC-required subroutines that appear in the !! MOM cap. The "Phase" column says whether the subroutine is called during the @@ -93,7 +64,7 @@ !! | (IPD) version to use !! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import !! | and export fields -!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid for the MOM grid +!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid or ESMF_Mesh !! | as well as ESMF_Fields for import !! | and export fields !! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep @@ -104,8 +75,12 @@ !! !! @subsection DomainCreation Domain Creation !! -!! The MOM tripolar grid is represented as a 2D `ESMF_Grid` and coupling fields are placed -!! on this grid. Calls related to creating the grid are located in the [InitializeRealize] +!! The cap can accomodate a MOM tripolar grid which is represented either as a 2D `ESMF_Grid` or +!! as a 1D `ESMF_Mesh`. Other MOM grids (e.g. a bipolar grid) can be represented as a 1d `ESMF_Mesh` only. +!! Coupling fields are placed on either the `ESMF_Grid` or `ESMF_Mesh`. +!! Note that for either the `ESMF_Grid` or `ESMF_Mesh` representation, the fields are translated into +!! a 2D MOM specific surface boundary type and the distinction between the two is no longer there. +!! Calls related to creating the grid are located in the [InitializeRealize] !! (@ref mom_cap_mod::initializerealize) subroutine, which is called by the NUOPC infrastructure !! during the intialization sequence. !! @@ -117,16 +92,23 @@ !! (to retrieve decomposition block indices) and `mpp_get_pelist()` (to determine how !! blocks are assigned to processors). !! -!! The grid is created in several steps: +!! The `ESMF_Grid` is created in several steps: !! - an `ESMF_DELayout` is created based on the pelist from MOM !! - an `ESMF_DistGrid` is created over the global index space. Connections are set !! up so that the index space is periodic in the first dimension and has a !! fold at the top for the bipole. The decompostion blocks are also passed in !! along with the `ESMF_DELayout` mentioned above. !! - an `ESMF_Grid` is then created by passing in the above `ESMF_DistGrid`. +!! - masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` +!! by retrieving those fields from the MOM datatype `ocean_grid` elements. +!! +!! The `ESMF_Mesh` is also created in several steps: +!! - the target mesh is generated offline. +!! - a temporary mesh is created from an input file specified by the config variable `mesh_ocn`. +!! the mesh has a distribution that is automatically generated by ESMF when reading in the mesh +!! - an `ESMF_DistGrid` is created from the global index space for the computational domain. +!! - the final `ESMF_Mesh` is then created by distributing the temporary mesh using the created `ESMF_DistGrid`. !! -!! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` -!! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. !! !! @subsection Initialization Initialization !! @@ -147,12 +129,9 @@ !! !! Priori to the call to `update_ocean_model()`, the cap performs these steps !! - the `Time` and `Time_step_coupled` parameters, based on FMS types, are derived from the incoming ESMF clock -!! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently -!! inactive, but may be modified to read in import data from file or from an external coupler !! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field -!! - mom_import is called +!! - mom_import is called and translates to the ESMF input data to a MOM specific data type !! - momentum flux vectors are rotated to internal grid -!! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` !! !! After the call to `update_ocean_model()`, the cap performs these steps: !! - mom_export is called @@ -160,6 +139,7 @@ !! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval !! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid !! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field +!! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` !! !! @subsubsection VectorRotations Vector Rotations !! @@ -226,7 +206,7 @@ !! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | !! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean !! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | -!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) +!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | !! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | !! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean !! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar @@ -239,8 +219,8 @@ !! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean !! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | !! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | -!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) -!! mean_zonal_moment_flx | Pa | u_flux | j-directed wind stress into ocean +!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | +!! mean_zonal_moment_flx | Pa | u_flux | i-directed wind stress into ocean !! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar !! !! @@ -251,7 +231,7 @@ !! !! Standard Name | Units | Model Variable | Description | Notes !! ---------------------------|-------|----------------|-------------------------------------------|-------------------- -!! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation +!! freezing_melting_potential | W m-2 | combination of frazil and melt_potential !! | cap converts model units (J m-2) to (W m-2) for export !! ocean_mask | | | ocean mask | | !! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell @@ -259,9 +239,10 @@ !! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell !! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon !! s_surf | psu | s_surf | sea surface salinity on t-cell | | -!! sea_lev | m | sea_lev | sea level -!! | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide !! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | +!! sea_surface_slope_zonal ! unitless | created from ssh | sea surface zonal slope +!! sea_surface_slope_merid ! unitless | created from ssh | sea surface meridional slope +!! so_bldepth ! m ! obld | ocean surface boundary layer depth !! !! @subsection MemoryManagement Memory Management !! @@ -308,53 +289,20 @@ !! named "field_ocn_internal_.nc". In all cases these NetCDF files will !! contain a time series of field data. !! -!! @section BuildingAndInstalling Building and Installing -!! -!! There are two makefiles included with the MOM cap, makefile and makefile.nuopc. -!! The makefile.nuopc file is intended to be used within another build system, such -!! as the NEMSAppBuilder. The regular makefile can be used generally for building -!! and installing the cap. Two variables must be customized at the top: -!! - `INSTALLDIR` - where to copy the cap library and dependent libraries -!! - `NEMSMOMDIR` - location of the MOM library and FMS library -!! -!! To install run: -!! $ make install -!! -!! A makefile fragment, mom.mk, will also be copied into the directory. The fragment -!! defines several variables that can be used by another build system to include the -!! MOM cap and its dependencies. -!! -!! @subsection Dependencies Dependencies -!! -!! The MOM cap is dependent on the MOM library itself (lib_ocean.a) and the FMS -!! library (lib_FMS.a). -!! !! @section RuntimeConfiguration Runtime Configuration !! !! At runtime, the MOM cap can be configured with several options provided !! as ESMF attributes. Attributes can be set in the cap by the NUOPC Driver -!! above this cap, or in some systems (e.g., NEMS) attributes are set by +!! above this cap, or in some systems ESMF attributes are set by !! reading in from a configuration file. The available attributes are: !! !! * `DumpFields` - when set to "true", write out diagnostic NetCDF files for import/export/internal fields !! * `ProfileMemory` - when set to "true", write out memory usage information to the ESMF log files; this -!! information is written when entering and leaving the [ModelAdvance] -!! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to +!! information is written when entering and leaving the [ModelAdvance] +!! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to !! `update_ocean_model()`. !! * `restart_interval` - integer number of seconds indicating the interval at -!! which to call `ocean_model_restart()`; no restarts written if set to 0 -!! * `GridAttachArea` - when set to "true", this option indicates that MOM grid attaches cell area -!! using internal values computed in MOM. The default value is "false", grid cell area will -!! be computed in ESMF. -!! -!! -!! @section Repository -!! The MOM NUOPC cap is maintained in a GitHub repository: -!! https://github.com/feiliuesmf/nems_mom_cap -!! -!! @section References -!! -!! - [MOM Home Page] (http://mom-ocean.org/web) +!! which to call `ocean_model_restart()`; no restarts written if set to 0 !! !! module mom_cap_mod @@ -1036,7 +984,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_water" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_heat" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") @@ -1050,7 +998,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") do n = 1,fldsToOcn_num call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) @@ -1474,9 +1422,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! area, mask, and centers should be same size in mom and esmf grid ! corner points may not be, need to offset corner points by 1 in i and j ! retrieve these values directly from ocean_grid, which contains halo - ! values for j=0 and wrap-around in i. on tripole seam, decomposition + ! values for j=0 and wrap-around in i. on tripole seam, decomposition ! domains are 1 larger in j; to load corner values need to loop one extra row - + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) lbnd1 = lbound(dataPtr_mask,1) @@ -1844,24 +1792,6 @@ subroutine ModelAdvance(gcomp, rc) ! Update MOM6 !--------------- - ! Optionally write restart files when currTime-startTime is integer multiples of restart_interval - ! if (restart_interval > 0 ) then - ! time_elapsed = currTime - startTime - ! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! n_interval = time_elapsed_sec / restart_interval - ! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then - ! time_restart_current = esmf2fms_time(currTime) - ! timestamp = date_to_string(time_restart_current) - ! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) - ! write(*,*) 'calling ocean_model_restart' - ! call ocean_model_restart(ocean_state, timestamp) - ! endif - ! endif - if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") @@ -1956,6 +1886,25 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out endif + ! TODO: address if this requirement is being met for the DA group + ! Optionally write restart files when currTime-startTime is integer multiples of restart_interval + ! if (restart_interval > 0 ) then + ! time_elapsed = currTime - startTime + ! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! n_interval = time_elapsed_sec / restart_interval + ! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then + ! time_restart_current = esmf2fms_time(currTime) + ! timestamp = date_to_string(time_restart_current) + ! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) + ! write(*,*) 'calling ocean_model_restart' + ! call ocean_model_restart(ocean_state, timestamp) + ! endif + ! endif + ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) From cec62451b0d8cc9a03785a9bb875f136d63f902a Mon Sep 17 00:00:00 2001 From: "Jessica.Meixner" Date: Wed, 6 Mar 2019 13:27:05 +0000 Subject: [PATCH 51/77] reverting files that were not meant to be changed --- src/core/MOM.F90 | 5 +---- src/ice_shelf/MOM_ice_shelf.F90 | 10 +++++----- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 4 ++-- 3 files changed, 8 insertions(+), 11 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 8ff49c628c..1a590bb5b8 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1153,10 +1153,7 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & call enable_averaging(dtdia, Time_end_thermo, CS%diag) - ! added check in order to run MOM with debug flags - if (CS%ensemble_ocean) then - call apply_oda_tracer_increments(dtdia,G,tv,h,CS%odaCS) - end if + call apply_oda_tracer_increments(dtdia,G,tv,h,CS%odaCS) if (update_BBL) then ! Calculate the BBL properties and store them inside visc (u,h). diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 9abebcfe9a..3a27c988c9 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -308,7 +308,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) if (CS%mass_from_file) call update_shelf_mass(G, CS, ISS, Time) endif - if (CS%debug) then + if (CS%DEBUG) then call hchksum(fluxes%frac_shelf_h, "frac_shelf_h before apply melting", G%HI, haloshift=0) call hchksum(state%sst, "sst before apply melting", G%HI, haloshift=0) call hchksum(state%sss, "sss before apply melting", G%HI, haloshift=0) @@ -633,7 +633,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call change_thickness_using_melt(ISS, G, time_step, fluxes, CS%density_ice, CS%debug) endif - if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) + if (CS%DEBUG) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) call add_shelf_flux(G, CS, state, fluxes) @@ -675,7 +675,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call cpu_clock_end(id_clock_shelf) - if (CS%debug) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) + if (CS%DEBUG) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) end subroutine shelf_calc_flux @@ -1043,7 +1043,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) endif enddo ; enddo - if (CS%debug) then + if (CS%DEBUG) then write(mesg,*) 'Mean melt flux (kg/(m^2 s)), dt = ', mean_melt_flux, CS%time_step call MOM_mesg(mesg) call MOM_forcing_chksum("After constant sea level", fluxes, G, haloshift=0) @@ -1483,7 +1483,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / G%areaT(i,j) enddo ; enddo ; endif - if (CS%debug) then + if (CS%DEBUG) then call hchksum(fluxes%frac_shelf_h, "IS init: frac_shelf_h", G%HI, haloshift=0) endif diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index eac698f67c..eea9ee322a 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -920,7 +920,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) call ice_shelf_solve_inner(CS, ISS, G, u, v, TAUDX, TAUDY, H_node, float_cond, & ISS%hmask, conv_flag, iters, time, Phi, Phisub) - if (CS%debug) then + if (CS%DEBUG) then call qchksum(u, "u shelf", G%HI, haloshift=2) call qchksum(v, "v shelf", G%HI, haloshift=2) endif @@ -3597,7 +3597,7 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) call pass_var(CS%t_shelf, G%domain) call pass_var(CS%tmask, G%domain) - if (CS%debug) then + if (CS%DEBUG) then call hchksum(CS%t_shelf, "temp after front", G%HI, haloshift=3) endif From 6e5e587339a804204759650e6ec1f2644d801de7 Mon Sep 17 00:00:00 2001 From: "Jessica.Meixner" Date: Wed, 6 Mar 2019 21:07:20 -0500 Subject: [PATCH 52/77] removing trailing white space and fixing lines longer than 120 --- .../nuopc_driver/MOM_surface_forcing.F90 | 4 +-- config_src/nuopc_driver/mom_cap.F90 | 27 ++++++++++--------- 2 files changed, 17 insertions(+), 14 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index eb4a7a5771..eebda0b8fc 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -162,8 +162,8 @@ module MOM_surface_forcing real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux (W/m2) real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux (kg/m2/s) real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux (kg/m2/s) - real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux (W/m2) - real, pointer, dimension(:,:) :: seaice_melt_water =>NULL() !< water flux due to sea ice and snow melting (kg/m2/s) + real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux (W/m2) + real, pointer, dimension(:,:) :: seaice_melt_water =>NULL() !< water flux due to sea ice and snow melting (kg/m2/s) real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation (W/m2) real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation (W/m2) real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation (W/m2) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 3fda902d3c..f465cb9183 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -47,7 +47,7 @@ !! by NUOPC. These subroutines are called by the NUOPC infrastructure according !! to a predefined calling sequence. Some subroutines are called during !! initialization of the coupled system, some during the run of the coupled -!! system, and some during finalization of the coupled system. +!! system, and some during finalization of the coupled system. !! !! The initialization sequence is the most complex and is governed by the NUOPC technical rules. !! Details about the initialization sequence can be found in the [NUOPC Reference Manual] @@ -64,7 +64,7 @@ !! | (IPD) version to use !! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import !! | and export fields -!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid or ESMF_Mesh +!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid or ESMF_Mesh !! | as well as ESMF_Fields for import !! | and export fields !! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep @@ -75,7 +75,7 @@ !! !! @subsection DomainCreation Domain Creation !! -!! The cap can accomodate a MOM tripolar grid which is represented either as a 2D `ESMF_Grid` or +!! The cap can accomodate a MOM tripolar grid which is represented either as a 2D `ESMF_Grid` or !! as a 1D `ESMF_Mesh`. Other MOM grids (e.g. a bipolar grid) can be represented as a 1d `ESMF_Mesh` only. !! Coupling fields are placed on either the `ESMF_Grid` or `ESMF_Mesh`. !! Note that for either the `ESMF_Grid` or `ESMF_Mesh` representation, the fields are translated into @@ -206,7 +206,7 @@ !! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | !! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean !! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | -!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | +!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | !! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | !! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean !! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar @@ -219,7 +219,7 @@ !! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean !! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | !! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | -!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | +!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | !! mean_zonal_moment_flx | Pa | u_flux | i-directed wind stress into ocean !! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar !! @@ -231,17 +231,19 @@ !! !! Standard Name | Units | Model Variable | Description | Notes !! ---------------------------|-------|----------------|-------------------------------------------|-------------------- -!! freezing_melting_potential | W m-2 | combination of frazil and melt_potential +!! freezing_melting_potential | W m-2 | combination of frazil and melt_potential !! | cap converts model units (J m-2) to (W m-2) for export !! ocean_mask | | | ocean mask | | !! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell -!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! | [vector rotation] (@ref VectorRotations) applied +!! | - tripolar to lat-lon !! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell -!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! | [vector rotation] (@ref VectorRotations) applied +!! | - tripolar to lat-lon !! s_surf | psu | s_surf | sea surface salinity on t-cell | | !! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | -!! sea_surface_slope_zonal ! unitless | created from ssh | sea surface zonal slope -!! sea_surface_slope_merid ! unitless | created from ssh | sea surface meridional slope +!! sea_surface_slope_zonal ! unitless | created from ssh | sea surface zonal slope +!! sea_surface_slope_merid ! unitless | created from ssh | sea surface meridional slope !! so_bldepth ! m ! obld | ocean surface boundary layer depth !! !! @subsection MemoryManagement Memory Management @@ -878,7 +880,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return else - call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + call ESMF_LogWrite('mom_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',& ESMF_LOGMSG_WARNING, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2337,8 +2339,9 @@ subroutine SetScalarField(field, rc) file=__FILE__)) & return ! bail out + ! num of scalar values field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) ! num of scalar values + ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & From 347eb0b545fccda3805e1e2dc89480bc684e6004 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 20 Mar 2019 14:17:22 -0600 Subject: [PATCH 53/77] Remove left spaces and add implicit none; private --- config_src/nuopc_driver/mom_cap.F90 | 3933 +++++++++---------- config_src/nuopc_driver/mom_cap_methods.F90 | 1697 ++++---- config_src/nuopc_driver/mom_cap_time.F90 | 791 ++-- config_src/nuopc_driver/time_utils.F90 | 305 +- 4 files changed, 3361 insertions(+), 3365 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index f465cb9183..7ac1f18e2b 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -308,2098 +308,2097 @@ !! !! module mom_cap_mod - use constants_mod, only: constants_init - use diag_manager_mod, only: diag_manager_init, diag_manager_end - use field_manager_mod, only: field_manager_init, field_manager_end - use fms_mod, only: fms_init, fms_end, open_namelist_file, check_nml_error - use fms_mod, only: close_file, file_exist, uppercase - use fms_io_mod, only: fms_io_exit - use mpp_domains_mod, only: domain2d, mpp_get_compute_domain, mpp_get_compute_domains - use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain - use mpp_domains_mod, only: mpp_get_domain_npes - use mpp_io_mod, only: mpp_open, MPP_RDONLY, MPP_ASCII, MPP_OVERWR, MPP_APPEND, mpp_close, MPP_SINGLE - use mpp_mod, only: input_nml_file, mpp_error, FATAL, NOTE, mpp_pe, mpp_npes, mpp_set_current_pelist - use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id - use mpp_mod, only: mpp_clock_begin, mpp_clock_end, MPP_CLOCK_SYNC - use mpp_mod, only: MPP_CLOCK_DETAILED, CLOCK_COMPONENT, MAXPES - use time_interp_external_mod, only: time_interp_external_init - use time_manager_mod, only: set_calendar_type, time_type, increment_date - use time_manager_mod, only: set_time, set_date, get_time, get_date, month_name - use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR - use time_manager_mod, only: operator( <= ), operator( < ), operator( >= ) - use time_manager_mod, only: operator( + ), operator( - ), operator( / ) - use time_manager_mod, only: operator( * ), operator( /= ), operator( > ) - use time_manager_mod, only: date_to_string - use time_manager_mod, only: fms_get_calendar_type => get_calendar_type - use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here - use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file - use MOM_get_input, only: Get_MOM_Input, directories - use MOM_domains, only: pass_var - use MOM_error_handler, only: is_root_pe - use MOM_ocean_model, only: ice_ocean_boundary_type - use MOM_grid, only: ocean_grid_type, get_global_grid_size - use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type - use MOM_ocean_model, only: ocean_model_init_sfc - use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid - use mom_cap_time, only: AlarmInit - use mom_cap_methods, only: mom_import, mom_export, mom_set_geomtype +use constants_mod, only: constants_init +use diag_manager_mod, only: diag_manager_init, diag_manager_end +use field_manager_mod, only: field_manager_init, field_manager_end +use fms_mod, only: fms_init, fms_end, open_namelist_file, check_nml_error +use fms_mod, only: close_file, file_exist, uppercase +use fms_io_mod, only: fms_io_exit +use mpp_domains_mod, only: domain2d, mpp_get_compute_domain, mpp_get_compute_domains +use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain +use mpp_domains_mod, only: mpp_get_domain_npes +use mpp_io_mod, only: mpp_open, MPP_RDONLY, MPP_ASCII, MPP_OVERWR, MPP_APPEND, mpp_close, MPP_SINGLE +use mpp_mod, only: input_nml_file, mpp_error, FATAL, NOTE, mpp_pe, mpp_npes, mpp_set_current_pelist +use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id +use mpp_mod, only: mpp_clock_begin, mpp_clock_end, MPP_CLOCK_SYNC +use mpp_mod, only: MPP_CLOCK_DETAILED, CLOCK_COMPONENT, MAXPES +use time_interp_external_mod, only: time_interp_external_init +use time_manager_mod, only: set_calendar_type, time_type, increment_date +use time_manager_mod, only: set_time, set_date, get_time, get_date, month_name +use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR +use time_manager_mod, only: operator( <= ), operator( < ), operator( >= ) +use time_manager_mod, only: operator( + ), operator( - ), operator( / ) +use time_manager_mod, only: operator( * ), operator( /= ), operator( > ) +use time_manager_mod, only: date_to_string +use time_manager_mod, only: fms_get_calendar_type => get_calendar_type +use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here +use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file +use MOM_get_input, only: Get_MOM_Input, directories +use MOM_domains, only: pass_var +use MOM_error_handler, only: is_root_pe +use MOM_ocean_model, only: ice_ocean_boundary_type +use MOM_grid, only: ocean_grid_type, get_global_grid_size +use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type +use MOM_ocean_model, only: ocean_model_init_sfc +use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid +use mom_cap_time, only: AlarmInit +use mom_cap_methods, only: mom_import, mom_export, mom_set_geomtype #ifdef CESMCOUPLED - use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit +use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit #endif - use time_utils_mod, only: esmf2fms_time - - use, intrinsic :: iso_fortran_env, only: output_unit - - use ESMF - use NUOPC - use NUOPC_Model, & - model_routine_SS => SetServices, & - model_label_Advance => label_Advance, & - model_label_DataInitialize => label_DataInitialize, & - model_label_SetRunClock => label_SetRunClock, & - model_label_Finalize => label_Finalize - - implicit none - private - - public SetServices - - type ocean_internalstate_type - type(ocean_public_type), pointer :: ocean_public_type_ptr - type(ocean_state_type), pointer :: ocean_state_type_ptr - type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr - end type - - type ocean_internalstate_wrapper - type(ocean_internalstate_type), pointer :: ptr - end type - - type fld_list_type - character(len=64) :: stdname - character(len=64) :: shortname - character(len=64) :: transferOffer - end type fld_list_type - - integer,parameter :: fldsMax = 100 - integer :: fldsToOcn_num = 0 - type (fld_list_type) :: fldsToOcn(fldsMax) - integer :: fldsFrOcn_num = 0 - type (fld_list_type) :: fldsFrOcn(fldsMax) - - integer :: debug = 0 - integer :: import_slice = 1 - integer :: export_slice = 1 - character(len=256) :: tmpstr - logical :: write_diagnostics = .false. - character(len=32) :: runtype ! run type - integer :: logunit ! stdout logging unit number - logical :: profile_memory = .true. - logical :: grid_attach_area = .false. - character(len=128) :: scalar_field_name = '' - integer :: scalar_field_count = 0 - integer :: scalar_field_idx_grid_nx = 0 - integer :: scalar_field_idx_grid_ny = 0 - character(len=*),parameter :: u_file_u = & - __FILE__ +use time_utils_mod, only: esmf2fms_time + +use, intrinsic :: iso_fortran_env, only: output_unit + +use ESMF +use NUOPC +use NUOPC_Model, & + model_routine_SS => SetServices, & + model_label_Advance => label_Advance, & + model_label_DataInitialize => label_DataInitialize, & + model_label_SetRunClock => label_SetRunClock, & + model_label_Finalize => label_Finalize + +implicit none; private + +public SetServices + +type ocean_internalstate_type + type(ocean_public_type), pointer :: ocean_public_type_ptr + type(ocean_state_type), pointer :: ocean_state_type_ptr + type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr +end type + +type ocean_internalstate_wrapper + type(ocean_internalstate_type), pointer :: ptr +end type + +type fld_list_type + character(len=64) :: stdname + character(len=64) :: shortname + character(len=64) :: transferOffer +end type fld_list_type + +integer,parameter :: fldsMax = 100 +integer :: fldsToOcn_num = 0 +type (fld_list_type) :: fldsToOcn(fldsMax) +integer :: fldsFrOcn_num = 0 +type (fld_list_type) :: fldsFrOcn(fldsMax) + +integer :: debug = 0 +integer :: import_slice = 1 +integer :: export_slice = 1 +character(len=256) :: tmpstr +logical :: write_diagnostics = .false. +character(len=32) :: runtype ! run type +integer :: logunit ! stdout logging unit number +logical :: profile_memory = .true. +logical :: grid_attach_area = .false. +character(len=128) :: scalar_field_name = '' +integer :: scalar_field_count = 0 +integer :: scalar_field_idx_grid_nx = 0 +integer :: scalar_field_idx_grid_ny = 0 +character(len=*),parameter :: u_file_u = & + __FILE__ #ifdef CESMCOUPLED - logical :: cesm_coupled = .true. - type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH +logical :: cesm_coupled = .true. +type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH #else - logical :: cesm_coupled = .false. - type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID +logical :: cesm_coupled = .false. +type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID #endif !======================================================================= contains !======================================================================= - !=============================================================================== - !> NUOPC SetService method is the only public entry point. - !! SetServices registers all of the user-provided subroutines - !! in the module with the NUOPC layer. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine SetServices(gcomp, rc) - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - character(len=*),parameter :: subname='(mom_cap:SetServices)' - - rc = ESMF_SUCCESS - - ! the NUOPC model component will register the generic methods - call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! switching to IPD versions - call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - userRoutine=InitializeP0, phase=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! set entry point for methods that require specific implementation - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeAdvertise, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeRealize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !------------------ - ! attach specializing method(s) - !------------------ - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_DataInitialize, & - specRoutine=DataInitialize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & - specRoutine=ModelAdvance, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, & - specRoutine=ModelSetRunClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & - specRoutine=ocean_model_finalize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine SetServices - - !=============================================================================== - - !> First initialize subroutine called by NUOPC. The purpose - !! is to set which version of the Initialize Phase Definition (IPD) - !! to use. - !! - !! For this MOM cap, we are using IPDv01. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - subroutine InitializeP0(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - logical :: isPresent, isSet - integer :: iostat - character(len=64) :: value, logmsg - character(len=*),parameter :: subname='(mom_cap:InitializeP0)' - - rc = ESMF_SUCCESS +!=============================================================================== +!> NUOPC SetService method is the only public entry point. +!! SetServices registers all of the user-provided subroutines +!! in the module with the NUOPC layer. +!! +!! @param gcomp an ESMF_GridComp object +!! @param rc return code +subroutine SetServices(gcomp, rc) + + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + character(len=*),parameter :: subname='(mom_cap:SetServices)' + + rc = ESMF_SUCCESS + + ! the NUOPC model component will register the generic methods + call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! switching to IPD versions + call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + userRoutine=InitializeP0, phase=0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! set entry point for methods that require specific implementation + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeAdvertise, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeRealize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !------------------ + ! attach specializing method(s) + !------------------ + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_DataInitialize, & + specRoutine=DataInitialize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & + specRoutine=ModelAdvance, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, & + specRoutine=ModelSetRunClock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & + specRoutine=ocean_model_finalize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +end subroutine SetServices - ! Switch to IPDv03 by filtering all other phaseMap entries - call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & - acceptStringList=(/"IPDv03p"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return +!=============================================================================== - write_diagnostics = .false. - call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") +!> First initialize subroutine called by NUOPC. The purpose +!! is to set which version of the Initialize Phase Definition (IPD) +!! to use. +!! +!! For this MOM cap, we are using IPDv01. +!! +!! @param gcomp an ESMF_GridComp object +!! @param importState an ESMF_State object for import fields +!! @param exportState an ESMF_State object for export fields +!! @param clock an ESMF_Clock object +!! @param rc return code +subroutine InitializeP0(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + logical :: isPresent, isSet + integer :: iostat + character(len=64) :: value, logmsg + character(len=*),parameter :: subname='(mom_cap:InitializeP0)' + + rc = ESMF_SUCCESS + + ! Switch to IPDv03 by filtering all other phaseMap entries + call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & + acceptStringList=(/"IPDv03p"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - write(logmsg,*) write_diagnostics - call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + write_diagnostics = .false. + call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") - profile_memory = .false. - call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) profile_memory=(trim(value)=="true") - write(logmsg,*) profile_memory - call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + write(logmsg,*) write_diagnostics + call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - grid_attach_area = .false. - call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") - write(logmsg,*) grid_attach_area - call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + profile_memory = .false. + call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) profile_memory=(trim(value)=="true") + write(logmsg,*) profile_memory + call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - scalar_field_name = "" - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) then - scalar_field_name = trim(value) - call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif + grid_attach_area = .false. + call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") + write(logmsg,*) grid_attach_area + call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - scalar_field_count = 0 - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=value, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) then - read(value, '(i)', iostat=iostat) scalar_field_count - if (iostat /= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ScalarFieldCount not an integer: "//trim(value), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - write(logmsg,*) scalar_field_count - call ESMF_LogWrite('mom_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif + scalar_field_name = "" + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + scalar_field_name = trim(value) + call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + scalar_field_count = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_count + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldCount not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_count + call ESMF_LogWrite('mom_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + scalar_field_idx_grid_nx = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldIdxGridNX not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_idx_grid_nx + call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + scalar_field_idx_grid_ny = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldIdxGridNY not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_idx_grid_ny + call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + call NUOPC_CompAttributeAdd(gcomp, & + attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - scalar_field_idx_grid_nx = 0 - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=value, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) then - read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx - if (iostat /= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ScalarFieldIdxGridNX not an integer: "//trim(value), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - write(logmsg,*) scalar_field_idx_grid_nx - call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif +end subroutine - scalar_field_idx_grid_ny = 0 - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=value, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) then - read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny - if (iostat /= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ScalarFieldIdxGridNY not an integer: "//trim(value), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - write(logmsg,*) scalar_field_idx_grid_ny - call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif +!=============================================================================== - call NUOPC_CompAttributeAdd(gcomp, & - attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - end subroutine - - !=============================================================================== - - !> Called by NUOPC to advertise import and export fields. "Advertise" - !! simply means that the standard names of all import and export - !! fields are supplied. The NUOPC layer uses these to match fields - !! between components in the coupled system. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - type(ESMF_VM) :: vm - type(ESMF_Time) :: MyTime - type(ESMF_TimeInterval) :: TINT - type (ocean_public_type), pointer :: ocean_public => NULL() - type (ocean_state_type), pointer :: ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - type(ocean_grid_type), pointer :: ocean_grid => NULL() - type(time_type) :: Run_len ! length of experiment - type(time_type) :: Time - type(time_type) :: Time_restart - type(time_type) :: DT - integer :: DT_OCEAN - integer :: isc,iec,jsc,jec - integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 - integer :: mpi_comm_mom - integer :: i,n - character(len=256) :: stdname, shortname - character(len=32) :: starttype ! model start type - character(len=512) :: diro - character(len=512) :: logfile - character(ESMF_MAXSTR) :: cvalue - logical :: isPresent, isPresentDiro, isPresentLogfile, isSet - logical :: existflag - integer :: userRc - character(len=512) :: restartfile ! Path/Name of restart file - character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' +!> Called by NUOPC to advertise import and export fields. "Advertise" +!! simply means that the standard names of all import and export +!! fields are supplied. The NUOPC layer uses these to match fields +!! between components in the coupled system. +!! +!! @param gcomp an ESMF_GridComp object +!! @param importState an ESMF_State object for import fields +!! @param exportState an ESMF_State object for export fields +!! @param clock an ESMF_Clock object +!! @param rc return code +subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + type(ESMF_VM) :: vm + type(ESMF_Time) :: MyTime + type(ESMF_TimeInterval) :: TINT + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + type(ocean_grid_type), pointer :: ocean_grid => NULL() + type(time_type) :: Run_len ! length of experiment + type(time_type) :: Time + type(time_type) :: Time_restart + type(time_type) :: DT + integer :: DT_OCEAN + integer :: isc,iec,jsc,jec + integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 + integer :: mpi_comm_mom + integer :: i,n + character(len=256) :: stdname, shortname + character(len=32) :: starttype ! model start type + character(len=512) :: diro + character(len=512) :: logfile + character(ESMF_MAXSTR) :: cvalue + logical :: isPresent, isPresentDiro, isPresentLogfile, isSet + logical :: existflag + integer :: userRc + character(len=512) :: restartfile ! Path/Name of restart file + character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' !-------------------------------- - rc = ESMF_SUCCESS + rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' enter', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - allocate(Ice_ocean_boundary) - !allocate(ocean_state) ! ocean_model_init allocate this pointer - allocate(ocean_public) - allocate(ocean_internalstate%ptr) - ocean_internalstate%ptr%ice_ocean_boundary_type_ptr => Ice_ocean_boundary - ocean_internalstate%ptr%ocean_public_type_ptr => ocean_public - ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state - - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeGet (MyTime, YY=YEAR, MM=MONTH, DD=DAY, H=HOUR, M=MINUTE, S=SECOND, RC=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call fms_init(mpi_comm_mom) - call constants_init - call field_manager_init - call set_calendar_type (JULIAN) - call diag_manager_init - - ! this ocean connector will be driven at set interval - DT = set_time (DT_OCEAN, 0) - Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) - - ! rsd need to figure out how to get this without share code - !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - !inst_name = "OCN"//trim(inst_suffix) - - ! reset shr logging to my log file - if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & - isPresent=isPresentDiro, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, & - isPresent=isPresentLogfile, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresentDiro .and. isPresentLogfile) then - open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - else - logunit = output_unit - endif - else - logunit = output_unit - endif - - starttype = "" - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) then - read(cvalue,*) starttype - else - call ESMF_LogWrite('mom_cap:start_type unset - using input.nml for restart option', & - ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif - - runtype = "" - if (trim(starttype) == trim('startup')) then - runtype = "initial" - else if (trim(starttype) == trim('continue') ) then - runtype = "continue" - else if (trim(starttype) == trim('branch')) then - runtype = "continue" - else if (len_trim(starttype) > 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": unknown starttype - "//trim(starttype), & - line=__LINE__, file=__FILE__, rcToReturn=rc) + call ESMF_LogWrite(subname//' enter', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & return - endif - if (len_trim(runtype) > 0) then - call ESMF_LogWrite('mom_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif - - restartfile = "" - if (runtype == "initial") then - ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml - restartfile = "n" - else if (runtype == "continue") then ! hybrid or branch or continuos runs - - ! optionally call into system-specific implementation to get restart file name - call ESMF_MethodExecute(gcomp, label="GetRestartFileToRead", & - existflag=existflag, userRc=userRc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (existflag) then - call ESMF_LogWrite('mom_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif - - call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & - value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) then - restartfile = trim(cvalue) - call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - else - call ESMF_LogWrite('mom_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',& - ESMF_LOGMSG_WARNING, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif - - end if - - ocean_public%is_ocean_pe = .true. - if (len_trim(restartfile) > 0) then - call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file=trim(restartfile)) - else - call ocean_model_init(ocean_public, ocean_state, Time, Time) - endif - - call ocean_model_init_sfc(ocean_state, ocean_public) - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - - allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% mi (isc:iec,jsc:jec), & - Ice_ocean_boundary% p (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec)) - - Ice_ocean_boundary%u_flux = 0.0 - Ice_ocean_boundary%v_flux = 0.0 - Ice_ocean_boundary%t_flux = 0.0 - Ice_ocean_boundary%q_flux = 0.0 - Ice_ocean_boundary%salt_flux = 0.0 - Ice_ocean_boundary%lw_flux = 0.0 - Ice_ocean_boundary%sw_flux_vis_dir = 0.0 - Ice_ocean_boundary%sw_flux_vis_dif = 0.0 - Ice_ocean_boundary%sw_flux_nir_dir = 0.0 - Ice_ocean_boundary%sw_flux_nir_dif = 0.0 - Ice_ocean_boundary%lprec = 0.0 - Ice_ocean_boundary%fprec = 0.0 - Ice_ocean_boundary%mi = 0.0 - Ice_ocean_boundary%p = 0.0 - Ice_ocean_boundary%runoff = 0.0 - Ice_ocean_boundary%calving = 0.0 - Ice_ocean_boundary%runoff_hflx = 0.0 - Ice_ocean_boundary%calving_hflx = 0.0 - Ice_ocean_boundary%rofl_flux = 0.0 - Ice_ocean_boundary%rofi_flux = 0.0 - - ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state - call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) + allocate(Ice_ocean_boundary) + !allocate(ocean_state) ! ocean_model_init allocate this pointer + allocate(ocean_public) + allocate(ocean_internalstate%ptr) + ocean_internalstate%ptr%ice_ocean_boundary_type_ptr => Ice_ocean_boundary + ocean_internalstate%ptr%ocean_public_type_ptr => ocean_public + ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, RC=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimeGet (MyTime, YY=YEAR, MM=MONTH, DD=DAY, H=HOUR, M=MINUTE, S=SECOND, RC=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call fms_init(mpi_comm_mom) + call constants_init + call field_manager_init + call set_calendar_type (JULIAN) + call diag_manager_init + + ! this ocean connector will be driven at set interval + DT = set_time (DT_OCEAN, 0) + Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) + + ! rsd need to figure out how to get this without share code + !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) + !inst_name = "OCN"//trim(inst_suffix) + + ! reset shr logging to my log file + if (is_root_pe()) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + isPresent=isPresentDiro, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, & + isPresent=isPresentLogfile, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresentDiro .and. isPresentLogfile) then + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + else + logunit = output_unit + endif + else + logunit = output_unit + endif + + starttype = "" + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(cvalue,*) starttype + else + call ESMF_LogWrite('mom_cap:start_type unset - using input.nml for restart option', & + ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + runtype = "" + if (trim(starttype) == trim('startup')) then + runtype = "initial" + else if (trim(starttype) == trim('continue') ) then + runtype = "continue" + else if (trim(starttype) == trim('branch')) then + runtype = "continue" + else if (len_trim(starttype) > 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": unknown starttype - "//trim(starttype), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + if (len_trim(runtype) > 0) then + call ESMF_LogWrite('mom_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + restartfile = "" + if (runtype == "initial") then + ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml + restartfile = "n" + else if (runtype == "continue") then ! hybrid or branch or continuos runs + + ! optionally call into system-specific implementation to get restart file name + call ESMF_MethodExecute(gcomp, label="GetRestartFileToRead", & + existflag=existflag, userRc=userRc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (existflag) then + call ESMF_LogWrite('mom_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & + value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + restartfile = trim(cvalue) + call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + else + call ESMF_LogWrite('mom_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',& + ESMF_LOGMSG_WARNING, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + end if + + ocean_public%is_ocean_pe = .true. + if (len_trim(restartfile) > 0) then + call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file=trim(restartfile)) + else + call ocean_model_init(ocean_public, ocean_state, Time, Time) + endif + + call ocean_model_init_sfc(ocean_state, ocean_public) + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + + allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% mi (isc:iec,jsc:jec), & + Ice_ocean_boundary% p (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec)) + + Ice_ocean_boundary%u_flux = 0.0 + Ice_ocean_boundary%v_flux = 0.0 + Ice_ocean_boundary%t_flux = 0.0 + Ice_ocean_boundary%q_flux = 0.0 + Ice_ocean_boundary%salt_flux = 0.0 + Ice_ocean_boundary%lw_flux = 0.0 + Ice_ocean_boundary%sw_flux_vis_dir = 0.0 + Ice_ocean_boundary%sw_flux_vis_dif = 0.0 + Ice_ocean_boundary%sw_flux_nir_dir = 0.0 + Ice_ocean_boundary%sw_flux_nir_dif = 0.0 + Ice_ocean_boundary%lprec = 0.0 + Ice_ocean_boundary%fprec = 0.0 + Ice_ocean_boundary%mi = 0.0 + Ice_ocean_boundary%p = 0.0 + Ice_ocean_boundary%runoff = 0.0 + Ice_ocean_boundary%calving = 0.0 + Ice_ocean_boundary%runoff_hflx = 0.0 + Ice_ocean_boundary%calving_hflx = 0.0 + Ice_ocean_boundary%rofl_flux = 0.0 + Ice_ocean_boundary%rofi_flux = 0.0 + + ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state + call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (cesm_coupled) then + if (len_trim(scalar_field_name) > 0) then + call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") + endif + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") + else + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") + end if + + !--------- import fields ------------- + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide") ! from ice + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff + !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_water" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_heat" , "will provide") + + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") + + !--------- export fields ------------- + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") + + do n = 1,fldsToOcn_num + call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + enddo - if (cesm_coupled) then - if (len_trim(scalar_field_name) > 0) then - call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") - endif - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") - else - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") - end if - - !--------- import fields ------------- - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide") ! from ice - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff - !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_water" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_heat" , "will provide") - - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") - - !--------- export fields ------------- - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") - - do n = 1,fldsToOcn_num - call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - enddo - - do n = 1,fldsFrOcn_num - call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, name=fldsFrOcn(n)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - enddo - - end subroutine InitializeAdvertise - -!=============================================================================== - !> Called by NUOPC to realize import and export fields. "Realizing" a field - !! means that its grid has been defined and an ESMF_Field object has been - !! created and put into the import or export State. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - - subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! Local Variables - type(ESMF_VM) :: vm - type(ESMF_Grid) :: gridIn, gridOut - type(ESMF_Mesh) :: Emesh, EmeshTemp - type(ESMF_DeLayout) :: delayout - type(ESMF_Distgrid) :: Distgrid - type(ESMF_DistGridConnection), allocatable :: connectionList(:) - type(ESMF_StateItem_Flag) :: itemFlag - type (ocean_public_type), pointer :: ocean_public => NULL() - type (ocean_state_type), pointer :: ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_grid_type) , pointer :: ocean_grid - type(ocean_internalstate_wrapper) :: ocean_internalstate - integer :: npet, ntiles - integer :: nxg, nyg, cnt - integer :: isc,iec,jsc,jec - integer, allocatable :: xb(:),xe(:),yb(:),ye(:),pe(:) - integer, allocatable :: deBlockList(:,:,:) - integer, allocatable :: petMap(:) - integer, allocatable :: deLabelList(:) - integer, allocatable :: indexList(:) - integer :: ioff, joff - integer :: i, j, n, i1, j1, n1, jlast - integer :: lbnd1,ubnd1,lbnd2,ubnd2 - integer :: lbnd3,ubnd3,lbnd4,ubnd4 - integer :: nblocks_tot - logical :: found - integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) - integer :: mpicom - integer :: localPet - integer :: lsize - integer :: ig,jg, ni,nj,k - integer, allocatable :: gindex(:) ! global index space - character(len=128) :: fldname - character(len=256) :: cvalue - character(len=*), parameter :: subname='(mom_cap:InitializeRealize)' - !-------------------------------- - - rc = ESMF_SUCCESS - - call shr_file_setLogUnit (logunit) - - !---------------------------------------------------------------------------- - ! Get pointers to ocean internal state - !---------------------------------------------------------------------------- - - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + do n = 1,fldsFrOcn_num + call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, name=fldsFrOcn(n)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + enddo - Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr +end subroutine InitializeAdvertise - !---------------------------------------------------------------------------- - ! Get mpi information - !---------------------------------------------------------------------------- - - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_VMGet(vm, petCount=npet, mpiCommunicator=mpicom, localPet=localPet, rc=rc) +!=============================================================================== +!> Called by NUOPC to realize import and export fields. "Realizing" a field +!! means that its grid has been defined and an ESMF_Field object has been +!! created and put into the import or export State. +!! +!! @param gcomp an ESMF_GridComp object +!! @param importState an ESMF_State object for import fields +!! @param exportState an ESMF_State object for export fields +!! @param clock an ESMF_Clock object +!! @param rc return code + +subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local Variables + type(ESMF_VM) :: vm + type(ESMF_Grid) :: gridIn, gridOut + type(ESMF_Mesh) :: Emesh, EmeshTemp + type(ESMF_DeLayout) :: delayout + type(ESMF_Distgrid) :: Distgrid + type(ESMF_DistGridConnection), allocatable :: connectionList(:) + type(ESMF_StateItem_Flag) :: itemFlag + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_grid_type) , pointer :: ocean_grid + type(ocean_internalstate_wrapper) :: ocean_internalstate + integer :: npet, ntiles + integer :: nxg, nyg, cnt + integer :: isc,iec,jsc,jec + integer, allocatable :: xb(:),xe(:),yb(:),ye(:),pe(:) + integer, allocatable :: deBlockList(:,:,:) + integer, allocatable :: petMap(:) + integer, allocatable :: deLabelList(:) + integer, allocatable :: indexList(:) + integer :: ioff, joff + integer :: i, j, n, i1, j1, n1, jlast + integer :: lbnd1,ubnd1,lbnd2,ubnd2 + integer :: lbnd3,ubnd3,lbnd4,ubnd4 + integer :: nblocks_tot + logical :: found + integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) + integer :: mpicom + integer :: localPet + integer :: lsize + integer :: ig,jg, ni,nj,k + integer, allocatable :: gindex(:) ! global index space + character(len=128) :: fldname + character(len=256) :: cvalue + character(len=*), parameter :: subname='(mom_cap:InitializeRealize)' + !-------------------------------- + + rc = ESMF_SUCCESS + + call shr_file_setLogUnit (logunit) + + !---------------------------------------------------------------------------- + ! Get pointers to ocean internal state + !---------------------------------------------------------------------------- + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + !---------------------------------------------------------------------------- + ! Get mpi information + !---------------------------------------------------------------------------- + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(vm, petCount=npet, mpiCommunicator=mpicom, localPet=localPet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !--------------------------------- + ! global mom grid size + !--------------------------------- + + call mpp_get_global_domain(ocean_public%domain, xsize=nxg, ysize=nyg) + write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !--------------------------------- + ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total + !--------------------------------- + + ntiles=mpp_get_ntile_count(ocean_public%domain) ! this is tiles on this pe + if (ntiles /= 1) then + rc = ESMF_FAILURE + call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !--------------------------------- - ! global mom grid size - !--------------------------------- + line=__LINE__, & + file=__FILE__)) & + return + endif + ntiles=mpp_get_domain_npes(ocean_public%domain) + write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - call mpp_get_global_domain(ocean_public%domain, xsize=nxg, ysize=nyg) - write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !--------------------------------- - ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total - !--------------------------------- - - ntiles=mpp_get_ntile_count(ocean_public%domain) ! this is tiles on this pe - if (ntiles /= 1) then - rc = ESMF_FAILURE - call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif - ntiles=mpp_get_domain_npes(ocean_public%domain) - write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - !--------------------------------- - ! get start and end indices of each tile and their PET - !--------------------------------- - - allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) - call mpp_get_compute_domains(ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) - call mpp_get_pelist(ocean_public%domain, pe) - if (debug > 0) then - do n = 1,ntiles - write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - enddo - end if - - !--------------------------------- - ! Create either a grid or a mesh - !--------------------------------- - - !Get the ocean grid and sizes of global and computational domains - call get_ocean_grid(ocean_state, ocean_grid) - - if (geomtype == ESMF_GEOMTYPE_MESH) then - - !--------------------------------- - ! Create a MOM6 mesh - !--------------------------------- - - call get_global_grid_size(ocean_grid, ni, nj) - lsize = ( ocean_grid%iec - ocean_grid%isc + 1 ) * ( ocean_grid%jec - ocean_grid%jsc + 1 ) - - ! Create the global index space for the computational domain - allocate(gindex(lsize)) - k = 0 - do j = ocean_grid%jsc, ocean_grid%jec - jg = j + ocean_grid%jdg_offset - do i = ocean_grid%isc, ocean_grid%iec - ig = i + ocean_grid%idg_offset - k = k + 1 ! Increment position within gindex - gindex(k) = ni * (jg - 1) + ig - enddo - enddo - - DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - ! read in the mesh - call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (localPet == 0) then - write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) - end if - - ! recreate the mesh using the above distGrid - EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - ! realize the import and export fields using the mesh - call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", mesh=Emesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", mesh=Emesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - else if (geomtype == ESMF_GEOMTYPE_GRID) then - - !--------------------------------- - ! create a MOM6 grid - !--------------------------------- - - ! generate delayout and dist_grid - - allocate(deBlockList(2,2,ntiles)) - allocate(petMap(ntiles)) - allocate(deLabelList(ntiles)) - - do n = 1, ntiles - deLabelList(n) = n - deBlockList(1,1,n) = xb(n) - deBlockList(1,2,n) = xe(n) - deBlockList(2,1,n) = yb(n) - deBlockList(2,2,n) = ye(n) - petMap(n) = pe(n) - ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side - enddo - - delayout = ESMF_DELayoutCreate(petMap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! rsd this assumes tripole grid, but sometimes in CESM a bipole - ! grid is used -- need to introduce conditional logic here - - allocate(connectionList(2)) - - ! bipolar boundary condition at top row: nyg - call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & - orientationVector=(/-1, -2/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! periodic boundary condition along first dimension - call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & - ! indexflag = ESMF_INDEX_DELOCAL, & - deBlockList=deBlockList, & - ! deLabelList=deLabelList, & - delayout=delayout, & - connectionList=connectionList, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - deallocate(xb,xe,yb,ye,pe) - deallocate(connectionList) - deallocate(deLabelList) - deallocate(deBlockList) - deallocate(petMap) - - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(indexList(cnt)) - write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& - indexList(1),indexList(cnt),minval(indexList), maxval(indexList) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - deallocate(IndexList) - - ! create grid - - gridIn = ESMF_GridCreate(distgrid=distgrid, & - gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & - coordSys = ESMF_COORDSYS_SPH_DEG, & - rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Attach area to the Grid optionally. By default the cell areas are computed. - if(grid_attach_area) then - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_xcen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_ycen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_xcor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_ycor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_mask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if(grid_attach_area) then - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_area, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - ! load up area, mask, center and corner values - ! area, mask, and centers should be same size in mom and esmf grid - ! corner points may not be, need to offset corner points by 1 in i and j - ! retrieve these values directly from ocean_grid, which contains halo - ! values for j=0 and wrap-around in i. on tripole seam, decomposition - ! domains are 1 larger in j; to load corner values need to loop one extra row - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - - lbnd1 = lbound(dataPtr_mask,1) - ubnd1 = ubound(dataPtr_mask,1) - lbnd2 = lbound(dataPtr_mask,2) - ubnd2 = ubound(dataPtr_mask,2) - - lbnd3 = lbound(dataPtr_xcor,1) - ubnd3 = ubound(dataPtr_xcor,1) - lbnd4 = lbound(dataPtr_xcor,2) - ubnd4 = ubound(dataPtr_xcor,2) - - write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": fld and grid do not have the same size.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + ocean_grid%isc - isc - dataPtr_mask(i1,j1) = ocean_grid%mask2dT(ig,jg) - dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) - dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) - if(grid_attach_area) then - dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) - end if - end do + !--------------------------------- + ! get start and end indices of each tile and their PET + !--------------------------------- + + allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) + call mpp_get_compute_domains(ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) + call mpp_get_pelist(ocean_public%domain, pe) + if (debug > 0) then + do n = 1,ntiles + write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + enddo + end if + + !--------------------------------- + ! Create either a grid or a mesh + !--------------------------------- + + !Get the ocean grid and sizes of global and computational domains + call get_ocean_grid(ocean_state, ocean_grid) + + if (geomtype == ESMF_GEOMTYPE_MESH) then + + !--------------------------------- + ! Create a MOM6 mesh + !--------------------------------- + + call get_global_grid_size(ocean_grid, ni, nj) + lsize = ( ocean_grid%iec - ocean_grid%isc + 1 ) * ( ocean_grid%jec - ocean_grid%jsc + 1 ) + + ! Create the global index space for the computational domain + allocate(gindex(lsize)) + k = 0 + do j = ocean_grid%jsc, ocean_grid%jec + jg = j + ocean_grid%jdg_offset + do i = ocean_grid%isc, ocean_grid%iec + ig = i + ocean_grid%idg_offset + k = k + 1 ! Increment position within gindex + gindex(k) = ni * (jg - 1) + ig + enddo + enddo + + DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + ! read in the mesh + call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (localPet == 0) then + write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) + end if + + ! recreate the mesh using the above distGrid + EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + ! realize the import and export fields using the mesh + call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", mesh=Emesh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", mesh=Emesh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + else if (geomtype == ESMF_GEOMTYPE_GRID) then + + !--------------------------------- + ! create a MOM6 grid + !--------------------------------- + + ! generate delayout and dist_grid + + allocate(deBlockList(2,2,ntiles)) + allocate(petMap(ntiles)) + allocate(deLabelList(ntiles)) + + do n = 1, ntiles + deLabelList(n) = n + deBlockList(1,1,n) = xb(n) + deBlockList(1,2,n) = xe(n) + deBlockList(2,1,n) = yb(n) + deBlockList(2,2,n) = ye(n) + petMap(n) = pe(n) + ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side + enddo + + delayout = ESMF_DELayoutCreate(petMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! rsd this assumes tripole grid, but sometimes in CESM a bipole + ! grid is used -- need to introduce conditional logic here + + allocate(connectionList(2)) + + ! bipolar boundary condition at top row: nyg + call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & + orientationVector=(/-1, -2/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! periodic boundary condition along first dimension + call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & + ! indexflag = ESMF_INDEX_DELOCAL, & + deBlockList=deBlockList, & + ! deLabelList=deLabelList, & + delayout=delayout, & + connectionList=connectionList, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(xb,xe,yb,ye,pe) + deallocate(connectionList) + deallocate(deLabelList) + deallocate(deBlockList) + deallocate(petMap) + + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + allocate(indexList(cnt)) + write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& + indexList(1),indexList(cnt),minval(indexList), maxval(indexList) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + deallocate(IndexList) + + ! create grid + + gridIn = ESMF_GridCreate(distgrid=distgrid, & + gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & + coordSys = ESMF_COORDSYS_SPH_DEG, & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Attach area to the Grid optionally. By default the cell areas are computed. + if(grid_attach_area) then + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_xcen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_ycen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_xcor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_ycor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_mask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if(grid_attach_area) then + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_area, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + ! load up area, mask, center and corner values + ! area, mask, and centers should be same size in mom and esmf grid + ! corner points may not be, need to offset corner points by 1 in i and j + ! retrieve these values directly from ocean_grid, which contains halo + ! values for j=0 and wrap-around in i. on tripole seam, decomposition + ! domains are 1 larger in j; to load corner values need to loop one extra row + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + + lbnd1 = lbound(dataPtr_mask,1) + ubnd1 = ubound(dataPtr_mask,1) + lbnd2 = lbound(dataPtr_mask,2) + ubnd2 = ubound(dataPtr_mask,2) + + lbnd3 = lbound(dataPtr_xcor,1) + ubnd3 = ubound(dataPtr_xcor,1) + lbnd4 = lbound(dataPtr_xcor,2) + ubnd4 = ubound(dataPtr_xcor,2) + + write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": fld and grid do not have the same size.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + dataPtr_mask(i1,j1) = ocean_grid%mask2dT(ig,jg) + dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) + dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) + if(grid_attach_area) then + dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) + end if end do - - jlast = jec - if(jec == nyg)jlast = jec+1 - - do j = jsc, jlast - j1 = j + lbnd4 - jsc - jg = j + ocean_grid%jsc - jsc - 1 - do i = isc, iec - i1 = i + lbnd3 - isc - ig = i + ocean_grid%isc - isc - 1 - dataPtr_xcor(i1,j1) = ocean_grid%geolonBu(ig,jg) - dataPtr_ycor(i1,j1) = ocean_grid%geolatBu(ig,jg) - end do + end do + + jlast = jec + if(jec == nyg)jlast = jec+1 + + do j = jsc, jlast + j1 = j + lbnd4 - jsc + jg = j + ocean_grid%jsc - jsc - 1 + do i = isc, iec + i1 = i + lbnd3 - isc + ig = i + ocean_grid%isc - isc - 1 + dataPtr_xcor(i1,j1) = ocean_grid%geolonBu(ig,jg) + dataPtr_ycor(i1,j1) = ocean_grid%geolatBu(ig,jg) end do + end do + + write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + if(grid_attach_area) then + write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + endif + + write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + gridOut = gridIn ! for now out same as in + + call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", grid=gridIn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", grid=gridOut, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end if + + !--------------------------------- + ! set scalar data in export state + !--------------------------------- + + if (len_trim(scalar_field_name) > 0) then + call State_SetScalar(dble(nxg),scalar_field_idx_grid_nx, exportState, localPet, & + scalar_field_name, scalar_field_count, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & + scalar_field_name, scalar_field_count, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + !--------------------------------- + ! Set module variable geomtype in mom_cap_methods + !--------------------------------- + call mom_set_geomtype(geomtype) + + !--------------------------------- + ! write out diagnostics + !--------------------------------- + + !call NUOPC_Write(exportState, fileNamePrefix='post_realize_field_ocn_export_', & + ! timeslice=1, relaxedFlag=.true., rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + +end subroutine InitializeRealize - write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - if(grid_attach_area) then - write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - endif - - write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - gridOut = gridIn ! for now out same as in - - call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", grid=gridIn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", grid=gridOut, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end if - - !--------------------------------- - ! set scalar data in export state - !--------------------------------- - - if (len_trim(scalar_field_name) > 0) then - call State_SetScalar(dble(nxg),scalar_field_idx_grid_nx, exportState, localPet, & - scalar_field_name, scalar_field_count, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & - scalar_field_name, scalar_field_count, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - !--------------------------------- - ! Set module variable geomtype in mom_cap_methods - !--------------------------------- - call mom_set_geomtype(geomtype) - - !--------------------------------- - ! write out diagnostics - !--------------------------------- - - !call NUOPC_Write(exportState, fileNamePrefix='post_realize_field_ocn_export_', & - ! timeslice=1, relaxedFlag=.true., rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - - end subroutine InitializeRealize - - !=============================================================================== - - subroutine DataInitialize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc +!=============================================================================== - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: importState, exportState - type (ocean_public_type), pointer :: ocean_public => NULL() - type (ocean_state_type), pointer :: ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - type(ocean_grid_type), pointer :: ocean_grid - character(240) :: msgString - integer :: fieldCount, n - type(ESMF_Field) :: field - character(len=64),allocatable :: fieldNameList(:) - character(len=*),parameter :: subname='(mom_cap:DataInitialize)' - !-------------------------------- - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) +subroutine DataInitialize(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_State) :: importState, exportState + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + type(ocean_grid_type), pointer :: ocean_grid + character(240) :: msgString + integer :: fieldCount, n + type(ESMF_Field) :: field + character(len=64),allocatable :: fieldNameList(:) + character(len=*),parameter :: subname='(mom_cap:DataInitialize)' + !-------------------------------- + + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + call get_ocean_grid(ocean_state, ocean_grid) + + if (cesm_coupled) then + call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + do n=1, fieldCount + call ESMF_StateGet(exportState, itemName=fieldNameList(n), field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + end do + deallocate(fieldNameList) - Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - call get_ocean_grid(ocean_state, ocean_grid) + ! check whether all Fields in the exportState are "Updated" + if (NUOPC_IsUpdated(exportState)) then + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) - if (cesm_coupled) then - call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if - - call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) + call ESMF_LogWrite("MOM6 - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + end if - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) + if(write_diagnostics) then + call NUOPC_Write(exportState, fileNamePrefix='field_init_ocn_export_', & + timeslice=import_slice, relaxedFlag=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + endif - do n=1, fieldCount - call ESMF_StateGet(exportState, itemName=fieldNameList(n), field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end do - deallocate(fieldNameList) - - ! check whether all Fields in the exportState are "Updated" - if (NUOPC_IsUpdated(exportState)) then - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) - - call ESMF_LogWrite("MOM6 - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if - - if(write_diagnostics) then - call NUOPC_Write(exportState, fileNamePrefix='field_init_ocn_export_', & - timeslice=import_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - end subroutine DataInitialize - - !=============================================================================== - - !> Called by NUOPC to advance the model a single timestep. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine ModelAdvance(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc +end subroutine DataInitialize - ! local variables - integer :: userRc - logical :: existflag, isPresent, isSet - type(ESMF_Clock) :: clock - type(ESMF_Alarm) :: alarm - type(ESMF_State) :: importState, exportState - type(ESMF_Time) :: currTime - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Time) :: startTime - type(ESMF_TimeInterval) :: time_elapsed - integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec - character(len=64) :: timestamp - type (ocean_public_type), pointer :: ocean_public => NULL() - type (ocean_state_type), pointer :: ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - type(ocean_grid_type) , pointer :: ocean_grid - type(time_type) :: Time - type(time_type) :: Time_step_coupled - type(time_type) :: Time_restart_current - integer :: dth, dtm, dts - integer :: nc - type(ESMF_Time) :: MyTime - integer :: seconds, day, year, month, hour, minute - character(ESMF_MAXSTR) :: restartname, cvalue - character(240) :: msgString - character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' - !-------------------------------- - - rc = ESMF_SUCCESS - if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") - - call shr_file_setLogUnit (logunit) - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +!=============================================================================== - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) +!> Called by NUOPC to advance the model a single timestep. +!! +!! @param gcomp an ESMF_GridComp object +!! @param rc return code +subroutine ModelAdvance(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: userRc + logical :: existflag, isPresent, isSet + type(ESMF_Clock) :: clock + type(ESMF_Alarm) :: alarm + type(ESMF_State) :: importState, exportState + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_TimeInterval) :: time_elapsed + integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec + character(len=64) :: timestamp + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + type(ocean_grid_type) , pointer :: ocean_grid + type(time_type) :: Time + type(time_type) :: Time_step_coupled + type(time_type) :: Time_restart_current + integer :: dth, dtm, dts + integer :: nc + type(ESMF_Time) :: MyTime + integer :: seconds, day, year, month, hour, minute + character(ESMF_MAXSTR) :: restartname, cvalue + character(240) :: msgString + character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' + !-------------------------------- + + rc = ESMF_SUCCESS + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") + + call shr_file_setLogUnit (logunit) + + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & + exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep + + call ESMF_ClockPrint(clock, options="currTime", & + preString="------>Advancing OCN from: ", unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(subname//trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & + timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimePrint(currTime + timeStep, & + preString="--------------------------------> to: ", & + unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Time = esmf2fms_time(currTime) + Time_step_coupled = esmf2fms_time(timeStep) + + !--------------- + ! Write diagnostics for import + !--------------- + + if(write_diagnostics) then + call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & + timeslice=import_slice, relaxedFlag=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + import_slice = import_slice + 1 + endif + + !--------------- + ! Get ocean grid + !--------------- + + call get_ocean_grid(ocean_state, ocean_grid) + + !--------------- + ! Import data + !--------------- + + call shr_file_setLogUnit (logunit) + + if (cesm_coupled) then + call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) + else + call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) + end if + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !--------------- + ! Update MOM6 + !--------------- + + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") + call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") + + !--------------- + ! Export Data + !--------------- + + call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call shr_file_setLogUnit (logunit) + + !--------------- + ! If restart alarm is ringing - write restart file + !--------------- + + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_AlarmRingerOff(alarm, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! call into system specific method to get desired restart filename + restartname = "" + call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & + existflag=existflag, userRc=userRc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (existflag) then + call ESMF_LogWrite("mom_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToWrite', & + isPresent=isPresent, isSet=isSet, value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + restartname = trim(cvalue) + call ESMF_LogWrite("mom_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + endif + + if (len_trim(restartname) == 0) then + ! none provided, so use a default restart filename + call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, & + h=hour, m=minute, s=seconds, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + "ocn", year, month, day, hour, minute, seconds + call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + ! TODO: address if this requirement is being met for the DA group + ! Optionally write restart files when currTime-startTime is integer multiples of restart_interval + ! if (restart_interval > 0 ) then + ! time_elapsed = currTime - startTime + ! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! n_interval = time_elapsed_sec / restart_interval + ! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then + ! time_restart_current = esmf2fms_time(currTime) + ! timestamp = date_to_string(time_restart_current) + ! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) + ! write(*,*) 'calling ocean_model_restart' + ! call ocean_model_restart(ocean_state, timestamp) + ! endif + ! endif + + ! write restart file(s) + call ocean_model_restart(ocean_state, restartname=restartname) + + if (is_root_pe()) then + write(logunit,*) subname//' writing restart file ',trim(restartname) + end if + endif + + !--------------- + ! Write diagnostics + !--------------- + + if (write_diagnostics) then + call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & + timeslice=export_slice, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + export_slice = export_slice + 1 + endif + + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") + +end subroutine ModelAdvance - Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - - ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep - - call ESMF_ClockPrint(clock, options="currTime", & - preString="------>Advancing OCN from: ", unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite(subname//trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +!=============================================================================== - call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & - timeStep=timeStep, rc=rc) +subroutine ModelSetRunClock(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: mclock, dclock + type(ESMF_Time) :: mcurrtime, dcurrtime + type(ESMF_Time) :: mstoptime + type(ESMF_TimeInterval) :: mtimestep, dtimestep + character(len=128) :: mtimestring, dtimestring + character(len=256) :: cvalue + character(len=256) :: restart_option ! Restart option units + integer :: restart_n ! Number until restart interval + integer :: restart_ymd ! Restart date (YYYYMMDD) + type(ESMF_ALARM) :: restart_alarm + logical :: isPresent, isSet + logical :: first_time = .true. + character(len=*),parameter :: subname='mom_cap:(ModelSetRunClock) ' + !-------------------------------- + + rc = ESMF_SUCCESS + + ! query the Component for its clock, importState and exportState + call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !-------------------------------- + ! check that the current time in the model and driver are the same + !-------------------------------- + + if (mcurrtime /= dcurrtime) then + call ESMF_TimeGet(dcurrtime, timeString=dtimestring, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call ESMF_TimePrint(currTime + timeStep, & - preString="--------------------------------> to: ", & - unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_TimeGet(mcurrtime, timeString=mtimestring, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - Time = esmf2fms_time(currTime) - Time_step_coupled = esmf2fms_time(timeStep) - - !--------------- - ! Write diagnostics for import - !--------------- - - if(write_diagnostics) then - call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & - timeslice=import_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - import_slice = import_slice + 1 - endif - - !--------------- - ! Get ocean grid - !--------------- - - call get_ocean_grid(ocean_state, ocean_grid) + call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & + msg=subname//": ERROR in time consistency: "//trim(dtimestring)//" != "//trim(mtimestring), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + !-------------------------------- + ! force model clock currtime and timestep to match driver and set stoptime + !-------------------------------- + + mstoptime = mcurrtime + dtimestep + + call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (first_time) then + !-------------------------------- + ! set restart alarm + !-------------------------------- + + ! defaults + restart_n = 0 + restart_ymd = 0 + + call NUOPC_CompAttributeGet(gcomp, name="restart_option", isPresent=isPresent, & + isSet=isSet, value=restart_option, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) restart_n + endif + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) restart_ymd + endif + else + restart_option = "none" + endif + + call AlarmInit(mclock, & + alarm = restart_alarm, & + option = trim(restart_option), & + opt_n = restart_n, & + opt_ymd = restart_ymd, & + RefTime = mcurrTime, & + alarmname = 'alarm_restart', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + first_time = .false. + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end if + + !-------------------------------- + ! Advance model clock to trigger alarms then reset model clock back to currtime + !-------------------------------- + + call ESMF_ClockAdvance(mclock,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +end subroutine ModelSetRunClock - !--------------- - ! Import data - !--------------- - call shr_file_setLogUnit (logunit) +!=============================================================================== - if (cesm_coupled) then - call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) - else - call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) - end if - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +!> Called by NUOPC at the end of the run to clean up. +!! +!! @param gcomp an ESMF_GridComp object +!! @param rc return code +subroutine ocean_model_finalize(gcomp, rc) + + ! input arguments + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type (ocean_public_type), pointer :: ocean_public + type (ocean_state_type), pointer :: ocean_state + type(ocean_internalstate_wrapper) :: ocean_internalstate + type(TIME_TYPE) :: Time + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + character(len=64) :: timestamp + character(len=*),parameter :: subname='(mom_cap:ocean_model_finalize)' + + write(*,*) 'MOM: --- finalize called ---' + rc = ESMF_SUCCESS + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + Time = esmf2fms_time(currTime) + + if (cesm_coupled) then + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) + else + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) + end if + call field_manager_end() + + call fms_io_exit() + call fms_end() + + write(*,*) 'MOM: --- completed ---' + +end subroutine ocean_model_finalize - !--------------- - ! Update MOM6 - !--------------- +!=============================================================================== - if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") - call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) - if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") +subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_count, rc) + ! ---------------------------------------------- + ! Set scalar data from State for a particular name + ! ---------------------------------------------- - !--------------- - ! Export Data - !--------------- + real(ESMF_KIND_R8),intent(in) :: value + integer, intent(in) :: scalar_id + type(ESMF_State), intent(inout) :: State + integer, intent(in) :: mytask + character(len=*), intent(in) :: scalar_name + integer, intent(in) :: scalar_count + integer, intent(inout) :: rc - call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! local variables + type(ESMF_Field) :: field + real(ESMF_KIND_R8), pointer :: farrayptr(:,:) + character(len=*), parameter :: subname='(mom_cap:State_SetScalar)' + !-------------------------------------------------------- - call shr_file_setLogUnit (logunit) + rc = ESMF_SUCCESS - !--------------- - ! If restart alarm is ringing - write restart file - !--------------- + call ESMF_StateGet(State, itemName=trim(scalar_name), field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_AlarmRingerOff(alarm, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! call into system specific method to get desired restart filename - restartname = "" - call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & - existflag=existflag, userRc=userRc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (existflag) then - call ESMF_LogWrite("mom_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompAttributeGet(gcomp, name='RestartFileToWrite', & - isPresent=isPresent, isSet=isSet, value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent .and. isSet) then - restartname = trim(cvalue) - call ESMF_LogWrite("mom_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - endif - - if (len_trim(restartname) == 0) then - ! none provided, so use a default restart filename - call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, & - h=hour, m=minute, s=seconds, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & - "ocn", year, month, day, hour, minute, seconds - call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - ! TODO: address if this requirement is being met for the DA group - ! Optionally write restart files when currTime-startTime is integer multiples of restart_interval - ! if (restart_interval > 0 ) then - ! time_elapsed = currTime - startTime - ! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! n_interval = time_elapsed_sec / restart_interval - ! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then - ! time_restart_current = esmf2fms_time(currTime) - ! timestamp = date_to_string(time_restart_current) - ! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) - ! write(*,*) 'calling ocean_model_restart' - ! call ocean_model_restart(ocean_state, timestamp) - ! endif - ! endif - - ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname) - - if (is_root_pe()) then - write(logunit,*) subname//' writing restart file ',trim(restartname) - end if - endif + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr=farrayptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - !--------------- - ! Write diagnostics - !--------------- - - if (write_diagnostics) then - call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & - timeslice=export_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - export_slice = export_slice + 1 + if (scalar_id < 0 .or. scalar_id > scalar_count) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ERROR in scalar_id", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif - if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") + farrayptr(scalar_id,1) = value + endif - end subroutine ModelAdvance +end subroutine State_SetScalar - !=============================================================================== - - subroutine ModelSetRunClock(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: mclock, dclock - type(ESMF_Time) :: mcurrtime, dcurrtime - type(ESMF_Time) :: mstoptime - type(ESMF_TimeInterval) :: mtimestep, dtimestep - character(len=128) :: mtimestring, dtimestring - character(len=256) :: cvalue - character(len=256) :: restart_option ! Restart option units - integer :: restart_n ! Number until restart interval - integer :: restart_ymd ! Restart date (YYYYMMDD) - type(ESMF_ALARM) :: restart_alarm - logical :: isPresent, isSet - logical :: first_time = .true. - character(len=*),parameter :: subname='mom_cap:(ModelSetRunClock) ' - !-------------------------------- - - rc = ESMF_SUCCESS - - ! query the Component for its clock, importState and exportState - call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +!=============================================================================== - call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: state + integer , intent(in) :: nfields + type(fld_list_type) , intent(inout) :: field_defs(:) + character(len=*) , intent(in) :: tag + type(ESMF_Grid) , intent(in), optional :: grid + type(ESMF_Mesh) , intent(in), optional :: mesh + integer , intent(inout) :: rc + + ! local variables + integer :: i + type(ESMF_Field) :: field + real(ESMF_KIND_R8), pointer :: fldptr1d(:) ! for mesh + real(ESMF_KIND_R8), pointer :: fldptr2d(:,:) ! for grid + character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' + !-------------------------------------------------------- + + rc = ESMF_SUCCESS + + do i = 1, nfields + + if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then + + if (field_defs(i)%shortname == scalar_field_name) then + + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=rc) + + call SetScalarField(field, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + else + + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=rc) + + if (present(grid)) then + + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr2d(:,:) = 0.0 + + else if (present(mesh)) then + + field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr1d(:) = 0.0 + + end if - !-------------------------------- - ! check that the current time in the model and driver are the same - !-------------------------------- + endif - if (mcurrtime /= dcurrtime) then - call ESMF_TimeGet(dcurrtime, timeString=dtimestring, rc=rc) + ! Realize connected field + call NUOPC_Realize(state, field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeGet(mcurrtime, timeString=mtimestring, rc=rc) + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + else ! field is not connected + + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=rc) + ! remove a not connected Field from State + call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & - msg=subname//": ERROR in time consistency: "//trim(dtimestring)//" != "//trim(mtimestring), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif + line=__LINE__, & + file=__FILE__)) & + return ! bail out - !-------------------------------- - ! force model clock currtime and timestep to match driver and set stoptime - !-------------------------------- - - mstoptime = mcurrtime + dtimestep - - call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (first_time) then - !-------------------------------- - ! set restart alarm - !-------------------------------- - - ! defaults - restart_n = 0 - restart_ymd = 0 - - call NUOPC_CompAttributeGet(gcomp, name="restart_option", isPresent=isPresent, & - isSet=isSet, value=restart_option, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent .and. isSet) then - read(cvalue,*) restart_n - endif - call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent .and. isSet) then - read(cvalue,*) restart_ymd - endif - else - restart_option = "none" - endif - - call AlarmInit(mclock, & - alarm = restart_alarm, & - option = trim(restart_option), & - opt_n = restart_n, & - opt_ymd = restart_ymd, & - RefTime = mcurrTime, & - alarmname = 'alarm_restart', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - first_time = .false. - - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & - ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end if - - !-------------------------------- - ! Advance model clock to trigger alarms then reset model clock back to currtime - !-------------------------------- - - call ESMF_ClockAdvance(mclock,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine ModelSetRunClock + endif + enddo - !=============================================================================== +contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !> Called by NUOPC at the end of the run to clean up. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine ocean_model_finalize(gcomp, rc) + subroutine SetScalarField(field, rc) - ! input arguments - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + ! create a field with scalar data on the root pe + type(ESMF_Field), intent(inout) :: field + integer, intent(inout) :: rc ! local variables - type (ocean_public_type), pointer :: ocean_public - type (ocean_state_type), pointer :: ocean_state - type(ocean_internalstate_wrapper) :: ocean_internalstate - type(TIME_TYPE) :: Time - type(ESMF_Clock) :: clock - type(ESMF_Time) :: currTime - character(len=64) :: timestamp - character(len=*),parameter :: subname='(mom_cap:ocean_model_finalize)' - - write(*,*) 'MOM: --- finalize called ---' + type(ESMF_Distgrid) :: distgrid + type(ESMF_Grid) :: grid + character(len=*), parameter :: subname='(mom_cap:SetScalarField)' + rc = ESMF_SUCCESS - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + ! create a DistGrid with a single index space element, which gets mapped onto DE 0. + distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) + grid = ESMF_GridCreate(distgrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + ! num of scalar values + field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - Time = esmf2fms_time(currTime) - - if (cesm_coupled) then - call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) - else - call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) - end if - call field_manager_end() - - call fms_io_exit() - call fms_end() - - write(*,*) 'MOM: --- completed ---' - - end subroutine ocean_model_finalize - -!=============================================================================== - - subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_count, rc) - ! ---------------------------------------------- - ! Set scalar data from State for a particular name - ! ---------------------------------------------- - - real(ESMF_KIND_R8),intent(in) :: value - integer, intent(in) :: scalar_id - type(ESMF_State), intent(inout) :: State - integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name - integer, intent(in) :: scalar_count - integer, intent(inout) :: rc - - ! local variables - type(ESMF_Field) :: field - real(ESMF_KIND_R8), pointer :: farrayptr(:,:) - character(len=*), parameter :: subname='(mom_cap:State_SetScalar)' - !-------------------------------------------------------- - - rc = ESMF_SUCCESS + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call ESMF_StateGet(State, itemName=trim(scalar_name), field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - if (mytask == 0) then - call ESMF_FieldGet(field, farrayPtr=farrayptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + end subroutine SetScalarField - if (scalar_id < 0 .or. scalar_id > scalar_count) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ERROR in scalar_id", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - - farrayptr(scalar_id,1) = value - endif - - end subroutine State_SetScalar +end subroutine MOM_RealizeFields !=============================================================================== - subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) - - ! input/output variables - type(ESMF_State) , intent(inout) :: state - integer , intent(in) :: nfields - type(fld_list_type) , intent(inout) :: field_defs(:) - character(len=*) , intent(in) :: tag - type(ESMF_Grid) , intent(in), optional :: grid - type(ESMF_Mesh) , intent(in), optional :: mesh - integer , intent(inout) :: rc - - ! local variables - integer :: i - type(ESMF_Field) :: field - real(ESMF_KIND_R8), pointer :: fldptr1d(:) ! for mesh - real(ESMF_KIND_R8), pointer :: fldptr2d(:,:) ! for grid - character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' - !-------------------------------------------------------- - - rc = ESMF_SUCCESS - - do i = 1, nfields - - if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then - - if (field_defs(i)%shortname == scalar_field_name) then - - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) - - call SetScalarField(field, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - else - - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) - - if (present(grid)) then - - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! initialize fldptr to zero - call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - fldptr2d(:,:) = 0.0 - - else if (present(mesh)) then - - field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! initialize fldptr to zero - call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - fldptr1d(:) = 0.0 - - end if - - endif - - ! Realize connected field - call NUOPC_Realize(state, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - else ! field is not connected - - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) - ! remove a not connected Field from State - call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - endif - - enddo - - contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine SetScalarField(field, rc) - - ! create a field with scalar data on the root pe - type(ESMF_Field), intent(inout) :: field - integer, intent(inout) :: rc - - ! local variables - type(ESMF_Distgrid) :: distgrid - type(ESMF_Grid) :: grid - character(len=*), parameter :: subname='(mom_cap:SetScalarField)' - - rc = ESMF_SUCCESS - - ! create a DistGrid with a single index space element, which gets mapped onto DE 0. - distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - grid = ESMF_GridCreate(distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! num of scalar values - field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine SetScalarField - - end subroutine MOM_RealizeFields - -!=============================================================================== - - subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) - ! ---------------------------------------------- - ! Set up a list of field information - ! ---------------------------------------------- - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname - character(len=*), intent(in) :: transferOffer - character(len=*), optional, intent(in) :: shortname - - ! local variables - integer :: rc - character(len=*), parameter :: subname='(mom_cap:fld_list_add)' - - ! fill in the new entry - num = num + 1 - if (num > fldsMax) then - call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & - msg=trim(subname)//": ERROR number of field exceeded fldsMax: "//trim(stdname), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - - fldlist(num)%stdname = trim(stdname) - if (present(shortname)) then - fldlist(num)%shortname = trim(shortname) - else - fldlist(num)%shortname = trim(stdname) - endif - fldlist(num)%transferOffer = trim(transferOffer) - - end subroutine fld_list_add +subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) + ! ---------------------------------------------- + ! Set up a list of field information + ! ---------------------------------------------- + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + character(len=*), intent(in) :: transferOffer + character(len=*), optional, intent(in) :: shortname + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(mom_cap:fld_list_add)' + + ! fill in the new entry + num = num + 1 + if (num > fldsMax) then + call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & + msg=trim(subname)//": ERROR number of field exceeded fldsMax: "//trim(stdname), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + fldlist(num)%stdname = trim(stdname) + if (present(shortname)) then + fldlist(num)%shortname = trim(shortname) + else + fldlist(num)%shortname = trim(stdname) + endif + fldlist(num)%transferOffer = trim(transferOffer) + +end subroutine fld_list_add !======================================================================= #ifndef CESMCOUPLED - subroutine shr_file_setLogUnit(nunit) - integer, intent(in) :: nunit - ! do nothing for this stub - its just here to replace - ! having cppdefs in the main program - end subroutine shr_file_setLogUnit - - subroutine shr_file_getLogUnit(nunit) - integer, intent(in) :: nunit - ! do nothing for this stub - its just here to replace - ! having cppdefs in the main program - end subroutine shr_file_getLogUnit +subroutine shr_file_setLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program +end subroutine shr_file_setLogUnit + +subroutine shr_file_getLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program +end subroutine shr_file_getLogUnit #endif end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 65360abeee..67c064194d 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,886 +1,885 @@ module mom_cap_methods - ! Cap import/export methods for both NEMS and CMEPS - - use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet - use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF, only: ESMF_State, ESMF_StateGet - use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate - use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate - use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate - use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError - use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE - use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE - use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND - use ESMF, only: ESMF_GEOMTYPE_FLAG, ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH - use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT - use ESMF, only: ESMF_TYPEKIND_R8 - use ESMF, only: operator(/=), operator(==) - use MOM_ocean_model, only: ocean_public_type, ocean_state_type - use MOM_surface_forcing, only: ice_ocean_boundary_type - use MOM_grid, only: ocean_grid_type - use MOM_domains, only: pass_var - use mpp_domains_mod, only: mpp_get_compute_domain - - ! By default make data private - implicit none - private - - ! Public member functions - public :: mom_set_geomtype - public :: mom_import - public :: mom_export - - private :: State_getImport - private :: State_setExport - - interface State_GetFldPtr - module procedure State_GetFldPtr_1d - module procedure State_GetFldPtr_2d - end interface - - integer :: import_cnt = 0 - type(ESMF_GeomType_Flag) :: geomtype +! Cap import/export methods for both NEMS and CMEPS + +use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet +use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet +use ESMF, only: ESMF_State, ESMF_StateGet +use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate +use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate +use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate +use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError +use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE +use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE +use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND +use ESMF, only: ESMF_GEOMTYPE_FLAG, ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH +use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT +use ESMF, only: ESMF_TYPEKIND_R8 +use ESMF, only: operator(/=), operator(==) +use MOM_ocean_model, only: ocean_public_type, ocean_state_type +use MOM_surface_forcing, only: ice_ocean_boundary_type +use MOM_grid, only: ocean_grid_type +use MOM_domains, only: pass_var +use mpp_domains_mod, only: mpp_get_compute_domain + +! By default make data private +implicit none; private + +! Public member functions +public :: mom_set_geomtype +public :: mom_import +public :: mom_export + +private :: State_getImport +private :: State_setExport + +interface State_GetFldPtr + module procedure State_GetFldPtr_1d + module procedure State_GetFldPtr_2d +end interface + +integer :: import_cnt = 0 +type(ESMF_GeomType_Flag) :: geomtype !=============================================================================== contains !=============================================================================== - subroutine mom_set_geomtype(geomtype_in) - ! Set module variable geomtype +subroutine mom_set_geomtype(geomtype_in) + ! Set module variable geomtype - type(ESMF_GeomType_Flag), intent(in) :: geomtype_in !< mesh or grid + type(ESMF_GeomType_Flag), intent(in) :: geomtype_in !< mesh or grid - geomtype = geomtype_in + geomtype = geomtype_in - end subroutine mom_set_geomtype +end subroutine mom_set_geomtype !=============================================================================== - !> This function has a few purposes: - !! (1) it imports surface fluxes using data from the mediator; and - !! (2) it can apply restoring in SST and SSS. - - subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype, rc) - - ! Input/output variables - type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid - type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator - type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing - character(len=*), optional , intent(in) :: runtype !< For cesm only, type of run - integer , intent(inout) :: rc - - ! Local Variables - integer :: i, j, ig, jg, n - integer :: isc, iec, jsc, jec - logical :: do_import - character(len=128) :: fldname - real(ESMF_KIND_R8), allocatable :: taux(:,:) - real(ESMF_KIND_R8), allocatable :: tauy(:,:) - character(len=*) , parameter :: subname = '(mom_import)' - - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! ------- - ! import_cnt is used to skip using the import state at the first count for cesm - ! ------- - - if (present(runtype)) then - import_cnt = import_cnt + 1 - if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then - do_import = .false. ! This will skip the first time import information is given - else - do_import = .true. - end if - else - do_import = .true. - end if - - if (do_import) then - ! The following are global indices without halos - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - - !---- - ! surface height pressure - !---- - call state_getimport(importState, 'inst_pres_height_surface', & - isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! near-IR, direct shortwave (W/m2) - !---- - call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! near-IR, diffuse shortwave (W/m2) - !---- - call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! visible, direct shortwave (W/m2) - !---- - call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! visible, diffuse shortwave (W/m2) - !---- - call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! ------- - ! Net longwave radiation (W/m2) - ! ------- - call state_getimport(importState, 'mean_net_lw_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! zonal and meridional surface stress - !---- - allocate (taux(isc:iec,jsc:jec)) - allocate (tauy(isc:iec,jsc:jec)) - - call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! rotate taux and tauy from true zonal/meridional to local coordinates - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & - - ocean_grid%sin_rot(ig,jg)*tauy(i,j) - ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & - + ocean_grid%sin_rot(ig,jg)*taux(i,j) - end do - end do - - deallocate(taux, tauy) - - !---- - ! sensible heat flux (W/m2) - !---- - call state_getimport(importState, 'mean_sensi_heat_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! evaporation flux (W/m2) - !---- - call state_getimport(importState, 'mean_evap_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! liquid precipitation (rain) - !---- - call state_getimport(importState, 'mean_prec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! frozen precipitation (snow) - !---- - call state_getimport(importState, 'mean_fprec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! runoff and heat content of runoff - !---- - ! Note - preset values to 0, if field does not exist in importState, then will simply return - ! and preset value will be used - - ! liquid runoff - ice_ocean_boundary%rofl_flux (:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'Foxx_rofl', & - isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! ice runoff - ice_ocean_boundary%rofi_flux (:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'Foxx_rofi', & - isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! total runoff - ice_ocean_boundary%runoff (:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_runoff_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! heat content of runoff - ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_runoff_heat_flux', & - isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! calving rate and heat flux - !---- - ! Note - preset values to 0, if field does not exist in importState, then will simply return - ! and preset value will be used - - ice_ocean_boundary%calving(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_calving_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_calving_heat_flux', & - isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! salt flux from ice - !---- - call state_getimport(importState, 'mean_salt_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! !---- - ! ! snow&ice melt heat flux (W/m^2) - ! !---- - ! call state_getimport(importState, 'seaice_melt_heat', & - ! isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat,rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - - ! !---- - ! ! snow&ice melt water flux (W/m^2) - ! !---- - ! call state_getimport(importState, 'seaice_melt_water', & - ! isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_water,rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - - !---- - ! mass of overlying ice - !---- - ! Note - preset values to 0, if field does not exist in importState, then will simply return - ! and preset value will be used - - ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mass_of_overlying_ice', & - isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end if - - end subroutine mom_import +!> This function has a few purposes: +!! (1) it imports surface fluxes using data from the mediator; and +!! (2) it can apply restoring in SST and SSS. + +subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype, rc) + + ! Input/output variables + type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid + type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator + type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing + character(len=*), optional , intent(in) :: runtype !< For cesm only, type of run + integer , intent(inout) :: rc + + ! Local Variables + integer :: i, j, ig, jg, n + integer :: isc, iec, jsc, jec + logical :: do_import + character(len=128) :: fldname + real(ESMF_KIND_R8), allocatable :: taux(:,:) + real(ESMF_KIND_R8), allocatable :: tauy(:,:) + character(len=*) , parameter :: subname = '(mom_import)' + + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! ------- + ! import_cnt is used to skip using the import state at the first count for cesm + ! ------- + + if (present(runtype)) then + import_cnt = import_cnt + 1 + if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then + do_import = .false. ! This will skip the first time import information is given + else + do_import = .true. + end if + else + do_import = .true. + end if + + if (do_import) then + ! The following are global indices without halos + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + + !---- + ! surface height pressure + !---- + call state_getimport(importState, 'inst_pres_height_surface', & + isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! near-IR, direct shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! near-IR, diffuse shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! visible, direct shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! visible, diffuse shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! ------- + ! Net longwave radiation (W/m2) + ! ------- + call state_getimport(importState, 'mean_net_lw_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! zonal and meridional surface stress + !---- + allocate (taux(isc:iec,jsc:jec)) + allocate (tauy(isc:iec,jsc:jec)) + + call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! rotate taux and tauy from true zonal/meridional to local coordinates + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & + - ocean_grid%sin_rot(ig,jg)*tauy(i,j) + ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & + + ocean_grid%sin_rot(ig,jg)*taux(i,j) + end do + end do + + deallocate(taux, tauy) + + !---- + ! sensible heat flux (W/m2) + !---- + call state_getimport(importState, 'mean_sensi_heat_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! evaporation flux (W/m2) + !---- + call state_getimport(importState, 'mean_evap_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! liquid precipitation (rain) + !---- + call state_getimport(importState, 'mean_prec_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! frozen precipitation (snow) + !---- + call state_getimport(importState, 'mean_fprec_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! runoff and heat content of runoff + !---- + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used + + ! liquid runoff + ice_ocean_boundary%rofl_flux (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'Foxx_rofl', & + isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! ice runoff + ice_ocean_boundary%rofi_flux (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'Foxx_rofi', & + isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! total runoff + ice_ocean_boundary%runoff (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_runoff_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! heat content of runoff + ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_runoff_heat_flux', & + isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! calving rate and heat flux + !---- + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used + + ice_ocean_boundary%calving(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_calving_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_calving_heat_flux', & + isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! salt flux from ice + !---- + call state_getimport(importState, 'mean_salt_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! !---- + ! ! snow&ice melt heat flux (W/m^2) + ! !---- + ! call state_getimport(importState, 'seaice_melt_heat', & + ! isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat,rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + + ! !---- + ! ! snow&ice melt water flux (W/m^2) + ! !---- + ! call state_getimport(importState, 'seaice_melt_water', & + ! isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_water,rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + + !---- + ! mass of overlying ice + !---- + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used + + ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mass_of_overlying_ice', & + isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end if + +end subroutine mom_import !=============================================================================== - !> Maps outgoing ocean data to ESMF State - subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc) - - ! Input/output variables - type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid - type(ocean_state_type) , pointer :: ocean_state - type(ESMF_State) , intent(inout) :: exportState !< outgoing data - type(ESMF_Clock) , intent(in) :: clock - integer , intent(inout) :: rc - - ! Local variables - integer :: i, j, ig, jg ! indices - integer :: isc, iec, jsc, jec ! indices - integer :: iloc, jloc ! indices - integer :: iglob, jglob ! indices - integer :: n - integer :: icount - real :: slp_L, slp_R, slp_C - real :: slope, u_min, u_max - integer :: day, secs - type(ESMF_TimeInterval) :: timeStep - integer :: dt_int - real :: inv_dt_int !< The inverse of coupling time interval in s-1. - type(ESMF_StateItem_Flag) :: itemFlag - real(ESMF_KIND_R8), allocatable :: omask(:,:) - real(ESMF_KIND_R8), allocatable :: melt_potential(:,:) - real(ESMF_KIND_R8), allocatable :: ocz(:,:), ocm(:,:) - real(ESMF_KIND_R8), allocatable :: ocz_rot(:,:), ocm_rot(:,:) - real(ESMF_KIND_R8), allocatable :: ssh(:,:) - real(ESMF_KIND_R8), allocatable :: dhdx(:,:), dhdy(:,:) - real(ESMF_KIND_R8), allocatable :: dhdx_rot(:,:), dhdy_rot(:,:) - character(len=*) , parameter :: subname = '(mom_export)' - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Use Adcroft's rule of reciprocals; it does the right thing here. - call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (real(dt_int) > 0.0) then - inv_dt_int = 1.0 / real(dt_int) - else - inv_dt_int = 0.0 - end if - - !---------------- - ! Copy from ocean_public to exportstate. - !---------------- - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - - ! ------- - ! ocean mask - ! ------- - - allocate(omask(isc:iec, jsc:jec)) - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - omask(i,j) = nint(ocean_grid%mask2dT(ig,jg)) - enddo - enddo - - call State_SetExport(exportState, 'ocean_mask', & - isc, iec, jsc, jec, omask, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - deallocate(omask) - - ! ------- - ! Sea surface temperature - ! ------- - call State_SetExport(exportState, 'sea_surface_temperature', & - isc, iec, jsc, jec, ocean_public%t_surf, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! ------- - ! Sea surface salinity - ! ------- - call State_SetExport(exportState, 's_surf', & - isc, iec, jsc, jec, ocean_public%s_surf, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! ------- - ! zonal and meridional currents - ! ------- - - ! rotate ocn current from tripolar grid back to lat/lon grid x,y => latlon (CCW) - ! "ocean_grid" has halos and uses local indexing. - - allocate(ocz(isc:iec, jsc:jec)) - allocate(ocm(isc:iec, jsc:jec)) - allocate(ocz_rot(isc:iec, jsc:jec)) - allocate(ocm_rot(isc:iec, jsc:jec)) - - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ocz(i,j) = ocean_public%u_surf(i,j) - ocm(i,j) = ocean_public%v_surf(i,j) - ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) + ocean_grid%sin_rot(ig,jg)*ocm(i,j) - ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) - ocean_grid%sin_rot(ig,jg)*ocz(i,j) - end do +!> Maps outgoing ocean data to ESMF State +subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc) + + ! Input/output variables + type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid + type(ocean_state_type) , pointer :: ocean_state + type(ESMF_State) , intent(inout) :: exportState !< outgoing data + type(ESMF_Clock) , intent(in) :: clock + integer , intent(inout) :: rc + + ! Local variables + integer :: i, j, ig, jg ! indices + integer :: isc, iec, jsc, jec ! indices + integer :: iloc, jloc ! indices + integer :: iglob, jglob ! indices + integer :: n + integer :: icount + real :: slp_L, slp_R, slp_C + real :: slope, u_min, u_max + integer :: day, secs + type(ESMF_TimeInterval) :: timeStep + integer :: dt_int + real :: inv_dt_int !< The inverse of coupling time interval in s-1. + type(ESMF_StateItem_Flag) :: itemFlag + real(ESMF_KIND_R8), allocatable :: omask(:,:) + real(ESMF_KIND_R8), allocatable :: melt_potential(:,:) + real(ESMF_KIND_R8), allocatable :: ocz(:,:), ocm(:,:) + real(ESMF_KIND_R8), allocatable :: ocz_rot(:,:), ocm_rot(:,:) + real(ESMF_KIND_R8), allocatable :: ssh(:,:) + real(ESMF_KIND_R8), allocatable :: dhdx(:,:), dhdy(:,:) + real(ESMF_KIND_R8), allocatable :: dhdx_rot(:,:), dhdy_rot(:,:) + character(len=*) , parameter :: subname = '(mom_export)' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Use Adcroft's rule of reciprocals; it does the right thing here. + call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (real(dt_int) > 0.0) then + inv_dt_int = 1.0 / real(dt_int) + else + inv_dt_int = 0.0 + end if + + !---------------- + ! Copy from ocean_public to exportstate. + !---------------- + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + + ! ------- + ! ocean mask + ! ------- + + allocate(omask(isc:iec, jsc:jec)) + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + omask(i,j) = nint(ocean_grid%mask2dT(ig,jg)) + enddo + enddo + + call State_SetExport(exportState, 'ocean_mask', & + isc, iec, jsc, jec, omask, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(omask) + + ! ------- + ! Sea surface temperature + ! ------- + call State_SetExport(exportState, 'sea_surface_temperature', & + isc, iec, jsc, jec, ocean_public%t_surf, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! ------- + ! Sea surface salinity + ! ------- + call State_SetExport(exportState, 's_surf', & + isc, iec, jsc, jec, ocean_public%s_surf, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! ------- + ! zonal and meridional currents + ! ------- + + ! rotate ocn current from tripolar grid back to lat/lon grid x,y => latlon (CCW) + ! "ocean_grid" has halos and uses local indexing. + + allocate(ocz(isc:iec, jsc:jec)) + allocate(ocm(isc:iec, jsc:jec)) + allocate(ocz_rot(isc:iec, jsc:jec)) + allocate(ocm_rot(isc:iec, jsc:jec)) + + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ocz(i,j) = ocean_public%u_surf(i,j) + ocm(i,j) = ocean_public%v_surf(i,j) + ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) + ocean_grid%sin_rot(ig,jg)*ocm(i,j) + ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) - ocean_grid%sin_rot(ig,jg)*ocz(i,j) + end do + end do + + call State_SetExport(exportState, 'ocn_current_zonal', & + isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call State_SetExport(exportState, 'ocn_current_merid', & + isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(ocz, ocm, ocz_rot, ocm_rot) + + ! ------- + ! Boundary layer depth + ! ------- + call ESMF_StateGet(exportState, 'So_bldepth', itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then + call State_SetExport(exportState, 'So_bldepth', & + isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + ! ------- + ! Freezing melting potential + ! ------- + ! melt_potential, defined positive for T>Tfreeze, so need to change sign + ! Convert from J/m^2 to W/m^2 and make sure Melt_potential is always <= 0 + + allocate(melt_potential(isc:iec, jsc:jec)) + + do j = jsc,jec + do i = isc,iec + if (ocean_public%frazil(i,j) > 0.0) then + melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int + else + melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int + if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 + end if + end do + end do + + call State_SetExport(exportState, 'freezing_melting_potential', & + isc, iec, jsc, jec, melt_potential, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(melt_potential) + + ! ------- + ! Sea level + ! ------- + call ESMF_StateGet(exportState, 'sea_level', itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then + call State_SetExport(exportState, 'sea_level', & + isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + !---------------- + ! Sea-surface zonal and meridional slopes + !---------------- + + allocate(ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) ! local indices with halos + allocate(dhdx(isc:iec, jsc:jec)) !global indices without halos + allocate(dhdy(isc:iec, jsc:jec)) !global indices without halos + allocate(dhdx_rot(isc:iec, jsc:jec)) !global indices without halos + allocate(dhdy_rot(isc:iec, jsc:jec)) !global indices without halos + + ssh = 0.0_ESMF_KIND_R8 + dhdx = 0.0_ESMF_KIND_R8 + dhdy = 0.0_ESMF_KIND_R8 + + ! Make a copy of ssh in order to do a halo update (ssh has local indexing with halos) + do j = ocean_grid%jsc, ocean_grid%jec + jloc = j + ocean_grid%jdg_offset + do i = ocean_grid%isc,ocean_grid%iec + iloc = i + ocean_grid%idg_offset + ssh(i,j) = ocean_public%sea_lev(iloc,jloc) + end do + end do + + ! Update halo of ssh so we can calculate gradients (local indexing) + call pass_var(ssh, ocean_grid%domain) + + ! d/dx ssh + ! This is a simple second-order difference + ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + + do jglob = jsc, jec + j = jglob + ocean_grid%jsc - jsc + do iglob = isc,iec + i = iglob + ocean_grid%isc - isc + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) + if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(i,j) + if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dhdx(iglob,jglob) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dhdx(iglob,jglob) = 0.0 end do - - call State_SetExport(exportState, 'ocn_current_zonal', & - isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_SetExport(exportState, 'ocn_current_merid', & - isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - deallocate(ocz, ocm, ocz_rot, ocm_rot) - - ! ------- - ! Boundary layer depth - ! ------- - call ESMF_StateGet(exportState, 'So_bldepth', itemFlag, rc=rc) - if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - call State_SetExport(exportState, 'So_bldepth', & - isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if - - ! ------- - ! Freezing melting potential - ! ------- - ! melt_potential, defined positive for T>Tfreeze, so need to change sign - ! Convert from J/m^2 to W/m^2 and make sure Melt_potential is always <= 0 - - allocate(melt_potential(isc:iec, jsc:jec)) - - do j = jsc,jec - do i = isc,iec - if (ocean_public%frazil(i,j) > 0.0) then - melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int - else - melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int - if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 - end if - end do - end do - - call State_SetExport(exportState, 'freezing_melting_potential', & - isc, iec, jsc, jec, melt_potential, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - deallocate(melt_potential) - - ! ------- - ! Sea level - ! ------- - call ESMF_StateGet(exportState, 'sea_level', itemFlag, rc=rc) - if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - call State_SetExport(exportState, 'sea_level', & - isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if - - !---------------- - ! Sea-surface zonal and meridional slopes - !---------------- - - allocate(ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) ! local indices with halos - allocate(dhdx(isc:iec, jsc:jec)) !global indices without halos - allocate(dhdy(isc:iec, jsc:jec)) !global indices without halos - allocate(dhdx_rot(isc:iec, jsc:jec)) !global indices without halos - allocate(dhdy_rot(isc:iec, jsc:jec)) !global indices without halos - - ssh = 0.0_ESMF_KIND_R8 - dhdx = 0.0_ESMF_KIND_R8 - dhdy = 0.0_ESMF_KIND_R8 - - ! Make a copy of ssh in order to do a halo update (ssh has local indexing with halos) - do j = ocean_grid%jsc, ocean_grid%jec - jloc = j + ocean_grid%jdg_offset - do i = ocean_grid%isc,ocean_grid%iec - iloc = i + ocean_grid%idg_offset - ssh(i,j) = ocean_public%sea_lev(iloc,jloc) - end do + end do + + ! d/dy ssh + ! This is a simple second-order difference + ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) + + do jglob = jsc, jec + j = jglob + ocean_grid%jsc - jsc + do iglob = isc,iec + i = iglob + ocean_grid%isc - isc + ! This is a PLM slope which might be less prone to the A-ocean_grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) + if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) + if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dhdy(iglob,jglob) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dhdy(iglob,jglob) = 0.0 end do + end do + + ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) + ! "ocean_grid" uses has halos and uses local indexing. + + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) + dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) + end do + end do + + call State_SetExport(exportState, 'sea_surface_slope_zonal', & + isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call State_SetExport(exportState, 'sea_surface_slope_merid', & + isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(ssh, dhdx, dhdy, dhdx_rot, dhdy_rot) + +end subroutine mom_export - ! Update halo of ssh so we can calculate gradients (local indexing) - call pass_var(ssh, ocean_grid%domain) - - ! d/dx ssh - ! This is a simple second-order difference - ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) - - do jglob = jsc, jec - j = jglob + ocean_grid%jsc - jsc - do iglob = isc,iec - i = iglob + ocean_grid%isc - isc - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) - if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(i,j) - if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dhdx(iglob,jglob) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) dhdx(iglob,jglob) = 0.0 - end do - end do +!=============================================================================== - ! d/dy ssh - ! This is a simple second-order difference - ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) - - do jglob = jsc, jec - j = jglob + ocean_grid%jsc - jsc - do iglob = isc,iec - i = iglob + ocean_grid%isc - isc - ! This is a PLM slope which might be less prone to the A-ocean_grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) - if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) - if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dhdy(iglob,jglob) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) dhdy(iglob,jglob) = 0.0 - end do - end do +subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) + type(ESMF_State) , intent(in) :: State + character(len=*) , intent(in) :: fldname + real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:) + integer, optional , intent(out) :: rc - ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) - ! "ocean_grid" uses has halos and uses local indexing. + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) - dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) - end do - end do + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call State_SetExport(exportState, 'sea_surface_slope_zonal', & - isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (present(rc)) rc = lrc - call State_SetExport(exportState, 'sea_surface_slope_merid', & - isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +end subroutine State_GetFldPtr_1d - deallocate(ssh, dhdx, dhdy, dhdx_rot, dhdy_rot) +!=============================================================================== - end subroutine mom_export +subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) + type(ESMF_State) , intent(in) :: State + character(len=*) , intent(in) :: fldname + real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:) + integer, optional , intent(out) :: rc -!=============================================================================== + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) - type(ESMF_State) , intent(in) :: State - character(len=*) , intent(in) :: fldname - real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:) - integer, optional , intent(out) :: rc + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! local variables - type(ESMF_Field) :: lfield - integer :: lrc - character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + if (present(rc)) rc = lrc - call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +end subroutine State_GetFldPtr_2d - if (present(rc)) rc = lrc +!=============================================================================== - end subroutine State_GetFldPtr_1d +subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, rc) + + ! ---------------------------------------------- + ! Map import state field to output array + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + integer , intent(in) :: isc + integer , intent(in) :: iec + integer , intent(in) :: jsc + integer , intent(in) :: jec + real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec) + logical, optional , intent(in) :: do_sum + integer , intent(out) :: rc + + ! local variables + type(ESMF_StateItem_Flag) :: itemFlag + integer :: n, i, j, i1, j1 + integer :: lbnd1,lbnd2 + real(ESMF_KIND_R8), pointer :: dataPtr1d(:) + real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) + character(len=*) , parameter :: subname='(mom_cap_methods:state_getimport)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then + + if (geomtype == ESMF_GEOMTYPE_MESH) then + + ! get field pointer + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! determine output array + n = 0 + do j = jsc,jec + do i = isc,iec + n = n + 1 + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr1d(n) + else + output(i,j) = dataPtr1d(n) + end if + end do + end do + + else if (geomtype == ESMF_GEOMTYPE_GRID) then + + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr2d(i1,j1) + else + output(i,j) = dataPtr2d(i1,j1) + end if + end do + end do + + end if + + end if + +end subroutine State_GetImport !=============================================================================== - subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) - type(ESMF_State) , intent(in) :: State - character(len=*) , intent(in) :: fldname - real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:) - integer, optional , intent(out) :: rc - - ! local variables - type(ESMF_Field) :: lfield - integer :: lrc - character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - - call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (present(rc)) rc = lrc - - end subroutine State_GetFldPtr_2d - - !=============================================================================== - - subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, rc) - - ! ---------------------------------------------- - ! Map import state field to output array - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State) , intent(in) :: state - character(len=*) , intent(in) :: fldname - integer , intent(in) :: isc - integer , intent(in) :: iec - integer , intent(in) :: jsc - integer , intent(in) :: jec - real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec) - logical, optional , intent(in) :: do_sum - integer , intent(out) :: rc - - ! local variables - type(ESMF_StateItem_Flag) :: itemFlag - integer :: n, i, j, i1, j1 - integer :: lbnd1,lbnd2 - real(ESMF_KIND_R8), pointer :: dataPtr1d(:) - real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) - character(len=*) , parameter :: subname='(mom_cap_methods:state_getimport)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) - if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - - if (geomtype == ESMF_GEOMTYPE_MESH) then - - ! get field pointer - call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! determine output array - n = 0 - do j = jsc,jec - do i = isc,iec - n = n + 1 - if (present(do_sum)) then - output(i,j) = output(i,j) + dataPtr1d(n) - else - output(i,j) = dataPtr1d(n) - end if - end do - end do - - else if (geomtype == ESMF_GEOMTYPE_GRID) then - - call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr2d,1) - lbnd2 = lbound(dataPtr2d,2) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - if (present(do_sum)) then - output(i,j) = output(i,j) + dataPtr2d(i1,j1) - else - output(i,j) = dataPtr2d(i1,j1) - end if - end do - end do - - end if - - end if - - end subroutine State_GetImport - - !=============================================================================== - - subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid, rc) - - ! ---------------------------------------------- - ! Map input array to export state - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State) , intent(inout) :: state - character(len=*) , intent(in) :: fldname - integer , intent(in) :: isc - integer , intent(in) :: iec - integer , intent(in) :: jsc - integer , intent(in) :: jec - real (ESMF_KIND_R8) , intent(in) :: input(isc:iec,jsc:jec) - type(ocean_grid_type) , intent(in) :: ocean_grid - integer , intent(out) :: rc - - ! local variables - type(ESMF_StateItem_Flag) :: itemFlag - integer :: n, i, j, i1, j1, ig,jg - integer :: lbnd1,lbnd2 - real(ESMF_KIND_R8), pointer :: dataPtr1d(:) - real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) - character(len=*) , parameter :: subname='(mom_cap_methods:state_setexport)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - ! Indexing notes: - ! input array from "ocean_public" uses local indexing without halos - ! mask from "ocean_grid" uses local indexing with halos - - call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) - if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - - if (geomtype == ESMF_GEOMTYPE_MESH) then - - call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - n = 0 - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - n = n+1 - dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) - end do - end do - - else if (geomtype == ESMF_GEOMTYPE_GRID) then - - call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr2d,1) - lbnd2 = lbound(dataPtr2d,2) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + ocean_grid%isc - isc - dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) - end do - end do - - end if - - end if - - end subroutine State_SetExport +subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid, rc) + + ! ---------------------------------------------- + ! Map input array to export state + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(inout) :: state + character(len=*) , intent(in) :: fldname + integer , intent(in) :: isc + integer , intent(in) :: iec + integer , intent(in) :: jsc + integer , intent(in) :: jec + real (ESMF_KIND_R8) , intent(in) :: input(isc:iec,jsc:jec) + type(ocean_grid_type) , intent(in) :: ocean_grid + integer , intent(out) :: rc + + ! local variables + type(ESMF_StateItem_Flag) :: itemFlag + integer :: n, i, j, i1, j1, ig,jg + integer :: lbnd1,lbnd2 + real(ESMF_KIND_R8), pointer :: dataPtr1d(:) + real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) + character(len=*) , parameter :: subname='(mom_cap_methods:state_setexport)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! Indexing notes: + ! input array from "ocean_public" uses local indexing without halos + ! mask from "ocean_grid" uses local indexing with halos + + call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then + + if (geomtype == ESMF_GEOMTYPE_MESH) then + + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + n = 0 + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + n = n+1 + dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) + end do + end do + + else if (geomtype == ESMF_GEOMTYPE_GRID) then + + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) + end do + end do + + end if + + end if + +end subroutine State_SetExport end module mom_cap_methods diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 index 7da3cf842d..bd26785f54 100644 --- a/config_src/nuopc_driver/mom_cap_time.F90 +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -8,418 +8,417 @@ ! module mom_cap_time - ! !USES: - use ESMF , only : ESMF_Time, ESMF_Clock, ESMF_Calendar, ESMF_Alarm - use ESMF , only : ESMF_TimeGet, ESMF_TimeSet - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet - use ESMF , only : ESMF_ClockGet, ESMF_AlarmCreate - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_LogSetError, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU - use ESMF , only : ESMF_RC_ARG_BAD - use ESMF , only : operator(<), operator(/=), operator(+), operator(-), operator(*) , operator(>=) - use ESMF , only : operator(<=), operator(>), operator(==) - - implicit none - private ! default private - - public :: AlarmInit ! initialize an alarm - - private :: TimeInit - private :: date2ymd - - ! Clock and alarm options - character(len=*), private, parameter :: & - optNONE = "none" , & - optNever = "never" , & - optNSteps = "nsteps" , & - optNStep = "nstep" , & - optNSeconds = "nseconds" , & - optNSecond = "nsecond" , & - optNMinutes = "nminutes" , & - optNMinute = "nminute" , & - optNHours = "nhours" , & - optNHour = "nhour" , & - optNDays = "ndays" , & - optNDay = "nday" , & - optNMonths = "nmonths" , & - optNMonth = "nmonth" , & - optNYears = "nyears" , & - optNYear = "nyear" , & - optMonthly = "monthly" , & - optYearly = "yearly" , & - optDate = "date" , & - optIfdays0 = "ifdays0" , & - optGLCCouplingPeriod = "glc_coupling_period" - - ! Module data - integer, parameter :: SecPerDay = 86400 ! Seconds per day - character(len=*), parameter :: u_FILE_u = & - __FILE__ +! !USES: +use ESMF , only : ESMF_Time, ESMF_Clock, ESMF_Calendar, ESMF_Alarm +use ESMF , only : ESMF_TimeGet, ESMF_TimeSet +use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet +use ESMF , only : ESMF_ClockGet, ESMF_AlarmCreate +use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO +use ESMF , only : ESMF_LogSetError, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU +use ESMF , only : ESMF_RC_ARG_BAD +use ESMF , only : operator(<), operator(/=), operator(+), operator(-), operator(*) , operator(>=) +use ESMF , only : operator(<=), operator(>), operator(==) + +implicit none; private + +public :: AlarmInit ! initialize an alarm + +private :: TimeInit +private :: date2ymd + +! Clock and alarm options +character(len=*), private, parameter :: & + optNONE = "none" , & + optNever = "never" , & + optNSteps = "nsteps" , & + optNStep = "nstep" , & + optNSeconds = "nseconds" , & + optNSecond = "nsecond" , & + optNMinutes = "nminutes" , & + optNMinute = "nminute" , & + optNHours = "nhours" , & + optNHour = "nhour" , & + optNDays = "ndays" , & + optNDay = "nday" , & + optNMonths = "nmonths" , & + optNMonth = "nmonth" , & + optNYears = "nyears" , & + optNYear = "nyear" , & + optMonthly = "monthly" , & + optYearly = "yearly" , & + optDate = "date" , & + optIfdays0 = "ifdays0" , & + optGLCCouplingPeriod = "glc_coupling_period" + +! Module data +integer, parameter :: SecPerDay = 86400 ! Seconds per day +character(len=*), parameter :: u_FILE_u = & + __FILE__ !=============================================================================== contains !=============================================================================== - subroutine AlarmInit( clock, alarm, option, & - opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) - - ! !DESCRIPTION: Setup an alarm in a clock - ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm - ! time. If you send an arbitrary but proper ringtime from the - ! past and the ring interval, the alarm will always go off on the - ! next clock advance and this will cause serious problems. Even - ! if it makes sense to initialize an alarm with some reference - ! time and the alarm interval, that reference time has to be - ! advance forward to be >= the current time. In the logic below - ! we set an appropriate "NextAlarm" and then we make sure to - ! advance it properly based on the ring interval. - - ! input/output variables - type(ESMF_Clock) , intent(inout) :: clock ! clock - type(ESMF_Alarm) , intent(inout) :: alarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer , optional , intent(in) :: opt_n ! alarm freq - integer , optional , intent(in) :: opt_ymd ! alarm ymd - integer , optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time - character(len=*) , optional , intent(in) :: alarmname ! alarm name - integer , intent(inout) :: rc ! Return code - - ! local variables - type(ESMF_Calendar) :: cal ! calendar - integer :: lymd ! local ymd - integer :: ltod ! local tod - integer :: cyy,cmm,cdd,csec ! time info - integer :: nyy,nmm,ndd,nsec ! time info - character(len=64) :: lalarmname ! local alarm name - logical :: update_nextalarm ! update next alarm - type(ESMF_Time) :: CurrTime ! Current Time - type(ESMF_Time) :: NextAlarm ! Next restart alarm time - type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - character(len=*), parameter :: subname = '(AlarmInit): ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - lalarmname = 'alarm_unknown' - if (present(alarmname)) lalarmname = trim(alarmname) - ltod = 0 - if (present(opt_tod)) ltod = opt_tod - lymd = -1 - if (present(opt_ymd)) lymd = opt_ymd - - ! verify parameters - if (trim(option) == optNSteps .or. trim(option) == optNStep .or. & - trim(option) == optNSeconds .or. trim(option) == optNSecond .or. & - trim(option) == optNMinutes .or. trim(option) == optNMinute .or. & - trim(option) == optNHours .or. trim(option) == optNHour .or. & - trim(option) == optNDays .or. trim(option) == optNDay .or. & - trim(option) == optNMonths .or. trim(option) == optNMonth .or. & - trim(option) == optNYears .or. trim(option) == optNYear .or. & - trim(option) == optIfdays0) then - if (.not. present(opt_n)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' requires opt_n', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return - end if - if (opt_n <= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' invalid opt_n', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return - end if - endif - - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - call ESMF_TimeGet(CurrTime, yy=nyy, mm=nmm, dd=ndd, s=nsec, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - ! initial guess of next alarm, this will be updated below - if (present(RefTime)) then - NextAlarm = RefTime - else - NextAlarm = CurrTime - endif - - ! Determine calendar - call ESMF_ClockGet(clock, calendar=cal, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - ! Determine inputs for call to create alarm - selectcase (trim(option)) - - case (optNONE, optNever) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - update_nextalarm = .false. - - case (optDate) - if (.not. present(opt_ymd)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' requires opt_ymd', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return - end if - if (lymd < 0 .or. ltod < 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call TimeInit(NextAlarm, lymd, cal, tod=ltod, desc="optDate", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - update_nextalarm = .false. - - case (optIfdays0) - if (.not. present(opt_ymd)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' requires opt_ymd', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - update_nextalarm = .true. - - case (optNSteps, optNStep) - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSeconds, optNSecond) - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMinutes, optNMinute) - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHours, optNHour) - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDays, optNDay) - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonths, optNMonth) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optMonthly) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - update_nextalarm = .true. - - case (optNYears, optNYear) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optYearly) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - update_nextalarm = .true. - - case default - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//' unknown option: '//trim(option), & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) +subroutine AlarmInit( clock, alarm, option, & + opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + + ! !DESCRIPTION: Setup an alarm in a clock + ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm + ! time. If you send an arbitrary but proper ringtime from the + ! past and the ring interval, the alarm will always go off on the + ! next clock advance and this will cause serious problems. Even + ! if it makes sense to initialize an alarm with some reference + ! time and the alarm interval, that reference time has to be + ! advance forward to be >= the current time. In the logic below + ! we set an appropriate "NextAlarm" and then we make sure to + ! advance it properly based on the ring interval. + + ! input/output variables + type(ESMF_Clock) , intent(inout) :: clock ! clock + type(ESMF_Alarm) , intent(inout) :: alarm ! alarm + character(len=*) , intent(in) :: option ! alarm option + integer , optional , intent(in) :: opt_n ! alarm freq + integer , optional , intent(in) :: opt_ymd ! alarm ymd + integer , optional , intent(in) :: opt_tod ! alarm tod (sec) + type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time + character(len=*) , optional , intent(in) :: alarmname ! alarm name + integer , intent(inout) :: rc ! Return code + + ! local variables + type(ESMF_Calendar) :: cal ! calendar + integer :: lymd ! local ymd + integer :: ltod ! local tod + integer :: cyy,cmm,cdd,csec ! time info + integer :: nyy,nmm,ndd,nsec ! time info + character(len=64) :: lalarmname ! local alarm name + logical :: update_nextalarm ! update next alarm + type(ESMF_Time) :: CurrTime ! Current Time + type(ESMF_Time) :: NextAlarm ! Next restart alarm time + type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval + character(len=*), parameter :: subname = '(AlarmInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lalarmname = 'alarm_unknown' + if (present(alarmname)) lalarmname = trim(alarmname) + ltod = 0 + if (present(opt_tod)) ltod = opt_tod + lymd = -1 + if (present(opt_ymd)) lymd = opt_ymd + + ! verify parameters + if (trim(option) == optNSteps .or. trim(option) == optNStep .or. & + trim(option) == optNSeconds .or. trim(option) == optNSecond .or. & + trim(option) == optNMinutes .or. trim(option) == optNMinute .or. & + trim(option) == optNHours .or. trim(option) == optNHour .or. & + trim(option) == optNDays .or. trim(option) == optNDay .or. & + trim(option) == optNMonths .or. trim(option) == optNMonth .or. & + trim(option) == optNYears .or. trim(option) == optNYear .or. & + trim(option) == optIfdays0) then + if (.not. present(opt_n)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_n', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + if (opt_n <= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' invalid opt_n', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + endif + + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & return - end select - - ! -------------------------------------------------------------------------------- - ! --- AlarmInterval and NextAlarm should be set --- - ! -------------------------------------------------------------------------------- - - ! --- advance Next Alarm so it won't ring on first timestep for - ! --- most options above. go back one alarminterval just to be careful - - if (update_nextalarm) then - NextAlarm = NextAlarm - AlarmInterval - do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval - enddo - endif - - alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, ringInterval=AlarmInterval, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - end subroutine AlarmInit - - !=============================================================================== - - subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) - - ! Create the ESMF_Time object corresponding to the given input time, given in - ! YMD (Year Month Day) and TOD (Time-of-day) format. - ! Set the time by an integer as YYYYMMDD and integer seconds in the day - - ! input/output parameters: - type(ESMF_Time) , intent(inout) :: Time ! ESMF time - integer , intent(in) :: ymd ! year, month, day YYYYMMDD - type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar - integer , intent(in), optional :: tod ! time of day in seconds - character(len=*) , intent(in), optional :: desc ! description of time to set - integer , intent(in), optional :: logunit - integer , intent(out), optional :: rc - - ! local varaibles - integer :: yr, mon, day ! Year, month, day as integers - integer :: ltod ! local tod - character(len=256) :: ldesc ! local desc - character(len=*), parameter :: subname = '(TimeInit) ' - !------------------------------------------------------------------------------- - - ltod = 0 - if (present(tod)) ltod = tod - ldesc = '' - if (present(desc)) ldesc = desc - - if ( (ymd < 0) .or. (ltod < 0) .or. (ltod > SecPerDay) )then - if (present(logunit)) then - write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & - 'time-of-day out of bounds', ymd, ltod - end if - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//' yymmdd is negative or time-of-day out of bounds ', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) + call ESMF_TimeGet(CurrTime, yy=nyy, mm=nmm, dd=ndd, s=nsec, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & return - end if - call date2ymd (ymd,yr,mon,day) + ! initial guess of next alarm, this will be updated below + if (present(RefTime)) then + NextAlarm = RefTime + else + NextAlarm = CurrTime + endif + + ! Determine calendar + call ESMF_ClockGet(clock, calendar=cal, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + ! Determine inputs for call to create alarm + selectcase (trim(option)) + + case (optNONE, optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .false. + + case (optDate) + if (.not. present(opt_ymd)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_ymd', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + if (lymd < 0 .or. ltod < 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call TimeInit(NextAlarm, lymd, cal, tod=ltod, desc="optDate", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .false. + + case (optIfdays0) + if (.not. present(opt_ymd)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_ymd', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case (optNSteps, optNStep) + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSeconds, optNSecond) + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes, optNMinute) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours, optNHour) + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDays, optNDay) + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths, optNMonth) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optMonthly) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case (optNYears, optNYear) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optYearly) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case default + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//' unknown option: '//trim(option), & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + + end select + + ! -------------------------------------------------------------------------------- + ! --- AlarmInterval and NextAlarm should be set --- + ! -------------------------------------------------------------------------------- + + ! --- advance Next Alarm so it won't ring on first timestep for + ! --- most options above. go back one alarminterval just to be careful + + if (update_nextalarm) then + NextAlarm = NextAlarm - AlarmInterval + do while (NextAlarm <= CurrTime) + NextAlarm = NextAlarm + AlarmInterval + enddo + endif + + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, ringInterval=AlarmInterval, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + +end subroutine AlarmInit - call ESMF_TimeSet( Time, yy=yr, mm=mon, dd=day, s=ltod, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return +!=============================================================================== + +subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) + + ! Create the ESMF_Time object corresponding to the given input time, given in + ! YMD (Year Month Day) and TOD (Time-of-day) format. + ! Set the time by an integer as YYYYMMDD and integer seconds in the day + + ! input/output parameters: + type(ESMF_Time) , intent(inout) :: Time ! ESMF time + integer , intent(in) :: ymd ! year, month, day YYYYMMDD + type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar + integer , intent(in), optional :: tod ! time of day in seconds + character(len=*) , intent(in), optional :: desc ! description of time to set + integer , intent(in), optional :: logunit + integer , intent(out), optional :: rc + + ! local varaibles + integer :: yr, mon, day ! Year, month, day as integers + integer :: ltod ! local tod + character(len=256) :: ldesc ! local desc + character(len=*), parameter :: subname = '(TimeInit) ' + !------------------------------------------------------------------------------- + + ltod = 0 + if (present(tod)) ltod = tod + ldesc = '' + if (present(desc)) ldesc = desc + + if ( (ymd < 0) .or. (ltod < 0) .or. (ltod > SecPerDay) )then + if (present(logunit)) then + write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & + 'time-of-day out of bounds', ymd, ltod + end if + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//' yymmdd is negative or time-of-day out of bounds ', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + + call date2ymd (ymd,yr,mon,day) + + call ESMF_TimeSet( Time, yy=yr, mm=mon, dd=day, s=ltod, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - end subroutine TimeInit +end subroutine TimeInit - !=============================================================================== +!=============================================================================== - subroutine date2ymd (date, year, month, day) +subroutine date2ymd (date, year, month, day) - ! input/output variables - integer, intent(in) :: date ! coded-date (yyyymmdd) - integer, intent(out) :: year,month,day ! calendar year,month,day + ! input/output variables + integer, intent(in) :: date ! coded-date (yyyymmdd) + integer, intent(out) :: year,month,day ! calendar year,month,day - ! local variables - integer :: tdate ! temporary date - character(*),parameter :: subName = "(date2ymd)" - !------------------------------------------------------------------------------- + ! local variables + integer :: tdate ! temporary date + character(*),parameter :: subName = "(date2ymd)" + !------------------------------------------------------------------------------- - tdate = abs(date) - year = int(tdate/10000) - if (date < 0) then - year = -year - end if - month = int( mod(tdate,10000)/ 100) - day = mod(tdate, 100) + tdate = abs(date) + year = int(tdate/10000) + if (date < 0) then + year = -year + end if + month = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) - end subroutine date2ymd +end subroutine date2ymd end module diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 index f009a72e8e..430114840d 100644 --- a/config_src/nuopc_driver/time_utils.F90 +++ b/config_src/nuopc_driver/time_utils.F90 @@ -1,161 +1,160 @@ module time_utils_mod - use fms_mod, only: uppercase - use mpp_mod, only: mpp_error, FATAL - use time_manager_mod, only: time_type, set_time, set_date, get_date - use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR - use time_manager_mod, only: fms_get_calendar_type => get_calendar_type - use ESMF - - implicit none - private - - !-------------------- interface blocks --------------------- - interface fms2esmf_cal - module procedure fms2esmf_cal_c - module procedure fms2esmf_cal_i - end interface fms2esmf_cal - interface esmf2fms_time - module procedure esmf2fms_time_t - module procedure esmf2fms_timestep - end interface esmf2fms_time - - public fms2esmf_cal - public esmf2fms_time - public fms2esmf_time - public string_to_date - - contains - - !-------------------- module code --------------------- - - function fms2esmf_cal_c(calendar) +use fms_mod, only: uppercase +use mpp_mod, only: mpp_error, FATAL +use time_manager_mod, only: time_type, set_time, set_date, get_date +use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR +use time_manager_mod, only: fms_get_calendar_type => get_calendar_type +use ESMF + +implicit none; private + +!-------------------- interface blocks --------------------- +interface fms2esmf_cal + module procedure fms2esmf_cal_c + module procedure fms2esmf_cal_i +end interface fms2esmf_cal +interface esmf2fms_time + module procedure esmf2fms_time_t + module procedure esmf2fms_timestep +end interface esmf2fms_time + +public fms2esmf_cal +public esmf2fms_time +public fms2esmf_time +public string_to_date + +contains + +!-------------------- module code --------------------- + +function fms2esmf_cal_c(calendar) ! ! Return Value: - type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c + type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c ! ! Arguments: - character(len=*), intent(in) :: calendar - - select case( uppercase(trim(calendar)) ) - case( 'GREGORIAN' ) - fms2esmf_cal_c = ESMF_CALKIND_GREGORIAN - case( 'JULIAN' ) - fms2esmf_cal_c = ESMF_CALKIND_JULIAN - case( 'NOLEAP' ) - fms2esmf_cal_c = ESMF_CALKIND_NOLEAP - case( 'THIRTY_DAY' ) - fms2esmf_cal_c = ESMF_CALKIND_360DAY - case( 'NO_CALENDAR' ) - fms2esmf_cal_c = ESMF_CALKIND_NOCALENDAR - case default - call mpp_error(FATAL, & - 'ocean_solo: ocean_solo_nml entry calendar must be one of GREGORIAN|JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) - end select - end function fms2esmf_cal_c - - function fms2esmf_cal_i(calendar) + character(len=*), intent(in) :: calendar + + select case( uppercase(trim(calendar)) ) + case( 'GREGORIAN' ) + fms2esmf_cal_c = ESMF_CALKIND_GREGORIAN + case( 'JULIAN' ) + fms2esmf_cal_c = ESMF_CALKIND_JULIAN + case( 'NOLEAP' ) + fms2esmf_cal_c = ESMF_CALKIND_NOLEAP + case( 'THIRTY_DAY' ) + fms2esmf_cal_c = ESMF_CALKIND_360DAY + case( 'NO_CALENDAR' ) + fms2esmf_cal_c = ESMF_CALKIND_NOCALENDAR + case default + call mpp_error(FATAL, & + 'ocean_solo: ocean_solo_nml entry calendar must be one of GREGORIAN|JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) + end select +end function fms2esmf_cal_c + +function fms2esmf_cal_i(calendar) ! ! Return Value: - type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i + type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i ! ! Arguments: - integer, intent(in) :: calendar - - select case(calendar) - case(THIRTY_DAY_MONTHS) - fms2esmf_cal_i = ESMF_CALKIND_360DAY - case(GREGORIAN) - fms2esmf_cal_i = ESMF_CALKIND_GREGORIAN - case(JULIAN) - fms2esmf_cal_i = ESMF_CALKIND_JULIAN - case(NOLEAP) - fms2esmf_cal_i = ESMF_CALKIND_NOLEAP - case(NO_CALENDAR) - fms2esmf_cal_i = ESMF_CALKIND_NOCALENDAR - end select - end function fms2esmf_cal_i - - function esmf2fms_time_t(time) - ! Return Value - type(Time_type) :: esmf2fms_time_t - ! Input Arguments - type(ESMF_Time), intent(in) :: time - ! Local Variables - integer :: yy, mm, dd, h, m, s - type(ESMF_CALKIND_FLAG) :: calkind - - integer :: rc - - call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, & - calkindflag=calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - esmf2fms_time_t = Set_date(yy, mm, dd, h, m, s) - - end function esmf2fms_time_t - - function esmf2fms_timestep(timestep) - ! Return Value - type(Time_type) :: esmf2fms_timestep - ! Input Arguments - type(ESMF_TimeInterval), intent(in):: timestep - ! Local Variables - integer :: s - type(ESMF_CALKIND_FLAG) :: calkind - - integer :: rc - - call ESMF_TimeIntervalGet(timestep, s=s, calkindflag=calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - esmf2fms_timestep = set_time(s, 0) - - end function esmf2fms_timestep - - function fms2esmf_time(time, calkind) - ! Return Value - type(ESMF_Time) :: fms2esmf_time - ! Input Arguments - type(Time_type), intent(in) :: time - type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind - ! Local Variables - integer :: yy, mm, d, h, m, s - type(ESMF_CALKIND_FLAG) :: l_calkind - - integer :: rc - - if(present(calkind)) then - l_calkind = calkind - else - l_calkind = fms2esmf_cal(fms_get_calendar_type()) - endif - - call get_date(time, yy, mm, d, h, m, s) - - call ESMF_TimeSet(fms2esmf_time, yy=yy, mm=mm, d=d, h=h, m=m, s=s, & - calkindflag=l_calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end function fms2esmf_time - - function string_to_date(string, rc) - character(len=15), intent(in) :: string - integer, intent(out), optional :: rc - type(time_type) :: string_to_date - - integer :: yr,mon,day,hr,min,sec - - if(present(rc)) rc = ESMF_SUCCESS - - read(string, '(I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') yr, mon, day, hr, min, sec - string_to_date = set_date(yr, mon, day, hr, min, sec) - - end function string_to_date + integer, intent(in) :: calendar + + select case(calendar) + case(THIRTY_DAY_MONTHS) + fms2esmf_cal_i = ESMF_CALKIND_360DAY + case(GREGORIAN) + fms2esmf_cal_i = ESMF_CALKIND_GREGORIAN + case(JULIAN) + fms2esmf_cal_i = ESMF_CALKIND_JULIAN + case(NOLEAP) + fms2esmf_cal_i = ESMF_CALKIND_NOLEAP + case(NO_CALENDAR) + fms2esmf_cal_i = ESMF_CALKIND_NOCALENDAR + end select +end function fms2esmf_cal_i + +function esmf2fms_time_t(time) + ! Return Value + type(Time_type) :: esmf2fms_time_t + ! Input Arguments + type(ESMF_Time), intent(in) :: time + ! Local Variables + integer :: yy, mm, dd, h, m, s + type(ESMF_CALKIND_FLAG) :: calkind + + integer :: rc + + call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, & + calkindflag=calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + esmf2fms_time_t = Set_date(yy, mm, dd, h, m, s) + +end function esmf2fms_time_t + +function esmf2fms_timestep(timestep) + ! Return Value + type(Time_type) :: esmf2fms_timestep + ! Input Arguments + type(ESMF_TimeInterval), intent(in):: timestep + ! Local Variables + integer :: s + type(ESMF_CALKIND_FLAG) :: calkind + + integer :: rc + + call ESMF_TimeIntervalGet(timestep, s=s, calkindflag=calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + esmf2fms_timestep = set_time(s, 0) + +end function esmf2fms_timestep + +function fms2esmf_time(time, calkind) + ! Return Value + type(ESMF_Time) :: fms2esmf_time + ! Input Arguments + type(Time_type), intent(in) :: time + type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind + ! Local Variables + integer :: yy, mm, d, h, m, s + type(ESMF_CALKIND_FLAG) :: l_calkind + + integer :: rc + + if(present(calkind)) then + l_calkind = calkind + else + l_calkind = fms2esmf_cal(fms_get_calendar_type()) + endif + + call get_date(time, yy, mm, d, h, m, s) + + call ESMF_TimeSet(fms2esmf_time, yy=yy, mm=mm, d=d, h=h, m=m, s=s, & + calkindflag=l_calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +end function fms2esmf_time + +function string_to_date(string, rc) + character(len=15), intent(in) :: string + integer, intent(out), optional :: rc + type(time_type) :: string_to_date + + integer :: yr,mon,day,hr,min,sec + + if(present(rc)) rc = ESMF_SUCCESS + + read(string, '(I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') yr, mon, day, hr, min, sec + string_to_date = set_date(yr, mon, day, hr, min, sec) + +end function string_to_date end module time_utils_mod From ea32f96d5a068cef1db2a615fc80fa1a95ea0231 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 20 Mar 2019 16:55:43 -0600 Subject: [PATCH 54/77] Clean and Doxygenize --- .../nuopc_driver/MOM_surface_forcing.F90 | 324 +++++++++--------- 1 file changed, 154 insertions(+), 170 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index eebda0b8fc..91d3ed6e3d 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -55,93 +55,92 @@ module MOM_surface_forcing private apply_force_adjustments private surface_forcing_end -! surface_forcing_CS is a structure containing pointers to the forcing fields -! which may be used to drive MOM. All fluxes are positive downward. +!> Contains pointers to the forcing fields which may be used to drive MOM. +!! All fluxes are positive downward. type, public :: surface_forcing_CS ; private - integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integer values - ! from MOM_domains) to indicate the staggering of - ! the winds that are being provided in calls to - ! update_ocean_model. - logical :: use_temperature ! If true, temp and saln used as state variables + integer :: wind_stagger !< AGRID, BGRID_NE, or CGRID_NE (integer values + !! from MOM_domains) to indicate the staggering of + !! the winds that are being provided in calls to + !! update_ocean_model. + logical :: use_temperature !! If true, temp and saln used as state variables real :: wind_stress_multiplier !< A multiplier applied to incoming wind stress (nondim). - real :: Rho0 ! Boussinesq reference density (kg/m^3) - real :: area_surf = -1.0 ! total ocean surface area (m^2) - real :: latent_heat_fusion ! latent heat of fusion (J/kg) - real :: latent_heat_vapor ! latent heat of vaporization (J/kg) - - real :: max_p_surf ! maximum surface pressure that can be - ! exerted by the atmosphere and floating sea-ice, - ! in Pa. This is needed because the FMS coupling - ! structure does not limit the water that can be - ! frozen out of the ocean and the ice-ocean heat - ! fluxes are treated explicitly. - logical :: use_limited_P_SSH ! If true, return the sea surface height with - ! the correction for the atmospheric (and sea-ice) - ! pressure limited by max_p_surf instead of the - ! full atmospheric pressure. The default is true. - - real :: gust_const ! constant unresolved background gustiness for ustar (Pa) - logical :: read_gust_2d ! If true, use a 2-dimensional gustiness supplied - ! from an input file. + real :: Rho0 !< Boussinesq reference density [kg/m^3] + real :: area_surf = -1.0 !< total ocean surface area [m^2] + real :: latent_heat_fusion !< latent heat of fusion [J/kg] + real :: latent_heat_vapor !< latent heat of vaporization [J/kg] + + real :: max_p_surf !< maximum surface pressure that can be + !! exerted by the atmosphere and floating sea-ice, + !! in Pa. This is needed because the FMS coupling + !! structure does not limit the water that can be + !! frozen out of the ocean and the ice-ocean heat + !! fluxes are treated explicitly. + logical :: use_limited_P_SSH !< If true, return the sea surface height with + !! the correction for the atmospheric (and sea-ice) + !! pressure limited by max_p_surf instead of the + !! full atmospheric pressure. The default is true. + + real :: gust_const !< constant unresolved background gustiness for ustar [Pa] + logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied + !! from an input file. real, pointer, dimension(:,:) :: & - TKE_tidal => NULL(), & ! turbulent kinetic energy introduced to the - ! bottom boundary layer by drag on the tidal flows, - ! in W m-2. - gust => NULL(), & ! spatially varying unresolved background - ! gustiness that contributes to ustar (Pa). - ! gust is used when read_gust_2d is true. - ustar_tidal => NULL() ! tidal contribution to the bottom friction velocity (m/s) - real :: cd_tides ! drag coefficient that applies to the tides (nondimensional) - real :: utide ! constant tidal velocity to use if read_tideamp - ! is false, in m s-1. - logical :: read_tideamp ! If true, spatially varying tidal amplitude read from a file. - - logical :: rigid_sea_ice ! If true, sea-ice exerts a rigidity that acts - ! to damp surface deflections (especially surface - ! gravity waves). The default is false. - real :: Kv_sea_ice ! viscosity in sea-ice that resists sheared vertical motions (m^2/s) - real :: density_sea_ice ! typical density of sea-ice (kg/m^3). The value is - ! only used to convert the ice pressure into - ! appropriate units for use with Kv_sea_ice. - real :: rigid_sea_ice_mass ! A mass per unit area of sea-ice beyond which - ! sea-ice viscosity becomes effective, in kg m-2, - ! typically of order 1000 kg m-2. - logical :: allow_flux_adjustments ! If true, use data_override to obtain flux adjustments - - real :: Flux_const ! piston velocity for surface restoring (m/s) - logical :: salt_restore_as_sflux ! If true, SSS restore as salt flux instead of water flux - logical :: adjust_net_srestore_to_zero ! adjust srestore to zero (for both salt_flux or vprec) - logical :: adjust_net_srestore_by_scaling ! adjust srestore w/o moving zero contour - logical :: adjust_net_fresh_water_to_zero ! adjust net surface fresh-water (w/ restoring) to zero - logical :: use_net_FW_adjustment_sign_bug ! use the wrong sign when adjusting net FW - logical :: adjust_net_fresh_water_by_scaling ! adjust net surface fresh-water w/o moving zero contour - logical :: mask_srestore_under_ice ! If true, use an ice mask defined by frazil - ! criteria for salinity restoring. - real :: ice_salt_concentration ! salt concentration for sea ice (kg/kg) - logical :: mask_srestore_marginal_seas ! if true, then mask SSS restoring in marginal seas - real :: max_delta_srestore ! maximum delta salinity used for restoring - real :: max_delta_trestore ! maximum delta sst used for restoring - real, pointer, dimension(:,:) :: basin_mask => NULL() ! mask for SSS restoring by basin - - type(diag_ctrl), pointer :: diag ! structure to regulate diagnostic output timing - character(len=200) :: inputdir ! directory where NetCDF input files are - character(len=200) :: salt_restore_file ! filename for salt restoring data - character(len=30) :: salt_restore_var_name ! name of surface salinity in salt_restore_file - logical :: mask_srestore ! if true, apply a 2-dimensional mask to the surface - ! salinity restoring fluxes. The masking file should be - ! in inputdir/salt_restore_mask.nc and the field should - ! be named 'mask' - real, pointer, dimension(:,:) :: srestore_mask => NULL() ! mask for SSS restoring - character(len=200) :: temp_restore_file ! filename for sst restoring data - character(len=30) :: temp_restore_var_name ! name of surface temperature in temp_restore_file - logical :: mask_trestore ! if true, apply a 2-dimensional mask to the surface - ! temperature restoring fluxes. The masking file should be - ! in inputdir/temp_restore_mask.nc and the field should - ! be named 'mask' - real, pointer, dimension(:,:) :: trestore_mask => NULL() ! mask for SST restoring - integer :: id_srestore = -1 ! id number for time_interp_external. - integer :: id_trestore = -1 ! id number for time_interp_external. + TKE_tidal => NULL(), & !< turbulent kinetic energy introduced to the + !! bottom boundary layer by drag on the tidal flows [W m-2] + gust => NULL(), & !< spatially varying unresolved background + !! gustiness that contributes to ustar [Pa]. + !! gust is used when read_gust_2d is true. + ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [m/s] + real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) + real :: utide !< constant tidal velocity to use if read_tideamp + !! is false [m s-1] + logical :: read_tideamp !< If true, spatially varying tidal amplitude read from a file. + + logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts + !! to damp surface deflections (especially surface + !! gravity waves). The default is false. + real :: Kv_sea_ice !! viscosity in sea-ice that resists sheared vertical motions [m^2/s] + real :: density_sea_ice !< typical density of sea-ice [kg/m^3]. The value is + !! only used to convert the ice pressure into + !! appropriate units for use with Kv_sea_ice. + real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which + !! sea-ice viscosity becomes effective, in kg m-2, + !! typically of order 1000 [kg m-2]. + logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments + + real :: Flux_const !< piston velocity for surface restoring [m/s] + logical :: salt_restore_as_sflux !< If true, SSS restore as salt flux instead of water flux + logical :: adjust_net_srestore_to_zero !< adjust srestore to zero (for both salt_flux or vprec) + logical :: adjust_net_srestore_by_scaling !< adjust srestore w/o moving zero contour + logical :: adjust_net_fresh_water_to_zero !< adjust net surface fresh-water (w/ restoring) to zero + logical :: use_net_FW_adjustment_sign_bug !< use the wrong sign when adjusting net FW + logical :: adjust_net_fresh_water_by_scaling !< adjust net surface fresh-water w/o moving zero contour + logical :: mask_srestore_under_ice !< If true, use an ice mask defined by frazil + !< criteria for salinity restoring. + real :: ice_salt_concentration !< salt concentration for sea ice [kg/kg] + logical :: mask_srestore_marginal_seas !< if true, then mask SSS restoring in marginal seas + real :: max_delta_srestore !< maximum delta salinity used for restoring + real :: max_delta_trestore !< maximum delta sst used for restoring + real, pointer, dimension(:,:) :: basin_mask => NULL() !< mask for SSS restoring by basin + + type(diag_ctrl), pointer :: diag !< structure to regulate diagnostic output timing + character(len=200) :: inputdir !< directory where NetCDF input files are + character(len=200) :: salt_restore_file !< filename for salt restoring data + character(len=30) :: salt_restore_var_name !< name of surface salinity in salt_restore_file + logical :: mask_srestore !< if true, apply a 2-dimensional mask to the surface + !< salinity restoring fluxes. The masking file should be + !< in inputdir/salt_restore_mask.nc and the field should + !! be named 'mask' + real, pointer, dimension(:,:) :: srestore_mask => NULL() !< mask for SSS restoring + character(len=200) :: temp_restore_file !< filename for sst restoring data + character(len=30) :: temp_restore_var_name !< name of surface temperature in temp_restore_file + logical :: mask_trestore !< if true, apply a 2-dimensional mask to the surface + !! temperature restoring fluxes. The masking file should be + !! in inputdir/temp_restore_mask.nc and the field should + !! be named 'mask' + real, pointer, dimension(:,:) :: trestore_mask => NULL() !< mask for SST restoring + integer :: id_srestore = -1 !< id number for time_interp_external. + integer :: id_trestore = -1 !< id number for time_interp_external. ! Diagnostics handles type(forcing_diags), public :: handles @@ -151,40 +150,39 @@ module MOM_surface_forcing type(user_revise_forcing_CS), pointer :: urf_CS => NULL() end type surface_forcing_CS -! ice_ocean_boundary_type is a structure corresponding to forcing, but with -! the elements, units, and conventions that exactly conform to the use for -! MOM-based coupled models. +!> Structure corresponding to forcing, but with the elements, units, and conventions +!! that exactly conform to the use for MOM-based coupled models. type, public :: ice_ocean_boundary_type - real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff (W/m2) - real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff (W/m2) - real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress (Pa) - real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress (Pa) - real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux (W/m2) - real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux (kg/m2/s) - real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux (kg/m2/s) - real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux (W/m2) - real, pointer, dimension(:,:) :: seaice_melt_water =>NULL() !< water flux due to sea ice and snow melting (kg/m2/s) - real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation (W/m2) - real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip (kg/m2/s) - real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip (kg/m2/s) - real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff (kg/m2/s) - real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff (kg/m2/s) - real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs (m/s) - real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs(m2/m2) + real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff [W/m2] + real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff [W/m2] + real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress [Pa] + real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress [Pa] + real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux [W/m2] + real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux [kg/m2/s] + real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux [kg/m2/s] + real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux [W/m2] + real, pointer, dimension(:,:) :: seaice_melt_water =>NULL() !< water flux due to sea ice and snow melting [kg/m2/s] + real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation [W/m2] + real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation [W/m2] + real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation [W/m2] + real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation [W/m2] + real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation [W/m2] + real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip [kg/m2/s] + real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip [kg/m2/s] + real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff [kg/m2/s] + real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff [kg/m2/s] + real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs [m/s] + real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs[m2/m2] real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2) - real, pointer, dimension(:,:) :: runoff_hflx =>NULL() !< heat content of liquid runoff (W/m2) - real, pointer, dimension(:,:) :: calving_hflx =>NULL() !< heat content of frozen runoff (W/m2) + real, pointer, dimension(:,:) :: runoff_hflx =>NULL() !< heat content of liquid runoff [W/m2] + real, pointer, dimension(:,:) :: calving_hflx =>NULL() !< heat content of frozen runoff [W/m2] real, pointer, dimension(:,:) :: p =>NULL() !< pressure of overlying ice and atmosphere - !< on ocean surface (Pa) - real, pointer, dimension(:,:) :: mi =>NULL() !< mass of ice (kg/m2) + !< on ocean surface [Pa] + real, pointer, dimension(:,:) :: mi =>NULL() !< mass of ice [kg/m2] real, pointer, dimension(:,:) :: ice_rigidity =>NULL() !< rigidity of the sea ice, sea-ice and !! ice-shelves, expressed as a coefficient !! for divergence damping, as determined - !! outside of the ocean model in (m3/s) + !! outside of the ocean model in [m3/s] integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of !! named fields used for passive tracer fluxes. @@ -197,9 +195,7 @@ module MOM_surface_forcing integer :: id_clock_forcing -!======================================================================= contains -!======================================================================= !> This subroutine translates the Ice_ocean_boundary_type into a MOM !! thermodynamic forcing type, including changes of units, sign conventions, @@ -223,34 +219,34 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & logical, optional, intent(in) :: restore_salt !< If true, salinity is restored to a target value. logical, optional, intent(in) :: restore_temp !< If true, temperature is restored to a target value. - + ! local varibles real, dimension(SZI_(G),SZJ_(G)) :: & - data_restore, & ! The surface value toward which to restore (g/kg or degC) - SST_anom, & ! Instantaneous sea surface temperature anomalies from a target value (deg C) - SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target value (g/kg) - SSS_mean, & ! A (mean?) salinity about which to normalize local salinity - ! anomalies when calculating restorative precipitation anomalies (g/kg) - PmE_adj, & ! The adjustment to PminusE that will cause the salinity - ! to be restored toward its target value (kg/(m^2 * s)) - net_FW, & ! The area integrated net freshwater flux into the ocean (kg/s) - net_FW2, & ! The area integrated net freshwater flux into the ocean (kg/s) - work_sum, & ! A 2-d array that is used as the work space for a global - ! sum, used with units of m2 or (kg/s) - open_ocn_mask ! a binary field indicating where ice is present based on frazil criteria + data_restore, & !< The surface value toward which to restore [g/kg or degC] + SST_anom, & !< Instantaneous sea surface temperature anomalies from a target value [deg C] + SSS_anom, & !< Instantaneous sea surface salinity anomalies from a target value [g/kg] + SSS_mean, & !< A (mean?) salinity about which to normalize local salinity + !! anomalies when calculating restorative precipitation anomalies [g/kg] + PmE_adj, & !< The adjustment to PminusE that will cause the salinity + !! to be restored toward its target value [kg/(m^2 * s)] + net_FW, & !< The area integrated net freshwater flux into the ocean [kg/s] + net_FW2, & !< The area integrated net freshwater flux into the ocean [kg/s] + work_sum, & !< A 2-d array that is used as the work space for a global + !! sum, used with units of m2 or [kg/s] + open_ocn_mask !< a binary field indicating where ice is present based on frazil criteria integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd - logical :: restore_salinity ! local copy of the argument restore_salt, if it - ! is present, or false (no restoring) otherwise. - logical :: restore_sst ! local copy of the argument restore_temp, if it - ! is present, or false (no restoring) otherwise. - real :: delta_sss ! temporary storage for sss diff from restoring value - real :: delta_sst ! temporary storage for sst diff from restoring value + logical :: restore_salinity !< local copy of the argument restore_salt, if it + !! is present, or false (no restoring) otherwise. + logical :: restore_sst !< local copy of the argument restore_temp, if it + !! is present, or false (no restoring) otherwise. + real :: delta_sss !< temporary storage for sss diff from restoring value + real :: delta_sst !< temporary storage for sst diff from restoring value - real :: C_p ! heat capacity of seawater ( J/(K kg) ) - real :: sign_for_net_FW_bug ! Should be +1. but an old bug can be recovered by using -1. + real :: C_p !< heat capacity of seawater ( J/(K kg) ) + real :: sign_for_net_FW_bug !< Should be +1. but an old bug can be recovered by using -1. call cpu_clock_begin(id_clock_forcing) @@ -463,11 +459,11 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & if (associated(IOB%t_flux)) & fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - ! ! sea ice and snow melt heat flux (W/m2) + ! ! sea ice and snow melt heat flux [W/m2] ! if (associated(fluxes%seaice_melt_heat)) & ! fluxes%seaice_melt_heat(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0) - ! ! water flux due to sea ice and snow melt (kg/m2/s) + ! ! water flux due to sea ice and snow melt [kg/m2/s] ! if (associated(fluxes%seaice_melt)) & ! fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_water(i-i0,j-j0) @@ -590,8 +586,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & end subroutine convert_IOB_to_fluxes -!======================================================================= - !> This subroutine translates the Ice_ocean_boundary_type into a MOM !! mechanical forcing type, including changes of units, sign conventions, !! and putting the fields into arrays with MOM-standard halos. @@ -607,26 +601,26 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. - + ! local variables real, dimension(SZIB_(G),SZJB_(G)) :: & - taux_at_q, & ! Zonal wind stresses at q points (Pa) - tauy_at_q ! Meridional wind stresses at q points (Pa) + taux_at_q, & !< Zonal wind stresses at q points [Pa] + tauy_at_q !< Meridional wind stresses at q points [Pa] real, dimension(SZI_(G),SZJ_(G)) :: & - rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1) - taux_at_h, & ! Zonal wind stresses at h points (Pa) - tauy_at_h ! Meridional wind stresses at h points (Pa) - - real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) - real :: Irho0 ! inverse of the mean density in (m^3/kg) - real :: taux2, tauy2 ! squared wind stresses (Pa^2) - real :: tau_mag ! magnitude of the wind stress (Pa) - real :: I_GEarth ! 1.0 / G%G_Earth (s^2/m) - real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) - real :: mass_ice ! mass of sea ice at a face (kg/m^2) - real :: mass_eff ! effective mass of sea ice for rigidity (kg/m^2) - - integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) + rigidity_at_h, & !< Ice rigidity at tracer points (m3 s-1) + taux_at_h, & !< Zonal wind stresses at h points [Pa] + tauy_at_h !< Meridional wind stresses at h points [Pa] + + real :: gustiness !< unresolved gustiness that contributes to ustar [Pa] + real :: Irho0 !< inverse of the mean density in (m^3/kg) + real :: taux2, tauy2 !< squared wind stresses (Pa^2) + real :: tau_mag !< magnitude of the wind stress [Pa] + real :: I_GEarth !< 1.0 / G%G_Earth (s^2/m) + real :: Kv_rho_ice !< (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) + real :: mass_ice !< mass of sea ice at a face (kg/m^2) + real :: mass_eff !< effective mass of sea ice for rigidity (kg/m^2) + + integer :: wind_stagger !< AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd @@ -876,8 +870,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) call cpu_clock_end(id_clock_forcing) end subroutine convert_IOB_to_forces -!======================================================================= - !> Adds thermodynamic flux adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: @@ -891,7 +883,7 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) type(forcing), intent(inout) :: fluxes !< Surface fluxes structure ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: temp_at_h ! Fluxes at h points (W m-2 or kg m-2 s-1) + real, dimension(SZI_(G),SZJ_(G)) :: temp_at_h !< Fluxes at h points [W m-2 or kg m-2 s-1] integer :: isc, iec, jsc, jec, i, j logical :: overrode_h @@ -923,8 +915,6 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) ! Not needed? ! if (overrode_h) call pass_var(fluxes%vprec, G%Domain) end subroutine apply_flux_adjustments -!======================================================================= - !> Adds mechanical forcing adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: @@ -937,8 +927,8 @@ subroutine apply_force_adjustments(G, CS, Time, forces) type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h ! Delta to zonal wind stress at h points (Pa) - real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h ! Delta to meridional wind stress at h points (Pa) + real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h !< Delta to zonal wind stress at h points [Pa] + real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h !< Delta to meridional wind stress at h points [Pa] integer :: isc, iec, jsc, jec, i, j real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau @@ -983,8 +973,6 @@ subroutine apply_force_adjustments(G, CS, Time, forces) end subroutine apply_force_adjustments -!======================================================================= - !> Save any restart files associated with the surface forcing. subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) @@ -1005,8 +993,6 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart -!======================================================================= - !> Initialize the surface forcing, including setting parameters and allocating permanent memory. subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) type(time_type), intent(in) :: Time !< The current model time @@ -1339,8 +1325,6 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res call cpu_clock_end(id_clock_forcing) end subroutine surface_forcing_init -!======================================================================= - !> Clean up and deallocate any memory associated with this module and its children. subroutine surface_forcing_end(CS, fluxes) type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by @@ -1359,8 +1343,6 @@ subroutine surface_forcing_end(CS, fluxes) end subroutine surface_forcing_end -!======================================================================= - !> Write out a set of messages with checksums of the fields in an ice_ocen_boundary type subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) @@ -1369,6 +1351,8 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) type(ice_ocean_boundary_type), & intent(in) :: iobt !< An ice-ocean boundary type with fluxes to drive the !! ocean in a coupled model whose checksums are reported + + ! local variables integer :: n,m, outunit outunit = stdout() From aefb2e328c89887b3b0ccffd1e3bab84a3de9381 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 21 Mar 2019 17:41:08 -0600 Subject: [PATCH 55/77] Remove space, doxygenize and add "use, only" --- config_src/nuopc_driver/mom_cap.F90 | 811 +++++++++++++++------------- 1 file changed, 423 insertions(+), 388 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 7ac1f18e2b..00e56ffac0 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -307,6 +307,8 @@ !! which to call `ocean_model_restart()`; no restarts written if set to 0 !! !! + +!> This module contains a set of subroutines that are required by NUOPC. module mom_cap_mod use constants_mod, only: constants_init use diag_manager_mod, only: diag_manager_init, diag_manager_end @@ -350,7 +352,30 @@ module mom_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit -use ESMF +! TODO add only below. +use ESMF, only: ESMF_ClockAdvance, ESMF_ClockGet, ESMF_ClockPrint +use ESMF, only: ESMF_ClockGetAlarm, ESMF_ClockGetNextTime, ESMF_ClockAdvance +use ESMF, only: ESMF_ClockSet, ESMF_Clock, ESMF_GeomType_Flag, ESMF_LOGMSG_INFO +use ESMF, only: ESMF_Grid, ESMF_GridCreate, ESMF_GridAddCoord +use ESMF, only: ESMF_GridGetCoord, ESMF_GridAddItem, ESMF_GridGetItem +use ESMF, only: ESMF_GridComp, ESMF_GridCompSetEntryPoint, ESMF_GridCompGet +use ESMF, only: ESMF_LogFoundError, ESMF_LogWrite, ESMF_LogSetError +use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_GridCompGetInternalState +use ESMF, only: ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_SUCCESS +use ESMF, only: ESMF_METHOD_INITIALIZE, ESMF_MethodRemove, ESMF_State +use ESMF, only: ESMF_LOGMSG_INFO, ESMF_RC_ARG_BAD, ESMF_VM, ESMF_Time +use ESMF, only: ESMF_TimeInterval, ESMF_MAXSTR, ESMF_VMGetCurrent +use ESMF, only: ESMF_VMGet, ESMF_TimeGet, ESMF_TimeIntervalGet +use ESMF, only: ESMF_MethodExecute, ESMF_Mesh, ESMF_DeLayout, ESMF_Distgrid +use ESMF, only: ESMF_DistGridConnection, ESMF_StateItem_Flag, ESMF_KIND_I4 +use ESMF, only: ESMF_KIND_I8, ESMF_FAILURE, ESMF_DistGridCreate, ESMF_MeshCreate +use ESMF, only: ESMF_FILEFORMAT_ESMFMESH, ESMF_DELayoutCreate, ESMF_DistGridConnectionSet +use ESMF, only: ESMF_DistGridGet, ESMF_STAGGERLOC_CORNER, ESMF_GRIDITEM_MASK +use ESMF, only: ESMF_TYPEKIND_I4, ESMF_TYPEKIND_R8, ESMF_STAGGERLOC_CENTER, +use ESMF, only: ESMF_GRIDITEM_AREA, ESMF_Field, ESMF_ALARM, ESMF_VMLogMemInfo +use ESMF, only: ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_StateRemove +use ESMF, only: ESMF_FieldCreate + use NUOPC use NUOPC_Model, & model_routine_SS => SetServices, & @@ -359,20 +384,29 @@ module mom_cap_mod model_label_SetRunClock => label_SetRunClock, & model_label_Finalize => label_Finalize +! TODO GMM, where are these coming from? thye do not have an explicit fortran interface +! ESMF_GridCompGetInternalState +! +! And these? +! ESMF_LOGERR_PASSTHRU implicit none; private public SetServices +!> Internal state type with pointers to three types defined by MOM. type ocean_internalstate_type type(ocean_public_type), pointer :: ocean_public_type_ptr type(ocean_state_type), pointer :: ocean_state_type_ptr type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr end type +!> Wrapper-derived type required to associate an internal state instance +!! with the ESMF/NUOPC component type ocean_internalstate_wrapper type(ocean_internalstate_type), pointer :: ptr end type +!> Contains field information type fld_list_type character(len=64) :: stdname character(len=64) :: shortname @@ -390,8 +424,8 @@ module mom_cap_mod integer :: export_slice = 1 character(len=256) :: tmpstr logical :: write_diagnostics = .false. -character(len=32) :: runtype ! run type -integer :: logunit ! stdout logging unit number +character(len=32) :: runtype !< run type +integer :: logunit !< stdout logging unit number logical :: profile_memory = .true. logical :: grid_attach_area = .false. character(len=128) :: scalar_field_name = '' @@ -409,11 +443,8 @@ module mom_cap_mod type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID #endif -!======================================================================= contains -!======================================================================= -!=============================================================================== !> NUOPC SetService method is the only public entry point. !! SetServices registers all of the user-provided subroutines !! in the module with the NUOPC layer. @@ -422,8 +453,10 @@ module mom_cap_mod !! @param rc return code subroutine SetServices(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp !< an ESMF_GridComp object + integer, intent(out) :: rc !< return code + + ! local variables character(len=*),parameter :: subname='(mom_cap:SetServices)' rc = ESMF_SUCCESS @@ -496,8 +529,6 @@ subroutine SetServices(gcomp, rc) end subroutine SetServices -!=============================================================================== - !> First initialize subroutine called by NUOPC. The purpose !! is to set which version of the Initialize Phase Definition (IPD) !! to use. @@ -510,11 +541,13 @@ end subroutine SetServices !! @param clock an ESMF_Clock object !! @param rc return code subroutine InitializeP0(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp !< ESMF_GridComp object + type(ESMF_State) :: importState, exportState !< ESMF_State object for + !! import/export fields + type(ESMF_Clock) :: clock !< ESMF_Clock object + integer, intent(out) :: rc !< return code + ! local variables logical :: isPresent, isSet integer :: iostat character(len=64) :: value, logmsg @@ -587,9 +620,9 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) scalar_field_name = trim(value) call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return endif scalar_field_count = 0 @@ -602,17 +635,17 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ScalarFieldCount not an integer: "//trim(value), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldCount not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif write(logmsg,*) scalar_field_count call ESMF_LogWrite('mom_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return endif scalar_field_idx_grid_nx = 0 @@ -625,17 +658,17 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ScalarFieldIdxGridNX not an integer: "//trim(value), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldIdxGridNX not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif write(logmsg,*) scalar_field_idx_grid_nx call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return endif scalar_field_idx_grid_ny = 0 @@ -648,17 +681,17 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ScalarFieldIdxGridNY not an integer: "//trim(value), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldIdxGridNY not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif write(logmsg,*) scalar_field_idx_grid_ny call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return endif call NUOPC_CompAttributeAdd(gcomp, & @@ -670,8 +703,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) end subroutine -!=============================================================================== - !> Called by NUOPC to advertise import and export fields. "Advertise" !! simply means that the standard names of all import and export !! fields are supplied. The NUOPC layer uses these to match fields @@ -683,11 +714,13 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) !! @param clock an ESMF_Clock object !! @param rc return code subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp !< ESMF_GridComp object + type(ESMF_State) :: importState, exportState !< ESMF_State object for + !! import/export fields + type(ESMF_Clock) :: clock !< ESMF_Clock object + integer, intent(out) :: rc !< return code + ! local variables type(ESMF_VM) :: vm type(ESMF_Time) :: MyTime type(ESMF_TimeInterval) :: TINT @@ -780,21 +813,21 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! reset shr logging to my log file if (is_root_pe()) then call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & - isPresent=isPresentDiro, rc=rc) + isPresent=isPresentDiro, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, & - isPresent=isPresentLogfile, rc=rc) + isPresent=isPresentLogfile, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return if (isPresentDiro .and. isPresentLogfile) then - open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else - logunit = output_unit + logunit = output_unit endif else logunit = output_unit @@ -811,11 +844,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) read(cvalue,*) starttype else call ESMF_LogWrite('mom_cap:start_type unset - using input.nml for restart option', & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return endif runtype = "" @@ -827,17 +860,17 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) runtype = "continue" else if (len_trim(starttype) > 0) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": unknown starttype - "//trim(starttype), & - line=__LINE__, file=__FILE__, rcToReturn=rc) + msg=subname//": unknown starttype - "//trim(starttype), & + line=__LINE__, file=__FILE__, rcToReturn=rc) return endif if (len_trim(runtype) > 0) then call ESMF_LogWrite('mom_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return endif restartfile = "" @@ -848,43 +881,43 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! optionally call into system-specific implementation to get restart file name call ESMF_MethodExecute(gcomp, label="GetRestartFileToRead", & - existflag=existflag, userRc=userRc, rc=rc) + existflag=existflag, userRc=userRc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (existflag) then - call ESMF_LogWrite('mom_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('mom_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return endif call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & - value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return if (isPresent .and. isSet) then - restartfile = trim(cvalue) - call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + restartfile = trim(cvalue) + call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return else - call ESMF_LogWrite('mom_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',& - ESMF_LOGMSG_WARNING, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('mom_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',& + ESMF_LOGMSG_WARNING, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return endif end if @@ -901,25 +934,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% mi (isc:iec,jsc:jec), & - Ice_ocean_boundary% p (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec)) + Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% mi (isc:iec,jsc:jec), & + Ice_ocean_boundary% p (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec)) Ice_ocean_boundary%u_flux = 0.0 Ice_ocean_boundary%v_flux = 0.0 @@ -951,8 +984,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (cesm_coupled) then if (len_trim(scalar_field_name) > 0) then - call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") endif !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") @@ -1019,7 +1052,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end subroutine InitializeAdvertise -!=============================================================================== !> Called by NUOPC to realize import and export fields. "Realizing" a field !! means that its grid has been defined and an ESMF_Field object has been !! created and put into the import or export State. @@ -1029,12 +1061,12 @@ end subroutine InitializeAdvertise !! @param exportState an ESMF_State object for export fields !! @param clock an ESMF_Clock object !! @param rc return code - subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp !< ESMF_GridComp object + type(ESMF_State) :: importState, exportState !< ESMF_State object for + !! import/export fields + type(ESMF_Clock) :: clock !< ESMF_Clock object + integer, intent(out) :: rc !< return code ! Local Variables type(ESMF_VM) :: vm @@ -1134,9 +1166,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) rc = ESMF_FAILURE call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return endif ntiles=mpp_get_domain_npes(ocean_public%domain) write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles @@ -1155,12 +1187,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call mpp_get_pelist(ocean_public%domain, pe) if (debug > 0) then do n = 1,ntiles - write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return enddo end if @@ -1184,55 +1216,56 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) allocate(gindex(lsize)) k = 0 do j = ocean_grid%jsc, ocean_grid%jec - jg = j + ocean_grid%jdg_offset - do i = ocean_grid%isc, ocean_grid%iec - ig = i + ocean_grid%idg_offset - k = k + 1 ! Increment position within gindex - gindex(k) = ni * (jg - 1) + ig - enddo + jg = j + ocean_grid%jdg_offset + do i = ocean_grid%isc, ocean_grid%iec + ig = i + ocean_grid%idg_offset + k = k + 1 ! Increment position within gindex + gindex(k) = ni * (jg - 1) + ig + enddo enddo DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return ! read in the mesh call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=cvalue, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return + if (localPet == 0) then - write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) + write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) end if ! recreate the mesh using the above distGrid EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return ! realize the import and export fields using the mesh call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", mesh=Emesh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", mesh=Emesh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return else if (geomtype == ESMF_GEOMTYPE_GRID) then @@ -1247,26 +1280,26 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) allocate(deLabelList(ntiles)) do n = 1, ntiles - deLabelList(n) = n - deBlockList(1,1,n) = xb(n) - deBlockList(1,2,n) = xe(n) - deBlockList(2,1,n) = yb(n) - deBlockList(2,2,n) = ye(n) - petMap(n) = pe(n) - ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side + deLabelList(n) = n + deBlockList(1,1,n) = xb(n) + deBlockList(1,2,n) = xe(n) + deBlockList(2,1,n) = yb(n) + deBlockList(2,2,n) = ye(n) + petMap(n) = pe(n) + ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side enddo delayout = ESMF_DELayoutCreate(petMap, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! rsd this assumes tripole grid, but sometimes in CESM a bipole ! grid is used -- need to introduce conditional logic here @@ -1275,32 +1308,32 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! bipolar boundary condition at top row: nyg call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & - orientationVector=(/-1, -2/), rc=rc) + tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & + orientationVector=(/-1, -2/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! periodic boundary condition along first dimension call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) + tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & - ! indexflag = ESMF_INDEX_DELOCAL, & - deBlockList=deBlockList, & - ! deLabelList=deLabelList, & - delayout=delayout, & - connectionList=connectionList, & - rc=rc) + ! indexflag = ESMF_INDEX_DELOCAL, & + deBlockList=deBlockList, & + ! deLabelList=deLabelList, & + delayout=delayout, & + connectionList=connectionList, & + rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return deallocate(xb,xe,yb,ye,pe) deallocate(connectionList) @@ -1310,113 +1343,125 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + allocate(indexList(cnt)) write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& - indexList(1),indexList(cnt),minval(indexList), maxval(indexList) + indexList(1),indexList(cnt),minval(indexList), maxval(indexList) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return + deallocate(IndexList) ! create grid gridIn = ESMF_GridCreate(distgrid=distgrid, & - gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & - coordSys = ESMF_COORDSYS_SPH_DEG, & - rc = rc) + gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & + coordSys = ESMF_COORDSYS_SPH_DEG, & + rc = rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! Attach area to the Grid optionally. By default the cell areas are computed. if(grid_attach_area) then - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_xcen, rc=rc) + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_xcen, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_ycen, rc=rc) + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_ycen, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_xcor, rc=rc) + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_xcor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_ycor, rc=rc) + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_ycor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_mask, rc=rc) + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_mask, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + if(grid_attach_area) then - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_area, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_area, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return endif ! load up area, mask, center and corner values @@ -1448,38 +1493,38 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": fld and grid do not have the same size.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": fld and grid do not have the same size.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif do j = jsc, jec j1 = j + lbnd2 - jsc jg = j + ocean_grid%jsc - jsc do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + ocean_grid%isc - isc - dataPtr_mask(i1,j1) = ocean_grid%mask2dT(ig,jg) - dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) - dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) - if(grid_attach_area) then - dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) - end if + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + dataPtr_mask(i1,j1) = ocean_grid%mask2dT(ig,jg) + dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) + dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) + if(grid_attach_area) then + dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) + end if end do end do - jlast = jec + jlast = jec if(jec == nyg)jlast = jec+1 do j = jsc, jlast j1 = j + lbnd4 - jsc jg = j + ocean_grid%jsc - jsc - 1 do i = isc, iec - i1 = i + lbnd3 - isc - ig = i + ocean_grid%isc - isc - 1 - dataPtr_xcor(i1,j1) = ocean_grid%geolonBu(ig,jg) - dataPtr_ycor(i1,j1) = ocean_grid%geolatBu(ig,jg) + i1 = i + lbnd3 - isc + ig = i + ocean_grid%isc - isc - 1 + dataPtr_xcor(i1,j1) = ocean_grid%geolonBu(ig,jg) + dataPtr_ycor(i1,j1) = ocean_grid%geolatBu(ig,jg) end do end do @@ -1487,8 +1532,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if(grid_attach_area) then - write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) endif write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) @@ -1507,15 +1552,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", grid=gridIn, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", grid=gridOut, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return end if @@ -1525,18 +1570,19 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (len_trim(scalar_field_name) > 0) then call State_SetScalar(dble(nxg),scalar_field_idx_grid_nx, exportState, localPet, & - scalar_field_name, scalar_field_count, rc) + scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & - scalar_field_name, scalar_field_count, rc) + scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + endif !--------------------------------- @@ -1557,11 +1603,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end subroutine InitializeRealize -!=============================================================================== - +!> TODO +!! +!! @param gcomp an ESMF_GridComp object +!! @param rc return code subroutine DataInitialize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp !< ESMF_GridComp object + integer, intent(out) :: rc !< return code ! local variables type(ESMF_Clock) :: clock @@ -1599,9 +1647,9 @@ subroutine DataInitialize(gcomp, rc) if (cesm_coupled) then call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out end if call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) @@ -1654,20 +1702,18 @@ subroutine DataInitialize(gcomp, rc) end subroutine DataInitialize -!=============================================================================== - !> Called by NUOPC to advance the model a single timestep. !! !! @param gcomp an ESMF_GridComp object !! @param rc return code subroutine ModelAdvance(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp !< ESMF_GridComp object + integer, intent(out) :: rc !< return code ! local variables integer :: userRc logical :: existflag, isPresent, isSet - type(ESMF_Clock) :: clock + type(ESMF_Clock) :: clock!< ESMF Clock class definition type(ESMF_Alarm) :: alarm type(ESMF_State) :: importState, exportState type(ESMF_Time) :: currTime @@ -1691,7 +1737,6 @@ subroutine ModelAdvance(gcomp, rc) character(ESMF_MAXSTR) :: restartname, cvalue character(240) :: msgString character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' - !-------------------------------- rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") @@ -1815,76 +1860,77 @@ subroutine ModelAdvance(gcomp, rc) call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! call into system specific method to get desired restart filename restartname = "" call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & - existflag=existflag, userRc=userRc, rc=rc) + existflag=existflag, userRc=userRc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (existflag) then - call ESMF_LogWrite("mom_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompAttributeGet(gcomp, name='RestartFileToWrite', & - isPresent=isPresent, isSet=isSet, value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent .and. isSet) then - restartname = trim(cvalue) - call ESMF_LogWrite("mom_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif + call ESMF_LogWrite("mom_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToWrite', & + isPresent=isPresent, isSet=isSet, value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + restartname = trim(cvalue) + call ESMF_LogWrite("mom_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif endif if (len_trim(restartname) == 0) then - ! none provided, so use a default restart filename - call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, & - h=hour, m=minute, s=seconds, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & - "ocn", year, month, day, hour, minute, seconds - call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! none provided, so use a default restart filename + call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, & + h=hour, m=minute, s=seconds, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + "ocn", year, month, day, hour, minute, seconds + call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out endif ! TODO: address if this requirement is being met for the DA group @@ -1920,11 +1966,11 @@ subroutine ModelAdvance(gcomp, rc) if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & - timeslice=export_slice, relaxedFlag=.true., rc=rc) + timeslice=export_slice, relaxedFlag=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out export_slice = export_slice + 1 endif @@ -1932,7 +1978,6 @@ subroutine ModelAdvance(gcomp, rc) end subroutine ModelAdvance -!=============================================================================== subroutine ModelSetRunClock(gcomp, rc) type(ESMF_GridComp) :: gcomp @@ -1993,8 +2038,8 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & - msg=subname//": ERROR in time consistency: "//trim(dtimestring)//" != "//trim(mtimestring), & - line=__LINE__, file=__FILE__, rcToReturn=rc) + msg=subname//": ERROR in time consistency: "//trim(dtimestring)//" != "//trim(mtimestring), & + line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -2103,9 +2148,8 @@ end subroutine ModelSetRunClock !! @param rc return code subroutine ocean_model_finalize(gcomp, rc) - ! input arguments - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp !< ESMF_GridComp object + integer, intent(out) :: rc !< return code ! local variables type (ocean_public_type), pointer :: ocean_public @@ -2156,20 +2200,16 @@ subroutine ocean_model_finalize(gcomp, rc) end subroutine ocean_model_finalize -!=============================================================================== +!> Set scalar data from state for a particula name subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_count, rc) - ! ---------------------------------------------- - ! Set scalar data from State for a particular name - ! ---------------------------------------------- - real(ESMF_KIND_R8),intent(in) :: value integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask character(len=*), intent(in) :: scalar_name integer, intent(in) :: scalar_count - integer, intent(inout) :: rc + integer, intent(inout) :: rc !< return code ! local variables type(ESMF_Field) :: field @@ -2198,11 +2238,9 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ end subroutine State_SetScalar -!=============================================================================== - +!> TODO subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) - ! input/output variables type(ESMF_State) , intent(inout) :: state integer , intent(in) :: nfields type(fld_list_type) , intent(inout) :: field_defs(:) @@ -2328,23 +2366,23 @@ subroutine SetScalarField(field, rc) ! create a DistGrid with a single index space element, which gets mapped onto DE 0. distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out grid = ESMF_GridCreate(distgrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! num of scalar values field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) + ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out end subroutine SetScalarField @@ -2352,10 +2390,8 @@ end subroutine MOM_RealizeFields !=============================================================================== +!> Set up list of field information subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) - ! ---------------------------------------------- - ! Set up a list of field information - ! ---------------------------------------------- integer, intent(inout) :: num type(fld_list_type), intent(inout) :: fldlist(:) character(len=*), intent(in) :: stdname @@ -2370,8 +2406,8 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) num = num + 1 if (num > fldsMax) then call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & - msg=trim(subname)//": ERROR number of field exceeded fldsMax: "//trim(stdname), & - line=__LINE__, file=__FILE__, rcToReturn=rc) + msg=trim(subname)//": ERROR number of field exceeded fldsMax: "//trim(stdname), & + line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -2385,7 +2421,6 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) end subroutine fld_list_add -!======================================================================= #ifndef CESMCOUPLED subroutine shr_file_setLogUnit(nunit) From acf99c85c0f9e6d13ee2b2d514ea3865c435c64c Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 25 Mar 2019 16:13:52 -0600 Subject: [PATCH 56/77] Doxygenize --- config_src/nuopc_driver/time_utils.F90 | 58 +++++++++++++------------- 1 file changed, 30 insertions(+), 28 deletions(-) diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 index 430114840d..e8effdd05b 100644 --- a/config_src/nuopc_driver/time_utils.F90 +++ b/config_src/nuopc_driver/time_utils.F90 @@ -1,3 +1,4 @@ +!> Set of subroutines that convert date/time between FMS and ESMF formats. module time_utils_mod use fms_mod, only: uppercase @@ -9,11 +10,13 @@ module time_utils_mod implicit none; private -!-------------------- interface blocks --------------------- +!> Converts calendar from FMS to ESMF format interface fms2esmf_cal module procedure fms2esmf_cal_c module procedure fms2esmf_cal_i end interface fms2esmf_cal + +!> Converts time from FMS to ESMF format interface esmf2fms_time module procedure esmf2fms_time_t module procedure esmf2fms_timestep @@ -26,13 +29,10 @@ module time_utils_mod contains -!-------------------- module code --------------------- - +!> Sets fms2esmf_cal_c to the corresponding ESMF calendar type function fms2esmf_cal_c(calendar) -! ! Return Value: - type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c -! ! Arguments: - character(len=*), intent(in) :: calendar + type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c !< ESMF calendar type + character(len=*), intent(in) :: calendar !< Type of calendar select case( uppercase(trim(calendar)) ) case( 'GREGORIAN' ) @@ -51,11 +51,10 @@ function fms2esmf_cal_c(calendar) end select end function fms2esmf_cal_c +!> Sets fms2esmf_cal_i to the corresponding ESMF calendar type function fms2esmf_cal_i(calendar) -! ! Return Value: - type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i -! ! Arguments: - integer, intent(in) :: calendar + type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i !< ESMF calendar structure + integer, intent(in) :: calendar !< Type of calendar select case(calendar) case(THIRTY_DAY_MONTHS) @@ -71,11 +70,11 @@ function fms2esmf_cal_i(calendar) end select end function fms2esmf_cal_i +!> Converts date from ESMF format to FMS format. function esmf2fms_time_t(time) - ! Return Value - type(Time_type) :: esmf2fms_time_t - ! Input Arguments - type(ESMF_Time), intent(in) :: time + type(Time_type) :: esmf2fms_time_t !< FMS time structure + type(ESMF_Time), intent(in) :: time !< ESMF time structure + ! Local Variables integer :: yy, mm, dd, h, m, s type(ESMF_CALKIND_FLAG) :: calkind @@ -89,15 +88,15 @@ function esmf2fms_time_t(time) file=__FILE__)) & return ! bail out - esmf2fms_time_t = Set_date(yy, mm, dd, h, m, s) + esmf2fms_time_t = set_date(yy, mm, dd, h, m, s) end function esmf2fms_time_t +!> Converts time-interval from ESMF format to FMS format. function esmf2fms_timestep(timestep) - ! Return Value - type(Time_type) :: esmf2fms_timestep - ! Input Arguments - type(ESMF_TimeInterval), intent(in):: timestep + type(Time_type) :: esmf2fms_timestep !< FMS time structure + type(ESMF_TimeInterval), intent(in):: timestep !< time-interval following + !! ESMF format [s] ! Local Variables integer :: s type(ESMF_CALKIND_FLAG) :: calkind @@ -114,12 +113,12 @@ function esmf2fms_timestep(timestep) end function esmf2fms_timestep +!> Converts date from FMS format to ESMF format. function fms2esmf_time(time, calkind) - ! Return Value - type(ESMF_Time) :: fms2esmf_time - ! Input Arguments - type(Time_type), intent(in) :: time - type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind + type(ESMF_Time) :: fms2esmf_time !< ESMF time structure + type(time_type), intent(in) :: time !< FMS time structure + type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind !< ESMF calendar structure + ! Local Variables integer :: yy, mm, d, h, m, s type(ESMF_CALKIND_FLAG) :: l_calkind @@ -143,11 +142,14 @@ function fms2esmf_time(time, calkind) end function fms2esmf_time +!> Converts a string (I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2) that represents +!! yr, mon, day, hr, min, sec to a FMS data format. function string_to_date(string, rc) - character(len=15), intent(in) :: string - integer, intent(out), optional :: rc - type(time_type) :: string_to_date + character(len=15), intent(in) :: string !< String representing a date + integer, intent(out), optional :: rc !< ESMF error handler + type(time_type) :: string_to_date!< FMS time structure + ! Local variables integer :: yr,mon,day,hr,min,sec if(present(rc)) rc = ESMF_SUCCESS From f19bbd4761faf096404e850ae3cb029f5e820ed6 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 25 Mar 2019 16:20:20 -0600 Subject: [PATCH 57/77] Adding "use, only: to import ESMF modules --- config_src/nuopc_driver/time_utils.F90 | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 index e8effdd05b..49bad199a1 100644 --- a/config_src/nuopc_driver/time_utils.F90 +++ b/config_src/nuopc_driver/time_utils.F90 @@ -1,12 +1,19 @@ !> Set of subroutines that convert date/time between FMS and ESMF formats. module time_utils_mod -use fms_mod, only: uppercase -use mpp_mod, only: mpp_error, FATAL -use time_manager_mod, only: time_type, set_time, set_date, get_date -use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR -use time_manager_mod, only: fms_get_calendar_type => get_calendar_type -use ESMF +! FMS +use fms_mod, only: uppercase +use mpp_mod, only: mpp_error, FATAL +use time_manager_mod, only: time_type, set_time, set_date, get_date +use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR +use time_manager_mod, only: fms_get_calendar_type => get_calendar_type +! ESMF +use ESMF, only: ESMF_CALKIND_FLAG, ESMF_CALKIND_GREGORIAN +use ESMF, only: ESMF_CALKIND_JULIAN, ESMF_CALKIND_NOLEAP +use ESMF, only: ESMF_CALKIND_360DAY, ESMF_CALKIND_NOCALENDAR +use ESMF, only: ESMF_Time, ESMF_TimeGet, ESMF_LogFoundError +use ESMF, only: ESMF_LOGERR_PASSTHRU,ESMF_TimeInterval +use ESMF, only: ESMF_TimeIntervalGet, ESMF_TimeSet, ESMF_SUCCESS implicit none; private From 75728019ea0c98766e36034d0e641002d079293d Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 25 Mar 2019 16:56:04 -0600 Subject: [PATCH 58/77] Clean code --- config_src/nuopc_driver/mom_cap.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 00e56ffac0..eb889e71e9 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -384,11 +384,6 @@ module mom_cap_mod model_label_SetRunClock => label_SetRunClock, & model_label_Finalize => label_Finalize -! TODO GMM, where are these coming from? thye do not have an explicit fortran interface -! ESMF_GridCompGetInternalState -! -! And these? -! ESMF_LOGERR_PASSTHRU implicit none; private public SetServices From aa4a2c0cd8966dd8a0ce72d6f73f1c235d405ab7 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 26 Mar 2019 16:32:46 -0600 Subject: [PATCH 59/77] Add documentation --- config_src/nuopc_driver/mom_cap_methods.F90 | 191 +++++++++----------- 1 file changed, 88 insertions(+), 103 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 67c064194d..adb3915787 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,7 +1,6 @@ +!> Contains import/export methods for both NEMS and CMEPS. module mom_cap_methods -! Cap import/export methods for both NEMS and CMEPS - use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet use ESMF, only: ESMF_State, ESMF_StateGet @@ -33,33 +32,31 @@ module mom_cap_methods private :: State_getImport private :: State_setExport +!> Get field pointer interface State_GetFldPtr module procedure State_GetFldPtr_1d module procedure State_GetFldPtr_2d end interface -integer :: import_cnt = 0 -type(ESMF_GeomType_Flag) :: geomtype +integer :: import_cnt = 0!< used to skip using the import state + !! at the first count for cesm +type(ESMF_GeomType_Flag) :: geomtype !< SMF type describing type of + !! geometry (mesh or grid) -!=============================================================================== contains -!=============================================================================== +!> Sets module variable geometry type subroutine mom_set_geomtype(geomtype_in) - ! Set module variable geomtype - - type(ESMF_GeomType_Flag), intent(in) :: geomtype_in !< mesh or grid + type(ESMF_GeomType_Flag), intent(in) :: geomtype_in !< ESMF type describing type of + !! geometry (mesh or grid) geomtype = geomtype_in end subroutine mom_set_geomtype -!=============================================================================== - !> This function has a few purposes: !! (1) it imports surface fluxes using data from the mediator; and !! (2) it can apply restoring in SST and SSS. - subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype, rc) ! Input/output variables @@ -68,7 +65,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing character(len=*), optional , intent(in) :: runtype !< For cesm only, type of run - integer , intent(inout) :: rc + integer , intent(inout) :: rc !< Error handler ! Local Variables integer :: i, j, ig, jg, n @@ -79,8 +76,6 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, real(ESMF_KIND_R8), allocatable :: tauy(:,:) character(len=*) , parameter :: subname = '(mom_import)' - !----------------------------------------------------------------------- - rc = ESMF_SUCCESS ! ------- @@ -90,9 +85,9 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, if (present(runtype)) then import_cnt = import_cnt + 1 if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then - do_import = .false. ! This will skip the first time import information is given + do_import = .false. ! This will skip the first time import information is given else - do_import = .true. + do_import = .true. end if else do_import = .true. @@ -106,61 +101,61 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! surface height pressure !---- call state_getimport(importState, 'inst_pres_height_surface', & - isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! near-IR, direct shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! near-IR, diffuse shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! visible, direct shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! visible, diffuse shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! ------- ! Net longwave radiation (W/m2) ! ------- call state_getimport(importState, 'mean_net_lw_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! zonal and meridional surface stress @@ -170,14 +165,15 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! rotate taux and tauy from true zonal/meridional to local coordinates do j = jsc, jec @@ -335,28 +331,26 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mass_of_overlying_ice', & - isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out end if end subroutine mom_import -!=============================================================================== - !> Maps outgoing ocean data to ESMF State subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc) ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid - type(ocean_state_type) , pointer :: ocean_state + type(ocean_state_type) , pointer :: ocean_state !< Ocean state type(ESMF_State) , intent(inout) :: exportState !< outgoing data - type(ESMF_Clock) , intent(in) :: clock - integer , intent(inout) :: rc + type(ESMF_Clock) , intent(in) :: clock !< ESMF clock + integer , intent(inout) :: rc !< Error handler ! Local variables integer :: i, j, ig, jg ! indices @@ -380,7 +374,6 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, real(ESMF_KIND_R8), allocatable :: dhdx(:,:), dhdy(:,:) real(ESMF_KIND_R8), allocatable :: dhdx_rot(:,:), dhdy_rot(:,:) character(len=*) , parameter :: subname = '(mom_export)' - !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -660,13 +653,12 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end subroutine mom_export -!=============================================================================== - +!> Get field pointer 1D subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) - type(ESMF_State) , intent(in) :: State - character(len=*) , intent(in) :: fldname - real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:) - integer, optional , intent(out) :: rc + type(ESMF_State) , intent(in) :: State !< ESMF state + character(len=*) , intent(in) :: fldname !< Field name + real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:)!< Pointer to the 1D field + integer, optional , intent(out) :: rc !< Error handler ! local variables type(ESMF_Field) :: lfield @@ -688,13 +680,12 @@ subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) end subroutine State_GetFldPtr_1d -!=============================================================================== - +!> Get field pointer 2D subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) - type(ESMF_State) , intent(in) :: State - character(len=*) , intent(in) :: fldname - real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:) - integer, optional , intent(out) :: rc + type(ESMF_State) , intent(in) :: State !< ESMF state + character(len=*) , intent(in) :: fldname !< Field name + real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:)!< Pointer to the 2D field + integer, optional , intent(out) :: rc !< Error handler ! local variables type(ESMF_Field) :: lfield @@ -716,24 +707,21 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) end subroutine State_GetFldPtr_2d -!=============================================================================== - +!> Map import state field to output array subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, rc) - - ! ---------------------------------------------- - ! Map import state field to output array - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State) , intent(in) :: state - character(len=*) , intent(in) :: fldname - integer , intent(in) :: isc - integer , intent(in) :: iec - integer , intent(in) :: jsc - integer , intent(in) :: jec - real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec) - logical, optional , intent(in) :: do_sum - integer , intent(out) :: rc + type(ESMF_State) , intent(in) :: state !< ESMF state + character(len=*) , intent(in) :: fldname !< Field name + integer , intent(in) :: isc !< The start i-index of cell centers within + !! the computational domain + integer , intent(in) :: iec !< The end i-index of cell centers within the + !! computational domain + integer , intent(in) :: jsc !< The start j-index of cell centers within + !! the computational domain + integer , intent(in) :: jec !< The end j-index of cell centers within + !! the computational domain + real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec)!< Output 2D array + logical, optional , intent(in) :: do_sum !< If true, sums the data + integer , intent(out) :: rc !< Error handler ! local variables type(ESMF_StateItem_Flag) :: itemFlag @@ -800,24 +788,21 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r end subroutine State_GetImport -!=============================================================================== - +!> Map input array to export state subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid, rc) - - ! ---------------------------------------------- - ! Map input array to export state - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State) , intent(inout) :: state - character(len=*) , intent(in) :: fldname - integer , intent(in) :: isc - integer , intent(in) :: iec - integer , intent(in) :: jsc - integer , intent(in) :: jec - real (ESMF_KIND_R8) , intent(in) :: input(isc:iec,jsc:jec) - type(ocean_grid_type) , intent(in) :: ocean_grid - integer , intent(out) :: rc + type(ESMF_State) , intent(inout) :: state !< ESMF state + character(len=*) , intent(in) :: fldname !< Field name + integer , intent(in) :: isc !< The start i-index of cell centers within + !! the computational domain + integer , intent(in) :: iec !< The end i-index of cell centers within the + !! computational domain + integer , intent(in) :: jsc !< The start j-index of cell centers within + !! the computational domain + integer , intent(in) :: jec !< The end j-index of cell centers within + !! the computational domain + real (ESMF_KIND_R8) , intent(in) :: input(isc:iec,jsc:jec)!< Input 2D array + type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean horizontal grid + integer , intent(out) :: rc !< Error handler ! local variables type(ESMF_StateItem_Flag) :: itemFlag From 4b643550c999cdb6a6ed266a6501bab04a07e39b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 26 Mar 2019 16:41:55 -0600 Subject: [PATCH 60/77] Replaced error handler with return code --- config_src/nuopc_driver/mom_cap_methods.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index adb3915787..036497be09 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -65,7 +65,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing character(len=*), optional , intent(in) :: runtype !< For cesm only, type of run - integer , intent(inout) :: rc !< Error handler + integer , intent(inout) :: rc !< Return code ! Local Variables integer :: i, j, ig, jg, n @@ -350,7 +350,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, type(ocean_state_type) , pointer :: ocean_state !< Ocean state type(ESMF_State) , intent(inout) :: exportState !< outgoing data type(ESMF_Clock) , intent(in) :: clock !< ESMF clock - integer , intent(inout) :: rc !< Error handler + integer , intent(inout) :: rc !< Return code ! Local variables integer :: i, j, ig, jg ! indices @@ -658,7 +658,7 @@ subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) type(ESMF_State) , intent(in) :: State !< ESMF state character(len=*) , intent(in) :: fldname !< Field name real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:)!< Pointer to the 1D field - integer, optional , intent(out) :: rc !< Error handler + integer, optional , intent(out) :: rc !< Return code ! local variables type(ESMF_Field) :: lfield @@ -685,7 +685,7 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) type(ESMF_State) , intent(in) :: State !< ESMF state character(len=*) , intent(in) :: fldname !< Field name real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:)!< Pointer to the 2D field - integer, optional , intent(out) :: rc !< Error handler + integer, optional , intent(out) :: rc !< Return code ! local variables type(ESMF_Field) :: lfield @@ -721,7 +721,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r !! the computational domain real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec)!< Output 2D array logical, optional , intent(in) :: do_sum !< If true, sums the data - integer , intent(out) :: rc !< Error handler + integer , intent(out) :: rc !< Return code ! local variables type(ESMF_StateItem_Flag) :: itemFlag @@ -802,7 +802,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid !! the computational domain real (ESMF_KIND_R8) , intent(in) :: input(isc:iec,jsc:jec)!< Input 2D array type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean horizontal grid - integer , intent(out) :: rc !< Error handler + integer , intent(out) :: rc !< Return code ! local variables type(ESMF_StateItem_Flag) :: itemFlag From a5b88424349444896436a91622647a33209b8df0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 26 Mar 2019 16:46:49 -0600 Subject: [PATCH 61/77] Add doxumentation --- config_src/nuopc_driver/mom_cap_time.F90 | 92 ++++++++++-------------- 1 file changed, 38 insertions(+), 54 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 index bd26785f54..cd7f65b88b 100644 --- a/config_src/nuopc_driver/mom_cap_time.F90 +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -1,11 +1,9 @@ -! -! This was originally share code in CIME, but required CIME as a -! dependency to build the MOM cap. The options here for setting -! a restart alarm are useful for all caps, so a second step is to -! determine if/how these could be offered more generally in a -! shared library. For now we really want the MOM cap to only -! depend on MOM and ESMF/NUOPC. -! +!> This was originally share code in CIME, but required CIME as a +!! dependency to build the MOM cap. The options here for setting +!! a restart alarm are useful for all caps, so a second step is to +!! determine if/how these could be offered more generally in a +!! shared library. For now we really want the MOM cap to only +!! depend on MOM and ESMF/NUOPC. module mom_cap_time ! !USES: @@ -55,37 +53,31 @@ module mom_cap_time character(len=*), parameter :: u_FILE_u = & __FILE__ -!=============================================================================== contains -!=============================================================================== +!> Setup an alarm in a clock. The ringtime sent to AlarmCreate +!! MUST be the next alarm time. If you send an arbitrary but +!! proper ringtime from the past and the ring interval, the alarm +!! will always go off on the next clock advance and this will cause +!! serious problems. Even if it makes sense to initialize an alarm +!! with some reference time and the alarm interval, that reference +!! time has to be advance forward to be >= the current time. +!! In the logic below we set an appropriate "NextAlarm" and then +!! we make sure to advance it properly based on the ring interval. subroutine AlarmInit( clock, alarm, option, & opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) - - ! !DESCRIPTION: Setup an alarm in a clock - ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm - ! time. If you send an arbitrary but proper ringtime from the - ! past and the ring interval, the alarm will always go off on the - ! next clock advance and this will cause serious problems. Even - ! if it makes sense to initialize an alarm with some reference - ! time and the alarm interval, that reference time has to be - ! advance forward to be >= the current time. In the logic below - ! we set an appropriate "NextAlarm" and then we make sure to - ! advance it properly based on the ring interval. - - ! input/output variables - type(ESMF_Clock) , intent(inout) :: clock ! clock - type(ESMF_Alarm) , intent(inout) :: alarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer , optional , intent(in) :: opt_n ! alarm freq - integer , optional , intent(in) :: opt_ymd ! alarm ymd - integer , optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time - character(len=*) , optional , intent(in) :: alarmname ! alarm name - integer , intent(inout) :: rc ! Return code + type(ESMF_Clock) , intent(inout) :: clock !< ESMF clock + type(ESMF_Alarm) , intent(inout) :: alarm !< ESMF alarm + character(len=*) , intent(in) :: option !< alarm option + integer , optional , intent(in) :: opt_n !< alarm freq + integer , optional , intent(in) :: opt_ymd !< alarm ymd + integer , optional , intent(in) :: opt_tod !< alarm tod (sec) + type(ESMF_Time) , optional , intent(in) :: RefTime !< ref time + character(len=*) , optional , intent(in) :: alarmname !< alarm name + integer , intent(inout) :: rc !< Return code ! local variables - type(ESMF_Calendar) :: cal ! calendar + type(ESMF_Calendar) :: cal ! calendar integer :: lymd ! local ymd integer :: ltod ! local tod integer :: cyy,cmm,cdd,csec ! time info @@ -347,22 +339,17 @@ subroutine AlarmInit( clock, alarm, option, & end subroutine AlarmInit -!=============================================================================== - +!> Creates the ESMF_Time object corresponding to the given input time, +!! given in YMD (Year Month Day) and TOD (Time-of-day) format. Sets +!! the time by an integer as YYYYMMDD and integer seconds in the day. subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) - - ! Create the ESMF_Time object corresponding to the given input time, given in - ! YMD (Year Month Day) and TOD (Time-of-day) format. - ! Set the time by an integer as YYYYMMDD and integer seconds in the day - - ! input/output parameters: - type(ESMF_Time) , intent(inout) :: Time ! ESMF time - integer , intent(in) :: ymd ! year, month, day YYYYMMDD - type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar - integer , intent(in), optional :: tod ! time of day in seconds - character(len=*) , intent(in), optional :: desc ! description of time to set - integer , intent(in), optional :: logunit - integer , intent(out), optional :: rc + type(ESMF_Time) , intent(inout) :: Time !< ESMF time + integer , intent(in) :: ymd !< year, month, day YYYYMMDD + type(ESMF_Calendar) , intent(in) :: cal !< ESMF calendar + integer , intent(in), optional :: tod !< time of day in [sec] + character(len=*) , intent(in), optional :: desc !< description of time to set + integer , intent(in), optional :: logunit!< Unit for stdout output + integer , intent(out), optional :: rc !< Return code ! local varaibles integer :: yr, mon, day ! Year, month, day as integers @@ -398,13 +385,10 @@ subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) end subroutine TimeInit -!=============================================================================== - +!> Converts a coded-date (yyyymmdd) into calendar year,month,day. subroutine date2ymd (date, year, month, day) - - ! input/output variables - integer, intent(in) :: date ! coded-date (yyyymmdd) - integer, intent(out) :: year,month,day ! calendar year,month,day + integer, intent(in) :: date !< coded-date (yyyymmdd) + integer, intent(out) :: year,month,day !< calendar year,month,day ! local variables integer :: tdate ! temporary date From c2900ac6d1c464b986e4f07d3379460b7d2d89ed Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Mar 2019 09:44:35 -0600 Subject: [PATCH 62/77] Loads missing modules --- config_src/nuopc_driver/mom_cap.F90 | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index eb889e71e9..63679cca3d 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -352,7 +352,6 @@ module mom_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit -! TODO add only below. use ESMF, only: ESMF_ClockAdvance, ESMF_ClockGet, ESMF_ClockPrint use ESMF, only: ESMF_ClockGetAlarm, ESMF_ClockGetNextTime, ESMF_ClockAdvance use ESMF, only: ESMF_ClockSet, ESMF_Clock, ESMF_GeomType_Flag, ESMF_LOGMSG_INFO @@ -360,7 +359,7 @@ module mom_cap_mod use ESMF, only: ESMF_GridGetCoord, ESMF_GridAddItem, ESMF_GridGetItem use ESMF, only: ESMF_GridComp, ESMF_GridCompSetEntryPoint, ESMF_GridCompGet use ESMF, only: ESMF_LogFoundError, ESMF_LogWrite, ESMF_LogSetError -use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_GridCompGetInternalState +use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_KIND_R8, ESMF_RC_VAL_WRONG use ESMF, only: ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_SUCCESS use ESMF, only: ESMF_METHOD_INITIALIZE, ESMF_MethodRemove, ESMF_State use ESMF, only: ESMF_LOGMSG_INFO, ESMF_RC_ARG_BAD, ESMF_VM, ESMF_Time @@ -371,12 +370,22 @@ module mom_cap_mod use ESMF, only: ESMF_KIND_I8, ESMF_FAILURE, ESMF_DistGridCreate, ESMF_MeshCreate use ESMF, only: ESMF_FILEFORMAT_ESMFMESH, ESMF_DELayoutCreate, ESMF_DistGridConnectionSet use ESMF, only: ESMF_DistGridGet, ESMF_STAGGERLOC_CORNER, ESMF_GRIDITEM_MASK -use ESMF, only: ESMF_TYPEKIND_I4, ESMF_TYPEKIND_R8, ESMF_STAGGERLOC_CENTER, +use ESMF, only: ESMF_TYPEKIND_I4, ESMF_TYPEKIND_R8, ESMF_STAGGERLOC_CENTER use ESMF, only: ESMF_GRIDITEM_AREA, ESMF_Field, ESMF_ALARM, ESMF_VMLogMemInfo use ESMF, only: ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_StateRemove -use ESMF, only: ESMF_FieldCreate - -use NUOPC +use ESMF, only: ESMF_FieldCreate, ESMF_LOGMSG_ERROR, ESMF_LOGMSG_WARNING +use ESMF, only: ESMF_COORDSYS_SPH_DEG, ESMF_GridCreate, ESMF_INDEX_DELOCAL +use ESMF, only: ESMF_MESHLOC_ELEMENT, ESMF_RC_VAL_OUTOFRANGE, ESMF_StateGet +use ESMF, only: ESMF_TimePrint, ESMF_AlarmSet, ESMF_FieldGet + +!TODO, where this is comming from? +! 1) ESMF_GridCompGetInternalState + +use NUOPC, only: NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize +use NUOPC, only: NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet, NUOPC_CompAttributeAdd +use NUOPC, only: NUOPC_Advertise, NUOPC_SetAttribute, NUOPC_IsUpdated, NUOPC_Write +use NUOPC, only: NUOPC_IsConnected, NUOPC_Realize, NUOPC_CompAttributeSet +use NUOPC_Model, only: NUOPC_ModelGet use NUOPC_Model, & model_routine_SS => SetServices, & model_label_Advance => label_Advance, & From c7042b4a7cc5495c48d068cf370f006ba68d91fc Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Mar 2019 09:58:19 -0600 Subject: [PATCH 63/77] Add more doxumentation and TODOs --- config_src/nuopc_driver/mom_cap.F90 | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 63679cca3d..dceef70804 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -378,8 +378,9 @@ module mom_cap_mod use ESMF, only: ESMF_MESHLOC_ELEMENT, ESMF_RC_VAL_OUTOFRANGE, ESMF_StateGet use ESMF, only: ESMF_TimePrint, ESMF_AlarmSet, ESMF_FieldGet -!TODO, where this is comming from? -! 1) ESMF_GridCompGetInternalState +! TODO ESMF_GridCompGetInternalState does not have an explicit Fortran interface. +!! Model does not compile with "use ESMF, only: ESMF_GridCompGetInternalState" +!! Is this okay? use NUOPC, only: NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC, only: NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet, NUOPC_CompAttributeAdd @@ -2242,16 +2243,17 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ end subroutine State_SetScalar -!> TODO +!> Realize the import and export fields using either a grid or a mesh. subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) - - type(ESMF_State) , intent(inout) :: state - integer , intent(in) :: nfields - type(fld_list_type) , intent(inout) :: field_defs(:) - character(len=*) , intent(in) :: tag - type(ESMF_Grid) , intent(in), optional :: grid - type(ESMF_Mesh) , intent(in), optional :: mesh - integer , intent(inout) :: rc + type(ESMF_State) , intent(inout) :: state !< ESMF_State object for + !! import/export fields. + integer , intent(in) :: nfields !< Number of fields. + type(fld_list_type) , intent(inout) :: field_defs(:) !< Structure with field's + !! information. + character(len=*) , intent(in) :: tag !< Import or export. + type(ESMF_Grid) , intent(in), optional :: grid!< ESMF grid. + type(ESMF_Mesh) , intent(in), optional :: mesh!< ESMF mesh. + integer , intent(inout) :: rc !< Return code. ! local variables integer :: i From 7ceda76b61f9eb90d94390c4dc1b944729ec5577 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Mar 2019 10:01:38 -0600 Subject: [PATCH 64/77] Add more doxumentation --- config_src/nuopc_driver/MOM_surface_forcing.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 91d3ed6e3d..73f96839ec 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -1,3 +1,4 @@ +!> Set of subroutines to deal with forcing fields that may be used to drive MOM. module MOM_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. From e73c579d09601d8c8d86b9cd672e3177593fa40a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Mar 2019 10:03:49 -0600 Subject: [PATCH 65/77] Removes unecessary comments --- config_src/nuopc_driver/mom_cap_methods.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 036497be09..ee713846b6 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -58,8 +58,6 @@ end subroutine mom_set_geomtype !! (1) it imports surface fluxes using data from the mediator; and !! (2) it can apply restoring in SST and SSS. subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype, rc) - - ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator @@ -343,8 +341,6 @@ end subroutine mom_import !> Maps outgoing ocean data to ESMF State subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc) - - ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid type(ocean_state_type) , pointer :: ocean_state !< Ocean state From d89b4b51da28b6b71176c78d066aec55b15a493d Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Mar 2019 10:13:54 -0600 Subject: [PATCH 66/77] Updates doxumentation --- config_src/nuopc_driver/time_utils.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 index 49bad199a1..e995c1b697 100644 --- a/config_src/nuopc_driver/time_utils.F90 +++ b/config_src/nuopc_driver/time_utils.F90 @@ -1,4 +1,4 @@ -!> Set of subroutines that convert date/time between FMS and ESMF formats. +!> Set of time utilities for converting between FMS and ESMF time type. module time_utils_mod ! FMS From 306bcfb1afe4f118ab0539594f2e037c882a987d Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Mar 2019 10:14:06 -0600 Subject: [PATCH 67/77] Updates doxumentation --- config_src/nuopc_driver/MOM_surface_forcing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 73f96839ec..ad68fb887f 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -1,4 +1,4 @@ -!> Set of subroutines to deal with forcing fields that may be used to drive MOM. +!> Converts the input ESMF data (import data) to a MOM-specific data type (surface_forcing_CS). module MOM_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. From 63514abeee7f1f2334a01b2807a6e833873eee62 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Mar 2019 10:42:56 -0600 Subject: [PATCH 68/77] Repalces end if > endif and end do > enddo --- config_src/nuopc_driver/mom_cap.F90 | 36 +++++----- config_src/nuopc_driver/mom_cap_methods.F90 | 74 ++++++++++----------- config_src/nuopc_driver/mom_cap_time.F90 | 16 ++--- 3 files changed, 63 insertions(+), 63 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index dceef70804..25bb8c69aa 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -925,7 +925,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) return endif - end if + endif ocean_public%is_ocean_pe = .true. if (len_trim(restartfile) > 0) then @@ -1002,7 +1002,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) else !call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") - end if + endif !--------- import fields ------------- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide") ! from ice @@ -1199,7 +1199,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return enddo - end if + endif !--------------------------------- ! Create either a grid or a mesh @@ -1250,7 +1250,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (localPet == 0) then write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) - end if + endif ! recreate the mesh using the above distGrid EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) @@ -1515,9 +1515,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) if(grid_attach_area) then dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) - end if - end do - end do + endif + enddo + enddo jlast = jec if(jec == nyg)jlast = jec+1 @@ -1530,8 +1530,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ig = i + ocean_grid%isc - isc - 1 dataPtr_xcor(i1,j1) = ocean_grid%geolonBu(ig,jg) dataPtr_ycor(i1,j1) = ocean_grid%geolatBu(ig,jg) - end do - end do + enddo + enddo write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) @@ -1567,7 +1567,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return - end if + endif !--------------------------------- ! set scalar data in export state @@ -1655,7 +1655,7 @@ subroutine DataInitialize(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - end if + endif call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1682,7 +1682,7 @@ subroutine DataInitialize(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - end do + enddo deallocate(fieldNameList) ! check whether all Fields in the exportState are "Updated" @@ -1694,7 +1694,7 @@ subroutine DataInitialize(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - end if + endif if(write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_init_ocn_export_', & @@ -1833,7 +1833,7 @@ subroutine ModelAdvance(gcomp, rc) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) else call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) - end if + endif if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1962,7 +1962,7 @@ subroutine ModelAdvance(gcomp, rc) if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) - end if + endif endif !--------------- @@ -2124,7 +2124,7 @@ subroutine ModelSetRunClock(gcomp, rc) file=__FILE__)) & return ! bail out - end if + endif !-------------------------------- ! Advance model clock to trigger alarms then reset model clock back to currtime @@ -2195,7 +2195,7 @@ subroutine ocean_model_finalize(gcomp, rc) call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) else call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) - end if + endif call field_manager_end() call fms_io_exit() @@ -2325,7 +2325,7 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) return ! bail out fldptr1d(:) = 0.0 - end if + endif endif diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index ee713846b6..46559fb22a 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -86,10 +86,10 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, do_import = .false. ! This will skip the first time import information is given else do_import = .true. - end if + endif else do_import = .true. - end if + endif if (do_import) then ! The following are global indices without halos @@ -182,8 +182,8 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, - ocean_grid%sin_rot(ig,jg)*tauy(i,j) ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & + ocean_grid%sin_rot(ig,jg)*taux(i,j) - end do - end do + enddo + enddo deallocate(taux, tauy) @@ -335,7 +335,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, file=__FILE__)) & return ! bail out - end if + endif end subroutine mom_import @@ -390,7 +390,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, inv_dt_int = 1.0 / real(dt_int) else inv_dt_int = 0.0 - end if + endif !---------------- ! Copy from ocean_public to exportstate. @@ -460,8 +460,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ocm(i,j) = ocean_public%v_surf(i,j) ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) + ocean_grid%sin_rot(ig,jg)*ocm(i,j) ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) - ocean_grid%sin_rot(ig,jg)*ocz(i,j) - end do - end do + enddo + enddo call State_SetExport(exportState, 'ocn_current_zonal', & isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) @@ -490,7 +490,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, line=__LINE__, & file=__FILE__)) & return ! bail out - end if + endif ! ------- ! Freezing melting potential @@ -507,9 +507,9 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, else melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 - end if - end do - end do + endif + enddo + enddo call State_SetExport(exportState, 'freezing_melting_potential', & isc, iec, jsc, jec, melt_potential, ocean_grid, rc=rc) @@ -531,7 +531,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, line=__LINE__, & file=__FILE__)) & return ! bail out - end if + endif !---------------- ! Sea-surface zonal and meridional slopes @@ -553,8 +553,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do i = ocean_grid%isc,ocean_grid%iec iloc = i + ocean_grid%idg_offset ssh(i,j) = ocean_public%sea_lev(iloc,jloc) - end do - end do + enddo + enddo ! Update halo of ssh so we can calculate gradients (local indexing) call pass_var(ssh, ocean_grid%domain) @@ -583,11 +583,11 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! Extrema in the mean values require a PCM reconstruction avoid generating ! larger extreme values. slope = 0.0 - end if + endif dhdx(iglob,jglob) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdx(iglob,jglob) = 0.0 - end do - end do + enddo + enddo ! d/dy ssh ! This is a simple second-order difference @@ -613,11 +613,11 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! Extrema in the mean values require a PCM reconstruction avoid generating ! larger extreme values. slope = 0.0 - end if + endif dhdy(iglob,jglob) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdy(iglob,jglob) = 0.0 - end do - end do + enddo + enddo ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) ! "ocean_grid" uses has halos and uses local indexing. @@ -628,8 +628,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ig = i + ocean_grid%isc - isc dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) - end do - end do + enddo + enddo call State_SetExport(exportState, 'sea_surface_slope_zonal', & isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) @@ -751,9 +751,9 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r output(i,j) = output(i,j) + dataPtr1d(n) else output(i,j) = dataPtr1d(n) - end if - end do - end do + endif + enddo + enddo else if (geomtype == ESMF_GEOMTYPE_GRID) then @@ -774,13 +774,13 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r output(i,j) = output(i,j) + dataPtr2d(i1,j1) else output(i,j) = dataPtr2d(i1,j1) - end if - end do - end do + endif + enddo + enddo - end if + endif - end if + endif end subroutine State_GetImport @@ -833,8 +833,8 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid ig = i + ocean_grid%isc - isc n = n+1 dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) - end do - end do + enddo + enddo else if (geomtype == ESMF_GEOMTYPE_GRID) then @@ -854,12 +854,12 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid i1 = i + lbnd1 - isc ig = i + ocean_grid%isc - isc dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) - end do - end do + enddo + enddo - end if + endif - end if + endif end subroutine State_SetExport diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 index cd7f65b88b..dc4f81e90e 100644 --- a/config_src/nuopc_driver/mom_cap_time.F90 +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -114,14 +114,14 @@ subroutine AlarmInit( clock, alarm, option, & line=__LINE__, & file=__FILE__, rcToReturn=rc) return - end if + endif if (opt_n <= 0) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//trim(option)//' invalid opt_n', & line=__LINE__, & file=__FILE__, rcToReturn=rc) return - end if + endif endif call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) @@ -179,14 +179,14 @@ subroutine AlarmInit( clock, alarm, option, & line=__LINE__, & file=__FILE__, rcToReturn=rc) return - end if + endif if (lymd < 0 .or. ltod < 0) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & line=__LINE__, & file=__FILE__, rcToReturn=rc) return - end if + endif call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -206,7 +206,7 @@ subroutine AlarmInit( clock, alarm, option, & line=__LINE__, & file=__FILE__, rcToReturn=rc) return - end if + endif call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -367,13 +367,13 @@ subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) if (present(logunit)) then write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & 'time-of-day out of bounds', ymd, ltod - end if + endif call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//' yymmdd is negative or time-of-day out of bounds ', & line=__LINE__, & file=__FILE__, rcToReturn=rc) return - end if + endif call date2ymd (ymd,yr,mon,day) @@ -399,7 +399,7 @@ subroutine date2ymd (date, year, month, day) year = int(tdate/10000) if (date < 0) then year = -year - end if + endif month = int( mod(tdate,10000)/ 100) day = mod(tdate, 100) From d3a57bc16ec0490a1fe865445efc24aaa7891562 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 9 Apr 2019 15:30:35 -0400 Subject: [PATCH 69/77] +Added dimensional rescaling of Coriolis parameter Changed the units of G%CoriolisBu from s-1 to T-1 for dimensional consistency testing and verified that all answers are bitwise identical for a range of values of T_RESCALE_POWER. This required several unit_scale_type arguments to be added to some routines. All answers are bitwise identical in the MOM6_examples test cases. --- src/core/MOM_CoriolisAdv.F90 | 10 ++-- src/core/MOM_barotropic.F90 | 12 ++--- src/core/MOM_dynamics_split_RK2.F90 | 10 ++-- src/core/MOM_dynamics_unsplit.F90 | 10 ++-- src/core/MOM_dynamics_unsplit_RK2.F90 | 8 +-- src/core/MOM_grid.F90 | 8 +-- src/diagnostics/MOM_diagnostics.F90 | 10 ++-- src/diagnostics/MOM_wave_structure.F90 | 4 +- src/framework/MOM_dyn_horgrid.F90 | 6 +-- src/ice_shelf/MOM_ice_shelf.F90 | 8 +-- .../MOM_fixed_initialization.F90 | 10 ++-- .../MOM_shared_initialization.F90 | 41 +++++++++----- .../MOM_state_initialization.F90 | 2 +- src/parameterizations/lateral/MOM_MEKE.F90 | 21 ++++---- .../lateral/MOM_hor_visc.F90 | 20 ++++--- .../lateral/MOM_internal_tides.F90 | 53 +++++++++++-------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 19 +++---- .../lateral/MOM_mixed_layer_restrat.F90 | 8 +-- .../vertical/MOM_CVMix_KPP.F90 | 4 +- .../vertical/MOM_bulk_mixed_layer.F90 | 8 +-- .../vertical/MOM_diapyc_energy_req.F90 | 4 +- .../vertical/MOM_energetic_PBL.F90 | 4 +- .../vertical/MOM_kappa_shear.F90 | 6 +-- .../vertical/MOM_set_diffusivity.F90 | 12 ++--- .../vertical/MOM_set_viscosity.F90 | 16 +++--- .../vertical/MOM_vert_friction.F90 | 4 +- src/user/Idealized_Hurricane.F90 | 10 ++-- src/user/Kelvin_initialization.F90 | 2 +- src/user/MOM_wave_interface.F90 | 9 ++-- src/user/Phillips_initialization.F90 | 4 +- src/user/Rossby_front_2d_initialization.F90 | 11 ++-- src/user/user_initialization.F90 | 2 +- 32 files changed, 196 insertions(+), 160 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 450d71d23e..6b4fdd8924 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -13,6 +13,7 @@ module MOM_CoriolisAdv use MOM_open_boundary, only : ocean_OBC_type, OBC_DIRECTION_E, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_string_functions, only : uppercase +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : accel_diag_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -107,7 +108,7 @@ module MOM_CoriolisAdv contains !> Calculates the Coriolis and momentum advection contributions to the acceleration. -subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) +subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1] @@ -122,8 +123,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: CAv !< Meridional acceleration due to Coriolis !! and momentum advection [m s-2]. type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics - type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv + type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -410,7 +412,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) relative_vorticity = G%mask2dBu(I,J) * (dvdx(I,J) - dudy(I,J)) * & G%IareaBu(I,J) endif - absolute_vorticity = G%CoriolisBu(I,J) + relative_vorticity + absolute_vorticity = US%s_to_T*G%CoriolisBu(I,J) + relative_vorticity Ih = 0.0 if (Area_q(i,j) > 0.0) then hArea_q = (hArea_u(I,j) + hArea_u(I,j+1)) + (hArea_v(i,J) + hArea_v(i+1,J)) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index cdc5ed0251..57914ad7c4 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -821,7 +821,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do I=is-1,ie - q(I,J) = 0.25 * G%CoriolisBu(I,J) * & + q(I,J) = 0.25 * US%s_to_T*G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) ) @@ -1396,8 +1396,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, gtot_W(i,j) * (Datu(I-1,j)*G%IdxCu(I-1,j))) + & (gtot_N(i,j) * (Datv(i,J)*G%IdyCv(i,J)) + & gtot_S(i,j) * (Datv(i,J-1)*G%IdyCv(i,J-1)))) + & - ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) + US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) H_eff_dx2 = max(H_min_dyn * (G%IdxT(i,j)**2 + G%IdyT(i,j)**2), & G%IareaT(i,j) * & ((Datu(I,j)*G%IdxCu(I,j) + Datu(I-1,j)*G%IdxCu(I-1,j)) + & @@ -2364,8 +2364,8 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (G%IareaT(i,j) * & ((gtot_E(i,j)*Datu(I,j)*G%IdxCu(I,j) + gtot_W(i,j)*Datu(I-1,j)*G%IdxCu(I-1,j)) + & (gtot_N(i,j)*Datv(i,J)*G%IdyCv(i,J) + gtot_S(i,j)*Datv(i,J-1)*G%IdyCv(i,J-1))) + & - ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) + US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) if (Idt_max2 * min_max_dt2 > 1.0) min_max_dt2 = 1.0 / Idt_max2 enddo ; enddo dtbt_max = sqrt(min_max_dt2 / dgeo_de) @@ -4105,7 +4105,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, enddo ; enddo do J=js-1,je ; do I=is-1,ie if (G%mask2dT(i,j)+G%mask2dT(i,j+1)+G%mask2dT(i+1,j)+G%mask2dT(i+1,j+1)>0.) then - CS%q_D(I,J) = 0.25 * G%CoriolisBu(I,J) * & + CS%q_D(I,J) = 0.25 * US%s_to_T*G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) ) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 2a4eeaf21a..c87154b587 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -433,7 +433,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, Gv, CS%CoriolisAdv_CSp) + G, Gv, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -682,14 +682,14 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! diffu = horizontal viscosity terms (u_av) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_av, v_av, h_av, CS%diffu, CS%diffv, & - MEKE, Varmix, G, GV, CS%hor_visc_CSp, OBC=CS%OBC) + MEKE, Varmix, G, GV, US, CS%hor_visc_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_horvisc) if (showCallTree) call callTree_wayPoint("done with horizontal_viscosity (step_MOM_dyn_split_RK2)") ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -1096,7 +1096,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, param_file, diag, CS%hor_visc_CSp) + call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & @@ -1136,7 +1136,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & .not. query_initialized(CS%diffv,"diffv",restart_CS)) & call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & - G, GV, CS%hor_visc_CSp, OBC=CS%OBC) + G, GV, US, CS%hor_visc_CSp, OBC=CS%OBC) if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then CS%u_av(:,:,:) = u(:,:,:) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 887a6c4f54..0995725536 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -255,7 +255,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, & - G, GV, CS%hor_visc_CSp) + G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) @@ -300,7 +300,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta)/h_av vh + d/dx KE call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u, v, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -368,7 +368,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -450,7 +450,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(upp))/h_av vh + d/dx KE(upp) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(upp, vpp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -653,7 +653,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, param_file, diag, CS%hor_visc_CSp) + call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index e3625dd6a3..c3525801a0 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -266,7 +266,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_in, v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & - G, GV, CS%hor_visc_CSp) + G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) call pass_vector(CS%diffu, CS%diffv, G%Domain, clock=id_clock_pass) @@ -295,7 +295,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta)/h_av vh + d/dx KE (function of u[n-1] and uh[n-1]) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_in, v_in, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) (function of h[n-1/2]) @@ -367,7 +367,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) (function of up[n-1/2], h[n-1/2]) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (associated(CS%OBC)) then call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) @@ -613,7 +613,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, param_file, diag, CS%hor_visc_CSp) + call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 25cd31f96b..b66aecd261 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -149,11 +149,11 @@ module MOM_grid Dblock_v, & !< Topographic depths at v-points at which the flow is blocked [Z ~> m]. Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv [Z ~> m]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - CoriolisBu !< The Coriolis parameter at corner points [s-1]. + CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [s-1 m-1]. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [s-1 m-1]. - real :: g_Earth !< The gravitational acceleration [m s-2]. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. + real :: g_Earth !< The gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. ! These variables are global sums that are useful for 1-d diagnostics real :: areaT_global !< Global sum of h-cell area [m2] diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index cd3c87b922..767625f1ea 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -627,10 +627,10 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & !$OMP private(f2_h,mag_beta) do j=js,je ; do i=is,ie ! Blend the equatorial deformation radius with the standard one. - f2_h = absurdly_small_freq2 + 0.25 * & + f2_h = absurdly_small_freq2 + 0.25 * US%s_to_T**2 * & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) - mag_beta = sqrt(0.5 * ( & + mag_beta = sqrt(0.5 * US%s_to_T**2 * ( & (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -676,10 +676,10 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & !$OMP private(f2_h,mag_beta) do j=js,je ; do i=is,ie ! Blend the equatorial deformation radius with the standard one. - f2_h = absurdly_small_freq2 + 0.25 * & + f2_h = absurdly_small_freq2 + 0.25 * US%s_to_T**2 * & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) - mag_beta = sqrt(0.5 * ( & + mag_beta = sqrt(0.5 * US%s_to_T**2 * ( & (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -1916,7 +1916,7 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%mask2dCv, diag, .true.) id = register_static_field('ocean_model', 'Coriolis', diag%axesB1, & - 'Coriolis parameter at corner (Bu) points', 's-1', interp_method='none') + 'Coriolis parameter at corner (Bu) points', 's-1', interp_method='none', conversion=US%s_to_T) if (id > 0) call post_data(id, G%CoriolisBu, diag, .true.) id = register_static_field('ocean_model', 'dxt', diag%axesT1, & diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 28ad4c6bfc..c289c540f0 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -459,8 +459,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo u_strct(nzm) = (w_strct(nzm-1)- w_strct(nzm))/dz(nzm-1) ! Calculate wavenumber magnitude - f2 = G%CoriolisBu(I,J)**2 - !f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 + !f2 = 0.25*US%s_to_T**2 *((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & ! (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) Kmag2 = (freq**2 - f2) / (cn(i,j)**2 + cg_subRO**2) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 11155d73e6..0a83ef983e 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -148,10 +148,10 @@ module MOM_dyn_horgrid Dblock_v, & !< Topographic depths at v-points at which the flow is blocked [Z ~> m]. Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv [Z ~> m]. real, allocatable, dimension(:,:) :: & - CoriolisBu !< The Coriolis parameter at corner points [s-1]. + CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1]. real, allocatable, dimension(:,:) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [s-1 m-1]. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [s-1 m-1]. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. ! These variables are global sums that are useful for 1-d diagnostics real :: areaT_global !< Global sum of h-cell area [m2] diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index fa4d2b0581..a10a0e55d6 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -375,8 +375,8 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) ! Estimate the neutral ocean boundary layer thickness as the minimum of the ! reported ocean mixed layer thickness and the neutral Ekman depth. - absf = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + absf = 0.25*US%s_to_T*((abs(US%s_to_T*G%CoriolisBu(I,J)) + abs(US%s_to_T*G%CoriolisBu(I-1,J-1))) + & + (abs(US%s_to_T*G%CoriolisBu(I,J-1)) + abs(US%s_to_T*G%CoriolisBu(I-1,J)))) if (absf*state%Hml(i,j) <= VK*ustar_h) then ; hBL_neut = state%Hml(i,j) else ; hBL_neut = (VK*ustar_h) / absf ; endif hBL_neut_h_molec = ZETA_N * ((hBL_neut * ustar_h) / (5.0 * CS%Kv_molec)) @@ -1394,8 +1394,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call rescale_dyn_horgrid_bathymetry(dG, US%Z_to_m) ! Set up the Coriolis parameter, G%f, usually analytically. - call MOM_initialize_rotation(dG%CoriolisBu, dG, param_file) - ! This copies grid elements, inglucy bathyT and CoriolisBu from dG to CS%grid. + call MOM_initialize_rotation(dG%CoriolisBu, dG, param_file, US) + ! This copies grid elements, including bathyT and CoriolisBu from dG to CS%grid. call copy_dyngrid_to_MOM_grid(dG, CS%grid) call destroy_dyn_horgrid(dG) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index c2f188bc6f..f51676bd1b 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -147,13 +147,13 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) ! Calculate the value of the Coriolis parameter at the latitude ! ! of the q grid points [s-1]. - call MOM_initialize_rotation(G%CoriolisBu, G, PF) + call MOM_initialize_rotation(G%CoriolisBu, G, PF, US=US) ! Calculate the components of grad f (beta) - call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G) + call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G, US=US) if (debug) then - call qchksum(G%CoriolisBu, "MOM_initialize_fixed: f ", G%HI) - call hchksum(G%dF_dx, "MOM_initialize_fixed: dF_dx ", G%HI) - call hchksum(G%dF_dy, "MOM_initialize_fixed: dF_dy ", G%HI) + call qchksum(G%CoriolisBu, "MOM_initialize_fixed: f ", G%HI, scale=US%s_to_T) + call hchksum(G%dF_dx, "MOM_initialize_fixed: dF_dx ", G%HI, scale=US%s_to_T) + call hchksum(G%dF_dy, "MOM_initialize_fixed: dF_dy ", G%HI, scale=US%s_to_T) endif call initialize_grid_rotation_angle(G, PF) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 7613eae6b0..2f9b1cefcc 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -56,7 +56,7 @@ end subroutine MOM_shared_init_init !> MOM_initialize_rotation makes the appropriate call to set up the Coriolis parameter. subroutine MOM_initialize_rotation(f, G, PF, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(out) :: f !< The Coriolis parameter [s-1] + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(out) :: f !< The Coriolis parameter [T-1 ~> s-1] type(param_file_type), intent(in) :: PF !< Parameter file structure type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type @@ -76,9 +76,9 @@ subroutine MOM_initialize_rotation(f, G, PF, US) " \t USER - call a user modified routine.", & default="2omegasinlat") select case (trim(config)) - case ("2omegasinlat"); call set_rotation_planetary(f, G, PF) - case ("beta"); call set_rotation_beta_plane(f, G, PF) - case ("betaplane"); call set_rotation_beta_plane(f, G, PF) + case ("2omegasinlat"); call set_rotation_planetary(f, G, PF, US) + case ("beta"); call set_rotation_beta_plane(f, G, PF, US) + case ("betaplane"); call set_rotation_beta_plane(f, G, PF, US) !case ("nonrotating") ! Note from AJA: Missing case? case default ; call MOM_error(FATAL,"MOM_initialize: "// & "Unrecognized rotation setup "//trim(config)) @@ -90,9 +90,9 @@ end subroutine MOM_initialize_rotation subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: dF_dx !< x-component of grad f + intent(out) :: dF_dx !< x-component of grad f [T-1 m-1 ~> s-1 m-1] real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: dF_dy !< y-component of grad f + intent(out) :: dF_dy !< y-component of grad f [T-1 m-1 ~> s-1 m-1] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j @@ -459,20 +459,24 @@ end subroutine limit_topography subroutine set_rotation_planetary(f, G, param_file, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & - intent(out) :: f !< Coriolis parameter (vertical component) in s^-1 + intent(out) :: f !< Coriolis parameter (vertical component) [T-1 ~> s-1] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine sets up the Coriolis parameter for a sphere character(len=30) :: mdl = "set_rotation_planetary" ! This subroutine's name. integer :: I, J - real :: PI, omega + real :: PI + real :: omega ! The planetary rotation rate [T-1 ~> s-1] + real :: T_to_s ! A time unit conversion factor call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + T_to_s = 1.0 ; if (present(US)) T_to_s = US%T_to_s + call get_param(param_file, "set_rotation_planetary", "OMEGA", omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) + default=7.2921e-5, scale=T_to_s) PI = 4.0*atan(1.0) do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB @@ -488,24 +492,30 @@ end subroutine set_rotation_planetary subroutine set_rotation_beta_plane(f, G, param_file, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & - intent(out) :: f !< Coriolis parameter (vertical component) in s^-1 + intent(out) :: f !< Coriolis parameter (vertical component) [T-1 ~> s-1] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine sets up the Coriolis parameter for a beta-plane integer :: I, J - real :: f_0, beta, y_scl, Rad_Earth, PI + real :: f_0 ! The reference value of the Coriolis parameter [T-1 ~> s-1] + real :: beta ! The meridional gradient of the Coriolis parameter [T-1 m-1 ~> s-1 m-1] + real :: y_scl, Rad_Earth + real :: T_to_s ! A time unit conversion factor + real :: PI character(len=40) :: mdl = "set_rotation_beta_plane" ! This subroutine's name. character(len=200) :: axis_units call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + T_to_s = 1.0 ; if (present(US)) T_to_s = US%T_to_s + call get_param(param_file, mdl, "F_0", f_0, & "The reference value of the Coriolis parameter with the \n"//& - "betaplane option.", units="s-1", default=0.0) + "betaplane option.", units="s-1", default=0.0, scale=T_to_s) call get_param(param_file, mdl, "BETA", beta, & "The northward gradient of the Coriolis parameter with \n"//& - "the betaplane option.", units="m-1 s-1", default=0.0) + "the betaplane option.", units="m-1 s-1", default=0.0, scale=T_to_s) call get_param(param_file, mdl, "AXIS_UNITS", axis_units, default="degrees") PI = 4.0*atan(1.0) @@ -1159,6 +1169,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) type(vardesc) :: vars(nFlds) type(fieldtype) :: fields(nFlds) real :: Z_to_m_scale ! A unit conversion factor from Z to m. + real :: s_to_T_scale ! A unit conversion factor from T-1 to s-1. integer :: unit integer :: file_threading integer :: nFlds_used @@ -1176,6 +1187,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB Z_to_m_scale = 1.0 ; if (present(US)) Z_to_m_scale = US%Z_to_m + s_to_T_scale = 1.0 ; if (present(US)) s_to_T_scale = US%s_to_T ! vardesc is a structure defined in MOM_io.F90. The elements of ! this structure, in order, are: @@ -1247,7 +1259,8 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) do j=js,je ; do i=is,ie ; out_h(i,j) = Z_to_m_scale*G%bathyT(i,j) ; enddo ; enddo call write_field(unit, fields(5), G%Domain%mpp_domain, out_h) - call write_field(unit, fields(6), G%Domain%mpp_domain, G%CoriolisBu) + do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(i,J) = s_to_T_scale*G%CoriolisBu(I,J) ; enddo ; enddo + call write_field(unit, fields(6), G%Domain%mpp_domain, out_q) ! I think that all of these copies are holdovers from a much earlier ! ancestor code in which many of the metrics were macros that could have diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 4c7b720f67..32e7161b1e 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -415,7 +415,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, & just_read_params=just_read) case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & - G, GV, PF, just_read_params=just_read) + G, GV, US, PF, just_read_params=just_read) case ("soliton"); call soliton_initialize_velocity(u, v, h, G) case ("USER"); call user_initialize_velocity(u, v, G, PF, & just_read_params=just_read) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 21e06ebcef..74b3386374 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -561,7 +561,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m real :: beta, SN, bottomFac2, barotrFac2, LmixScale, Lrhines, Leady real :: I_H, KhCoeff, Kh, Ubg2, cd2, drag_rate, ldamping, src real :: EKE, EKEmin, EKEmax, resid, ResMin, ResMax, EKEerr - real :: FatH ! Coriolis parameter at h points; to compute topographic beta + real :: FatH ! Coriolis parameter at h points; to compute topographic beta [s-1] integer :: i, j, is, ie, js, je, n1, n2 real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket [m2 s-2]. logical :: useSecant, debugIteration @@ -579,11 +579,12 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m ! This avoids extremes values in equilibrium solution due to bad values in SN_u, SN_v SN = min( min(SN_u(I,j) , SN_u(I-1,j)) , min(SN_v(i,J), SN_v(i,J-1)) ) - FatH = 0.25*((G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & + FatH = 0.25*US%s_to_T*((G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & (G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1))) !< Coriolis parameter at h points - beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j)* & + !### This expression should be recast to use a single division, but it will change answers. + beta = sqrt( ( US%s_to_T*G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j)* & (G%bathyT(i+1,j) - G%bathyT(i-1,j))/2./G%dxT(i,j) )**2. & - + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & + + ( US%s_to_T*G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) I_H = GV%Rho0 * I_mass(i,j) @@ -690,7 +691,8 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [m]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady - real :: beta, SN, FatH + real :: beta, SN + real :: FatH ! Coriolis parameter at h points [s-1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -703,11 +705,12 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & else SN = 0. endif - FatH = 0.25*( ( G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1) ) + & - ( G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1) ) ) ! Coriolis parameter at h points - beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & + FatH = 0.25*US%s_to_T* ( ( G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1) ) + & + ( G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1) ) ) ! Coriolis parameter at h points + !### This expression should be recast to use a single division, but it will change answers. + beta = sqrt( ( US%s_to_T*G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & *(G%bathyT(i+1,j) - G%bathyT(i-1,j)) /2./G%dxT(i,j) )**2. & - + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & + + ( US%s_to_T*G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) endif ! Returns bottomFac2, barotrFac2 and LmixScale diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index a980704d21..5387e0fa8b 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -9,12 +9,13 @@ module MOM_hor_visc use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_io, only : MOM_read_data, slasher use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type, OBC_DIRECTION_E, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_NONE +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type -use MOM_io, only : MOM_read_data, slasher implicit none ; private @@ -175,7 +176,7 @@ module MOM_hor_visc !! u[is-2:ie+2,js-2:je+2] !! v[is-2:ie+2,js-2:je+2] !! h[is-1:ie+1,js-1:je+1] -subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, OBC) +subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, CS, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -194,6 +195,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, !! related to Mesoscale Eddy Kinetic Energy. type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that !! specify the spatially variable viscosities + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(hor_visc_CS), pointer :: CS !< Pontrol structure returned by a previous !! call to hor_visc_init. type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type @@ -893,12 +895,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif if (MEKE%backscatter_Ro_c /= 0.) then do j=js,je ; do i=is,ie - FatH = 0.25*( (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) & - +(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1))) ) + FatH = 0.25*US%s_to_T*( (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & + (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1))) ) Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) FatH = FatH ** MEKE%backscatter_Ro_pow ! f^n + !### Note the hard-coded dimensional constant in the following line. Shear_mag = ( ( Shear_mag ** MEKE%backscatter_Ro_pow ) + 1.e-30 ) & * MEKE%backscatter_Ro_c ! c * D^n ! The Rossby number function is g(Ro) = 1/(1+c.Ro^n) @@ -953,9 +956,10 @@ end subroutine horizontal_viscosity !> Allocates space for and calculates static variables used by horizontal_viscosity(). !! hor_visc_init calculates and stores the values of a number of metric functions that !! are used in horizontal_viscosity(). -subroutine hor_visc_init(Time, G, param_file, diag, CS) +subroutine hor_visc_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< Current model time. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure to regulate diagnostic output. @@ -1447,8 +1451,8 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) if (CS%Smagorinsky_Ah) then CS%BIHARM_CONST_xx(i,j) = Smag_bi_const * (grid_sp_h2 * grid_sp_h2) if (CS%bound_Coriolis) then - fmax = MAX(abs(G%CoriolisBu(I-1,J-1)), abs(G%CoriolisBu(I,J-1)), & - abs(G%CoriolisBu(I-1,J)), abs(G%CoriolisBu(I,J))) + fmax = US%s_to_T*MAX(abs(G%CoriolisBu(I-1,J-1)), abs(G%CoriolisBu(I,J-1)), & + abs(G%CoriolisBu(I-1,J)), abs(G%CoriolisBu(I,J))) CS%Biharm_Const2_xx(i,j) = (grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & (fmax * BoundCorConst) endif @@ -1471,7 +1475,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) CS%BIHARM_CONST_xy(I,J) = Smag_bi_const * (grid_sp_q2 * grid_sp_q2) if (CS%bound_Coriolis) then CS%Biharm_Const2_xy(I,J) = (grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & - (abs(G%CoriolisBu(I,J)) * BoundCorConst) + (abs(US%s_to_T*G%CoriolisBu(I,J)) * BoundCorConst) endif endif diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 4052f948a3..27115dec67 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -214,8 +214,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%energized_angle <= 0) then frac_per_sector = 1.0 / real(CS%nAngle * CS%nMode * CS%nFreq) do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie - f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + !### For rotational symmetry this should be + ! f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + ! (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) if (CS%frequency(fr)**2 > f2) & CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + & dt*frac_per_sector*(1-CS%q_itides)*TKE_itidal_input(i,j) @@ -224,8 +227,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & frac_per_sector = 1.0 / real(CS%nMode * CS%nFreq) a = CS%energized_angle do m=1,CS%nMode ; do fr=1,CS%nFreq ; do j=js,je ; do i=is,ie - f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + !### For rotational symmetry this should be + ! f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + ! (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) if (CS%frequency(fr)**2 > f2) & CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + & dt*frac_per_sector**(1-CS%q_itides)*TKE_itidal_input(i,j) @@ -245,7 +251,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply half the refraction. do m=1,CS%nMode ; do fr=1,CS%nFreq - call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, CS%nAngle, CS%use_PPMang) + call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, US, CS%nAngle, CS%use_PPMang) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -271,7 +277,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Propagate the waves. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, G, CS, CS%NAngle) + call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, G, US, CS, CS%NAngle) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -292,7 +298,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply the other half of the refraction. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, CS%NAngle, CS%use_PPMang) + call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, US, CS%NAngle, CS%use_PPMang) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -421,8 +427,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do j=jsd,jed ; do i=isd,ied id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging ! Calculate horizontal phase velocity magnitudes - f2 = 0.25*(G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2 + & - G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2 ) + f2 = 0.25*US%s_to_T**2*(G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2 + & + G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2 ) + !### For rotational symmetry this should be + ! f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + ! (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) Kmag2 = (freq2 - f2) / (cn(i,j,m)**2 + cn_subRO**2) c_phase = 0.0 if (Kmag2 > 0.0) then @@ -730,7 +739,7 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) end subroutine get_lowmode_loss !> Implements refraction on the internal waves at a single frequency. -subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) +subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -742,6 +751,7 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) intent(in) :: cn !< Baroclinic mode speed [m s-1]. real, intent(in) :: freq !< Wave frequency [s-1]. real, intent(in) :: dt !< Time step [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: use_PPMang !< If true, use PPM for advection rather !! than upwind. ! Local variables @@ -795,24 +805,24 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) ! Do the refraction. do i=is,ie - f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + f2 = 0.25*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) - favg = 0.25*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & - (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J))) - df2_dx = 0.5*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) - & + favg = 0.25*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & + (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J))) + df2_dx = 0.5*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) - & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I-1,J-1)**2)) * & G%IdxT(i,j) - df_dx = 0.5*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & + df_dx = 0.5*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & (G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1))) * & G%IdxT(i,j) dlnCn_dx = 0.5*( G%IdxCu(I,j) * (cn(i+1,j) - cn(i,j)) / & (0.5*(cn(i+1,j) + cn(i,j)) + cn_subRO) + & G%IdxCu(I-1,j) * (cn(i,j) - cn(i-1,j)) / & (0.5*(cn(i,j) + cn(i-1,j)) + cn_subRO) ) - df2_dy = 0.5*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) - & + df2_dy = 0.5*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) - & (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2)) * & G%IdyT(i,j) - df_dy = 0.5*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & + df_dy = 0.5*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1))) * & G%IdyT(i,j) dlnCn_dy = 0.5*( G%IdyCv(i,J) * (cn(i,j+1) - cn(i,j)) / & @@ -950,7 +960,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) end subroutine PPM_angular_advect !> Propagates internal waves at a single frequency. -subroutine propagate(En, cn, freq, dt, G, CS, NAngle) +subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -962,6 +972,7 @@ subroutine propagate(En, cn, freq, dt, G, CS, NAngle) intent(in) :: cn !< Baroclinic mode speed [m s-1]. real, intent(in) :: freq !< Wave frequency [s-1]. real, intent(in) :: dt !< Time step [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. ! Local variables @@ -1012,7 +1023,7 @@ subroutine propagate(En, cn, freq, dt, G, CS, NAngle) ! Fix indexing here later speed(:,:) = 0 do J=jsh-1,jeh ; do I=ish-1,ieh - f2 = G%CoriolisBu(I,J)**2 + f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 speed(I,J) = 0.25*(cn(i,j) + cn(i+1,j) + cn(i+1,j+1) + cn(i,j+1)) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo @@ -1042,12 +1053,12 @@ subroutine propagate(En, cn, freq, dt, G, CS, NAngle) enddo do j=jsh,jeh ; do I=ish-1,ieh - f2 = 0.5*(G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) + f2 = 0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) speed_x(I,j) = 0.5*(cn(i,j) + cn(i+1,j)) * G%mask2dCu(I,j) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo do J=jsh-1,jeh ; do i=ish,ieh - f2 = 0.5*(G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) + f2 = 0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) speed_y(i,J) = 0.5*(cn(i,j) + cn(i,j+1)) * G%mask2dCv(i,J) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 3f250bc935..1182ce94e7 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -719,7 +719,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) ! Local variables real :: KhTr_Slope_Cff, KhTh_Slope_Cff, oneOrTwo, N2_filter_depth real :: KhTr_passivity_coeff - real, parameter :: absurdly_small_freq2 = 1e-34 ! A miniscule frequency + real :: absurdly_small_freq2 ! A miniscule frequency ! squared that is used to avoid division by 0 [s-2]. This ! value is roughly (pi / (the age of the universe) )^2. logical :: Gill_equatorial_Ld, use_FGNV_streamfn, use_MEKE, in_use @@ -747,6 +747,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) CS%calculate_Rd_dx = .false. CS%calculate_res_fns = .false. CS%calculate_Eady_growth_rate = .false. + absurdly_small_freq2 = 1e-34 !### Note the hard-coded dimensional parameter. ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -946,8 +947,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do J=js-1,Jeq ; do I=is-1,Ieq CS%f2_dx2_q(I,J) = (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * & - max(G%CoriolisBu(I,J)**2, absurdly_small_freq2) - CS%beta_dx2_q(I,J) = oneOrTwo * (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * (sqrt(0.5 * & + max(US%s_to_T**2 * G%CoriolisBu(I,J)**2, absurdly_small_freq2) + CS%beta_dx2_q(I,J) = oneOrTwo * (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * (US%s_to_T * sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -956,8 +957,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do j=js,je ; do I=is-1,Ieq CS%f2_dx2_u(I,j) = (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * & - max(0.5*(G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq2) - CS%beta_dx2_u(I,j) = oneOrTwo * (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * (sqrt( & + max(0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq2) + CS%beta_dx2_u(I,j) = oneOrTwo * (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * (US%s_to_T * sqrt( & 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * G%IdxCv(i+1,J-1))**2 + & @@ -967,8 +968,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do J=js-1,Jeq ; do i=is,ie CS%f2_dx2_v(i,J) = (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * & - max(0.5*(G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq2) - CS%beta_dx2_v(i,J) = oneOrTwo * (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * (sqrt( & + max(0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq2) + CS%beta_dx2_v(i,J) = oneOrTwo * (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * (US%s_to_T * sqrt( & ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * G%IdyCu(I-1,j+1))**2) + & @@ -990,10 +991,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%f2_dx2_h(isd:ied,jsd:jed)) ; CS%f2_dx2_h(:,:) = 0.0 do j=js-1,je+1 ; do i=is-1,ie+1 CS%f2_dx2_h(i,j) = (G%dxT(i,j)**2 + G%dyT(i,j)**2) * & - max(0.25 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + max(0.25 * US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)), & absurdly_small_freq2) - CS%beta_dx2_h(i,j) = oneOrTwo * (G%dxT(i,j)**2 + G%dyT(i,j)**2) * (sqrt(0.5 * & + CS%beta_dx2_h(i,j) = oneOrTwo * (G%dxT(i,j)**2 + G%dyT(i,j)**2) * (US%s_to_T * sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index d2a1abb730..eef2a2f954 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -357,7 +357,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP do do j=js,je ; do I=is-1,ie u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_l_f ) & @@ -433,7 +433,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP do do J=js-1,je ; do i=is,ie u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & ( sqrt( 0.5 * ( G%dxCv(i,J)**2 + G%dyCv(i,J)**2 ) ) * I_l_f ) & @@ -657,7 +657,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. @@ -705,7 +705,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index ef0e9504ac..139754cada 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -959,8 +959,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF enddo ! things independent of position within the column - Coriolis = 0.25*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) & - +(G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) + Coriolis = 0.25*US%s_to_T*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & + (G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) surfFricVel = US%Z_to_m * uStar(i,j) ! Bullk Richardson number computed for each cell in a column, diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 9b3aee8e7d..be7d0ff08b 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -670,7 +670,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C kU_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & fluxes%frac_shelf_h(i,j) * (0.41*fluxes%ustar_shelf(i,j)) endif - absf_x_H = 0.25 * US%m_to_Z * h(i,0) * & !### I think this should be H_to_Z -RWH + absf_x_H = 0.25 * US%m_to_Z * US%s_to_T * h(i,0) * & !### I think this should be H_to_Z -RWH ((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) ! If the mixed layer vertical viscosity specification is changed in @@ -1355,7 +1355,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, real :: totEn_Z ! The total potential energy released by convection, [Z3 s-2 ~> m3 s-2]. real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim]. - real :: absf ! The absolute value of f averaged to thickness points, s-1. + real :: absf ! The absolute value of f averaged to thickness points [s-1]. real :: U_star ! The friction velocity [Z s-1 ~> m s-1]. real :: absf_Ustar ! The absolute value of f divided by U_star [Z-1 ~> m-1]. real :: wind_TKE_src ! The surface wind source of TKE [Z m2 s-3 ~> m3 s-3]. @@ -1377,8 +1377,8 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (U_Star < CS%ustar_min) U_Star = CS%ustar_min if (CS%omega_frac < 1.0) then - absf = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & + (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 53e4b29178..5c9d06e96f 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -95,8 +95,8 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) enddo ustar = 0.01*US%m_to_Z ! Change this to being an input parameter? - absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & - (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J)))) + absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & + (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J)))) Kd(1) = 0.0 ; Kd(nz+1) = 0.0 do K=2,nz tmp1 = h_top(K) * h_bot(K) * GV%H_to_Z diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 5d4d70ec30..b171570f8e 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -624,8 +624,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS Bf_Unstable = min(0.0, buoy_flux(i,j)) ! Negative for unstable if (CS%omega_frac >= 1.0) then ; absf(i) = 2.0*CS%omega else - absf(i) = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + absf(i) = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & + (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) if (CS%omega_frac > 0.0) & absf(i) = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf(i)**2) endif diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index a92106444e..428048665b 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -289,8 +289,8 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & nzc = nz do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo endif - f2 = 0.25*((G%CoriolisBu(I,j)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + f2 = 0.25 * US%s_to_T**2 * ((G%CoriolisBu(I,j)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) surface_pres = 0.0 ; if (associated(p_surf)) surface_pres = p_surf(i,j) ! ---------------------------------------------------- @@ -612,7 +612,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ nzc = nz do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo endif - f2 = G%CoriolisBu(I,J)**2 + f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 surface_pres = 0.0 ; if (associated(p_surf)) then surface_pres = 0.25 * ((p_surf(i,j) + p_surf(i+1,j+1)) + & (p_surf(i+1,j) + p_surf(i,j+1))) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index e4214c8d16..962a9d07c2 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1219,8 +1219,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ustar_h = visc%ustar_BBL(i,j) if (associated(fluxes%ustar_tidal)) & ustar_h = ustar_h + US%m_to_Z*fluxes%ustar_tidal(i,j) - absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & - (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) + absf = 0.25 * US%s_to_T * ((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & + (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) if ((ustar_h > 0.0) .and. (absf > 0.5*CS%IMax_decay*ustar_h)) then I2decay(i) = absf / ustar_h else @@ -1433,8 +1433,8 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & do i=G%isc,G%iec ! Developed in single-column mode ! Column-wise parameters. - absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & - (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! + absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & + (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! ! u* at the bottom [m s-1]. ustar = visc%ustar_BBL(i,j) @@ -1583,8 +1583,8 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, if (CS%ML_omega_frac >= 1.0) then f_sq = 4.0*Omega2 else - f_sq = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + f_sq = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) if (CS%ML_omega_frac > 0.0) & f_sq = CS%ML_omega_frac*4.0*Omega2 + (1.0-CS%ML_omega_frac)*f_sq endif diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 7eba2fbac0..ffc2402267 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -625,8 +625,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! The bottom boundary layer thickness is found by solving the same ! equation as in Killworth and Edwards: (h/h_f)^2 + h/h_N = 1. - if (m==1) then ; C2f = (G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) - else ; C2f = (G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) ; endif + if (m==1) then ; C2f = US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + else ; C2f = US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) ; endif if (CS%cdrag * U_bg_sq <= 0.0) then ! This avoids NaNs and overflows, and could be used in all cases, @@ -1202,7 +1202,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri (forces%tauy(i,J-1) + forces%tauy(i+1,J))) if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else - absf = 0.5*(abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I,J-1))) + absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I,J-1))) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif @@ -1405,10 +1405,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri !visc%tbl_thick_shelf_u(I,j) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(I) / (0.5 + sqrt(0.25 + & - ! (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & + ! (htot(i)*US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & ! (ustar(i)*GV%Z_to_H)**2 )) ) ustar1 = ustar(i)*GV%Z_to_H - h2f2 = (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 + h2f2 = (htot(i)*US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_u(I,j) = tbl_thick_Z @@ -1437,7 +1437,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri (forces%taux(I-1,j) + forces%taux(I,j+1))) if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else - absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif @@ -1642,10 +1642,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri !visc%tbl_thick_shelf_v(i,J) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(i) / (0.5 + sqrt(0.25 + & - ! (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & + ! (htot(i)*US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & ! (ustar(i)*GV%Z_to_H)**2 )) ) ustar1 = ustar(i)*GV%Z_to_H - h2f2 = (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 + h2f2 = (htot(i)*US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_v(i,J) = tbl_thick_Z diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index e01374b5c6..cfcd5ec6c3 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1292,11 +1292,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (GV%nkml>0) nk_visc(i) = real(GV%nkml+1) if (work_on_u) then u_star(I) = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + absf(I) = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(I) = visc%nkml_visc_u(I,j) + 1 else u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + absf(i) = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(i) = visc%nkml_visc_v(i,J) + 1 endif h_ml(i) = h_neglect ; z_t(i) = 0.0 diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index c29e3beded..efd75810d6 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -258,8 +258,7 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) Uocn = state%u(I,j)*REL_TAU_FAC Vocn = 0.25*(state%v(i,J)+state%v(i+1,J-1)& +state%v(i+1,J)+state%v(i,J-1))*REL_TAU_FAC - f = abs(0.5*(G%CoriolisBu(I,J)+G%CoriolisBu(I,J-1)))*fbench_fac & - + fbench + f = abs(0.5*US%s_to_T*(G%CoriolisBu(I,J)+G%CoriolisBu(I,J-1)))*fbench_fac + fbench ! Calculate position as a function of time. if (CS%SCM_mode) then YY = YC + CS%dy_from_center @@ -281,8 +280,7 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) Uocn = 0.25*(state%u(I,j)+state%u(I-1,j+1)& +state%u(I-1,j)+state%u(I,j+1))*REL_TAU_FAC Vocn = state%v(i,J)*REL_TAU_FAC - f = abs(0.5*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))*fbench_fac & - + fbench + f = abs(0.5*US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))*fbench_fac + fbench ! Calculate position as a function of time. if (CS%SCM_mode) then YY = YC + CS%dy_from_center @@ -487,10 +485,10 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) B = C**2 * 1.2 * exp(1.0) endif A = (CS%rad_max_wind/1000.)**B - f =G%CoriolisBu(is,js) ! f=f(x,y) but in the SCM is constant + f = US%s_to_T*G%CoriolisBu(is,js) ! f=f(x,y) but in the SCM is constant if (BR_Bench) then ! f reset to value used in generated wind for benchmark test - f = 5.5659e-05 + f = 5.5659e-05 !### A constant value in s-1. endif !/ BR ! Calculate x position as a function of time. diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 85e11435dc..6114464bf5 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -297,7 +297,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) - val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * y / cff) + val2 = fac * exp(- 0.5 * US%s_to_T * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * y / cff) segment%eta(I,j) = val2 * cos(omega * time_sec) segment%normal_vel_bt(I,j) = val1 * cff * sina / & (0.5*(G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index fedd46ab03..418cd648f8 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1251,7 +1251,7 @@ end subroutine StokesMixing !! CHECK THAT RIGHT TIMESTEP IS PASSED IF YOU USE THIS** !! !! Not accessed in the standard code. -subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) +subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES, US) type(ocean_grid_type), & intent(in) :: G !< Ocean grid type(verticalGrid_type), & @@ -1265,8 +1265,9 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) intent(inout) :: v !< Velocity j-component [m s-1] type(Wave_parameters_CS), & pointer :: Waves !< Surface wave related control structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: DVel + real :: DVel ! A rescaled velocity change [m s-1 T-1 ~> m s-2] integer :: i,j,k do k = 1, G%ke @@ -1274,7 +1275,7 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) do I = G%iscB, G%iecB DVel = 0.25*(WAVES%us_y(i,j+1,k)+WAVES%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + & 0.25*(WAVES%us_y(i,j,k)+WAVES%us_y(i-1,j,k))*G%CoriolisBu(i,j) - u(I,j,k) = u(I,j,k) + DVEL*DT + u(I,j,k) = u(I,j,k) + DVEL*US%s_to_T*DT enddo enddo enddo @@ -1284,7 +1285,7 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) do i = G%isc, G%iec DVel = 0.25*(WAVES%us_x(i+1,j,k)+WAVES%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + & 0.25*(WAVES%us_x(i,j,k)+WAVES%us_x(i,j-1,k))*G%CoriolisBu(i,j) - v(i,J,k) = v(i,j,k) - DVEL*DT + v(i,J,k) = v(i,j,k) - DVEL*US%s_to_T*DT enddo enddo enddo diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 357396b794..adfff7949f 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -165,11 +165,11 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p ! This uses d/d y_2 atan(y_2 / jet_width) ! u(I,j,k) = u(I,j,k+1) + (1e-3 * jet_height / & ! (jet_width * (1.0 + (y_2 / jet_width)**2))) * & -! (2.0 * GV%g_prime(K+1) / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) +! (2.0 * GV%g_prime(K+1) * US%T_to_s / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) ! This uses d/d y_2 tanh(y_2 / jet_width) u(I,j,k) = u(I,j,k+1) + (1e-3 * (jet_height / jet_width) * & (sech(y_2 / jet_width))**2 ) * & - (2.0 * GV%g_prime(K+1) / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) + (2.0 * GV%g_prime(K+1) * US%T_to_s / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) enddo ; enddo ; enddo do k=1,nz ; do j=js,je ; do I=is-1,ie diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index a3f23361f7..a32a2978b7 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -7,6 +7,7 @@ module Rossby_front_2d_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -159,9 +160,10 @@ end subroutine Rossby_front_initialize_temperature_salinity !> Initialization of u and v in the Rossby front test -subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_read_params) +subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: u !< i-component of velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -178,7 +180,8 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f real :: dRho_dT real :: Dml, zi, zc, zm ! Depths [Z ~> m]. - real :: f, Ty + real :: f ! The local Coriolis parameter [T-1 ~> s-1] + real :: Ty real :: hAtU ! Interpolated layer thickness [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz logical :: just_read ! If true, just read parameters but set nothing. @@ -200,9 +203,9 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea u(:,:,:) = 0.0 do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1 - f = 0.5*( G%CoriolisBu(I,j) + G%CoriolisBu(I,j-1) ) + f = 0.5* (G%CoriolisBu(I,j) + G%CoriolisBu(I,j-1) ) dUdT = 0.0 ; if (abs(f) > 0.0) & - dUdT = ( GV%g_Earth * dRho_dT ) / ( f * GV%Rho0 ) + dUdT = ( GV%g_Earth * dRho_dT ) / ( US%s_to_T * f * GV%Rho0 ) Dml = Hml( G, G%geoLatT(i,j) ) Ty = dTdy( G, T_range, G%geoLatT(i,j) ) zi = 0. diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 1de9c3664a..d79e9183bf 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -246,7 +246,7 @@ end subroutine write_user_log !! - v - Meridional velocity [m s-1]. !! - h - Layer thickness [H ~> m or kg m-2]. (Must be positive.) !! - G%bathyT - Basin depth [Z ~> m]. (Must be positive.) -!! - G%CoriolisBu - The Coriolis parameter [s-1]. +!! - G%CoriolisBu - The Coriolis parameter [T-1 ~> s-1]. !! - GV%g_prime - The reduced gravity at each interface [m2 Z-1 s-2 ~> m s-2]. !! - GV%Rlay - Layer potential density (coordinate variable) [kg m-3]. !! If ENABLE_THERMODYNAMICS is defined: From dc2e629f6f695721b8d21e3c60c1842229d058e1 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 9 Apr 2019 15:42:42 -0400 Subject: [PATCH 70/77] Travis: switch to mpich2 - After moving to the xanadu version of FMS, Travis-CI was failing to link due to not being able to find mpi_comm_create_group(). Attempts to use the xenial distribution introduced different problems. - This is a temporary work around. - We need to be able to build in newer distributions. --- .travis.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index f211d9f162..2886eb09bd 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,14 +4,13 @@ # This is a not a c-language project but we use the same environment. language: c dist: trusty -sudo: false addons: apt: sources: - ubuntu-toolchain-r-test packages: - - tcsh pkg-config netcdf-bin libnetcdf-dev openmpi-bin libopenmpi-dev gfortran + - tcsh pkg-config netcdf-bin libnetcdf-dev mpich2 libmpich2-dev gfortran # For saving time... cache: From 2d4161cb4390c6fbb574791164bb8e7ac70a39a5 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 10 Apr 2019 17:27:39 -0400 Subject: [PATCH 71/77] Fix doxygen typos --- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 2 +- src/user/MOM_wave_interface.F90 | 10 +++++----- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 21e06ebcef..5d9f413f24 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1264,7 +1264,7 @@ end subroutine MEKE_end !! !! \f$L_c\f$ is a constant and \f$\delta[L_c]\f$ is the impulse function so that the term !! \f$\frac{\delta[L_c]}{L_c}\f$ evaluates to \f$\frac{1}{L_c}\f$ when \f$L_c\f$ is non-zero -!! but is dropped if \f$L_c=0\fi$. +!! but is dropped if \f$L_c=0\f$. !! !! \f$\beta^*\f$ is the effective \f$\beta\f$ that combines both the planetary vorticity !! gradient (i.e. \f$\beta=\nabla f\f$) and the topographic \f$\beta\f$ effect, diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 7d683944a2..12ee411831 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -48,7 +48,7 @@ module MOM_bkgnd_mixing !! Bryan-Lewis profile [m] real :: bckgrnd_vdc1 !< Background diffusivity (Ledwell) when !! horiz_varying_background=.true. - real :: bckgrnd_vdc_eq !! Equatorial diffusivity (Gregg) when + real :: bckgrnd_vdc_eq !< Equatorial diffusivity (Gregg) when !! horiz_varying_background=.true. real :: bckgrnd_vdc_psim !< Max. PSI induced diffusivity (MacKinnon) when !! horiz_varying_background=.true. diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index fedd46ab03..b6c455e673 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -111,11 +111,11 @@ module MOM_wave_interface type(diag_ctrl), pointer, public :: diag !< A structure that is used to regulate the !! timing of diagnostic output. - ! An arbitrary lower-bound on the Langmuir number. Run-time parameter. - ! Langmuir number is sqrt(u_star/u_stokes). When both are small - ! but u_star is orders of magnitude smaller the Langmuir number could - ! have unintended consequences. Since both are small it can be safely capped - ! to avoid such consequences. + !> An arbitrary lower-bound on the Langmuir number. Run-time parameter. + !! Langmuir number is sqrt(u_star/u_stokes). When both are small + !! but u_star is orders of magnitude smaller the Langmuir number could + !! have unintended consequences. Since both are small it can be safely capped + !! to avoid such consequences. real :: La_min = 0.05 !>@{ Diagnostic handles From f3e4d7b282d68caf4af7904f01d68404b1b35821 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 10 Apr 2019 17:27:52 -0400 Subject: [PATCH 72/77] Doxygenized down sampling routine in diag_mediator - Missing documentation for APIs and types have been added. - doxygen.log should now be clean of errors. --- src/framework/MOM_diag_mediator.F90 | 280 +++++++++++++++++----------- src/framework/MOM_domains.F90 | 18 +- 2 files changed, 185 insertions(+), 113 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index d862f8c815..954bf48e90 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -69,18 +69,22 @@ module MOM_diag_mediator module procedure post_data_3d, post_data_2d, post_data_1d_k, post_data_0d end interface post_data +!> Down sample a field interface downsample_field module procedure downsample_field_2d, downsample_field_3d end interface downsample_field +!> Down sample the mask of a field interface downsample_mask module procedure downsample_mask_2d, downsample_mask_3d end interface downsample_mask +!> Down sample a diagnostic field interface downsample_diag_field module procedure downsample_diag_field_2d, downsample_diag_field_3d end interface downsample_diag_field +!> Contained for down sampled masks type, private :: diag_dsamp real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes @@ -143,25 +147,25 @@ module MOM_diag_mediator type(diag_grids_type), dimension(:), allocatable :: diag_grids !< Primarily empty, except h field end type diag_grid_storage -!> integers to encode the total cell methods +! Integers to encode the total cell methods !integer :: PPP=111 ! x:point,y:point,z:point, this kind of diagnostic is not currently present in diag_table.MOM6 !integer :: PPS=112 ! x:point,y:point,z:sum , this kind of diagnostic is not currently present in diag_table.MOM6 !integer :: PPM=113 ! x:point,y:point,z:mean , this kind of diagnostic is not currently present in diag_table.MOM6 -integer :: PSP=121 ! x:point,y:sum,z:point -integer :: PSS=122 ! x:point,y:sum,z:point -integer :: PSM=123 ! x:point,y:sum,z:mean -integer :: PMP=131 ! x:point,y:mean,z:point -integer :: PMM=133 ! x:point,y:mean,z:mean -integer :: SPP=211 ! x:sum,y:point,z:point -integer :: SPS=212 ! x:sum,y:point,z:sum -integer :: SSP=221 ! x:sum;y:sum,z:point -integer :: MPP=311 ! x:mean,y:point,z:point -integer :: MPM=313 ! x:mean,y:point,z:mean -integer :: MMP=331 ! x:mean,y:mean,z:point -integer :: MMS=332 ! x:mean,y:mean,z:sum -integer :: SSS=222 ! x:sum,y:sum,z:sum -integer :: MMM=333 ! x:mean,y:mean,z:mean -integer :: MSK=-1 ! Use the downsample method of a mask +integer :: PSP=121 !< x:point,y:sum,z:point +integer :: PSS=122 !< x:point,y:sum,z:point +integer :: PSM=123 !< x:point,y:sum,z:mean +integer :: PMP=131 !< x:point,y:mean,z:point +integer :: PMM=133 !< x:point,y:mean,z:mean +integer :: SPP=211 !< x:sum,y:point,z:point +integer :: SPS=212 !< x:sum,y:point,z:sum +integer :: SSP=221 !< x:sum;y:sum,z:point +integer :: MPP=311 !< x:mean,y:point,z:point +integer :: MPM=313 !< x:mean,y:point,z:mean +integer :: MMP=331 !< x:mean,y:mean,z:point +integer :: MMS=332 !< x:mean,y:mean,z:sum +integer :: SSS=222 !< x:sum,y:sum,z:sum +integer :: MMM=333 !< x:mean,y:mean,z:mean +integer :: MSK=-1 !< Use the downsample method of a mask !> This type is used to represent a diagnostic at the diag_mediator level. !! @@ -182,9 +186,10 @@ module MOM_diag_mediator logical :: v_extensive = .false. !< True for vertically extensive fields (vertically integrated). !! False for intensive (concentrations). integer :: xyz_method = 0 !< A 3 digit integer encoding the diagnostics cell method - !! It can be used to determine the downsample algorithm + !! It can be used to determine the downsample algorithm end type diag_type +!> Container for down sampling information type diagcs_dsamp integer :: isc !< The start i-index of cell centers within the computational domain integer :: iec !< The end i-index of cell centers within the computational domain @@ -194,14 +199,22 @@ module MOM_diag_mediator integer :: ied !< The end i-index of cell centers within the data domain integer :: jsd !< The start j-index of cell centers within the data domain integer :: jed !< The end j-index of cell centers within the data domain - integer :: isg,ieg,jsg,jeg - integer :: isgB,iegB,jsgB,jegB - + integer :: isg !< The start i-index of cell centers within the global domain + integer :: ieg !< The end i-index of cell centers within the global domain + integer :: jsg !< The start j-index of cell centers within the global domain + integer :: jeg !< The end j-index of cell centers within the global domain + integer :: isgB !< The start i-index of cell corners within the global domain + integer :: iegB !< The end i-index of cell corners within the global domain + integer :: jsgB !< The start j-index of cell corners within the global domain + integer :: jegB !< The end j-index of cell corners within the global domain + + !>@{ Axes for each location on a diagnostic grid type(axes_grp) :: axesBL, axesTL, axesCuL, axesCvL type(axes_grp) :: axesBi, axesTi, axesCui, axesCvi type(axes_grp) :: axesB1, axesT1, axesCu1, axesCv1 type(axes_grp), dimension(:), allocatable :: remap_axesTL, remap_axesBL, remap_axesCuL, remap_axesCvL type(axes_grp), dimension(:), allocatable :: remap_axesTi, remap_axesBi, remap_axesCui, remap_axesCvi + !!@} real, dimension(:,:), pointer :: mask2dT => null() !< 2D mask array for cell-center points real, dimension(:,:), pointer :: mask2dBu => null() !< 2D mask array for cell-corner points @@ -216,6 +229,7 @@ module MOM_diag_mediator real, dimension(:,:,:), pointer :: mask3dBi => null() real, dimension(:,:,:), pointer :: mask3dCui => null() real, dimension(:,:,:), pointer :: mask3dCvi => null() + !!@} end type diagcs_dsamp !> The following data type a list of diagnostic fields an their variants, @@ -515,7 +529,8 @@ subroutine set_axes_info_dsamp(G, GV, param_file, diag_cs, id_zl_native, id_zi_n type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(param_file_type), intent(in) :: param_file !< Parameter file structure type(diag_ctrl), intent(inout) :: diag_cs !< Diagnostics control structure - integer, intent(in) :: id_zl_native, id_zi_native + integer, intent(in) :: id_zl_native !< ID of native layers + integer, intent(in) :: id_zi_native !< ID of native interfaces ! Local variables integer :: id_xq, id_yq, id_zl, id_zi, id_xh, id_yh @@ -3533,11 +3548,15 @@ end subroutine downsample_diag_masks_set !> Get the diagnostics-compute indices (to be passed to send_data) based on the shape of !! the diag field (the same way they are deduced for non-downsampled fields) -subroutine downsample_diag_indices_get(fo1,fo2, dl, diag_cs,isv,iev,jsv,jev) - integer, intent(in) :: fo1,fo2 !< the sizes of the diag field in x and y - integer, intent(in) :: dl !< integer downsample level - type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output - integer, intent(out) ::isv,iev,jsv,jev !< diagnostics-compute indices (to be passed to send_data) +subroutine downsample_diag_indices_get(fo1, fo2, dl, diag_cs, isv, iev, jsv, jev) + integer, intent(in) :: fo1 !< The size of the diag field in x + integer, intent(in) :: fo2 !< The size of the diag field in y + integer, intent(in) :: dl !< Integer downsample level + type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output + integer, intent(out) :: isv !< i-start index for diagnostics + integer, intent(out) :: iev !< i-end index for diagnostics + integer, intent(out) :: jsv !< j-start index for diagnostics + integer, intent(out) :: jev !< j-end index for diagnostics ! Local variables integer :: dszi,cszi,dszj,cszj,f1,f2 character(len=500) :: mesg @@ -3602,15 +3621,18 @@ end subroutine downsample_diag_indices_get !> This subroutine allocates and computes a downsampled array from an input array !! It also determines the diagnostics-compurte indices for the downsampled array !! 3d interface -subroutine downsample_diag_field_3d(locfield, locfield_dsamp, dl, diag_cs, diag,isv,iev,jsv,jev, mask) - real, dimension(:,:,:), pointer :: locfield !< input array pointer - real, dimension(:,:,:), allocatable, intent(inout) :: locfield_dsamp !< output (downsampled) array +subroutine downsample_diag_field_3d(locfield, locfield_dsamp, dl, diag_cs, diag, isv, iev, jsv, jev, mask) + real, dimension(:,:,:), pointer :: locfield !< Input array pointer + real, dimension(:,:,:), allocatable, intent(inout) :: locfield_dsamp !< Output (downsampled) array type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post - integer, intent(in) :: dl !< integer downsample level - integer, intent(inout):: isv,iev,jsv,jev !< diagnostics-compute indices (to be passed to send_data) + integer, intent(in) :: dl !< Level of down sampling + integer, intent(inout) :: isv !< i-start index for diagnostics + integer, intent(inout) :: iev !< i-end index for diagnostics + integer, intent(inout) :: jsv !< j-start index for diagnostics + integer, intent(inout) :: jev !< j-end index for diagnostics real, optional,target, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask. - !locals + ! Locals real, dimension(:,:,:), pointer :: locmask integer :: f1,f2,isv_o,jsv_o @@ -3640,15 +3662,18 @@ end subroutine downsample_diag_field_3d !> This subroutine allocates and computes a downsampled array from an input array !! It also determines the diagnostics-compurte indices for the downsampled array !! 2d interface -subroutine downsample_diag_field_2d(locfield, locfield_dsamp, dl, diag_cs, diag,isv,iev,jsv,jev, mask) - real, dimension(:,:), pointer :: locfield !< input array pointer - real, dimension(:,:), allocatable, intent(inout) :: locfield_dsamp !< output (downsampled) array +subroutine downsample_diag_field_2d(locfield, locfield_dsamp, dl, diag_cs, diag, isv, iev, jsv, jev, mask) + real, dimension(:,:), pointer :: locfield !< Input array pointer + real, dimension(:,:), allocatable, intent(inout) :: locfield_dsamp !< Output (downsampled) array type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output - type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post - integer, intent(in) :: dl !< integer downsample level - integer, intent(out):: isv,iev,jsv,jev !< diagnostics-compute indices (to be passed to send_data) + type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post + integer, intent(in) :: dl !< Level of down sampling + integer, intent(inout) :: isv !< i-start index for diagnostics + integer, intent(inout) :: iev !< i-end index for diagnostics + integer, intent(inout) :: jsv !< j-start index for diagnostics + integer, intent(inout) :: jev !< j-end index for diagnostics real, optional,target, intent(in) :: mask(:,:) !< If present, use this real array as the data mask. - !locals + ! Locals real, dimension(:,:), pointer :: locmask integer :: f1,f2,isv_o,jsv_o @@ -3675,50 +3700,58 @@ subroutine downsample_diag_field_2d(locfield, locfield_dsamp, dl, diag_cs, diag, end subroutine downsample_diag_field_2d -!> The downsample algorithm -!! The downsample method could be deduced (before send_data call) +!> \section downsampling The down sample algorithm +!! +!! The down sample method could be deduced (before send_data call) !! from the diag%x_cell_method, diag%y_cell_method and diag%v_cell_method !! -!! This is the summary of the downsample algoritm for a diagnostic field f: -!! f(Id,Jd) = \sum_{i,j} f(Id+i,Jd+j) * weight(Id+i,Jd+j) / [ \sum_{i,j} weight(Id+i,Jd+j)] -!! i and j run from 0 to dl-1 (dl being the downsample level) -!! Id,Jd are the downsampled (coarse grid) indices run over the coarsened compute grid, -!! if and jf are the original (fine grid) indices +!! This is the summary of the down sample algoritm for a diagnostic field f: +!! \f[ +!! f(Id,Jd) = \sum_{i,j} f(Id+i,Jd+j) * weight(Id+i,Jd+j) / [ \sum_{i,j} weight(Id+i,Jd+j)] +!! \f] +!! Here, i and j run from 0 to dl-1 (dl being the down sample level). +!! Id,Jd are the down sampled (coarse grid) indices run over the coarsened compute grid, +!! if and jf are the original (fine grid) indices. !! -!!example x_cell y_cell v_cell algorithm_id impemented weight(if,jf) -!!--------------------------------------------------------------------------------------- -!!theta mean mean mean MMM =222 G%areaT(if,jf)*h(if,jf) -!!u point mean mean PMM =022 dyCu(if,jf)*h(if,jf)*delta(if,Id) -!!v mean point mean MPM =202 dxCv(if,jf)*h(if,jf)*delta(jf,Jd) -!!? point sum mean PSM =012 h(if,jf)*delta(if,Id) -!!volcello sum sum sum SSS =111 1 -!!T_dfxy_co sum sum point SSP =110 1 -!!umo point sum sum PSS =011 1*delta(if,Id) -!!vmo sum point sum SPS =101 1*delta(jf,Jd) -!!umo_2d point sum point PSP =010 1*delta(if,Id) -!!vmo_2d sum point point SPP =100 1*delta(jf,Jd) -!!? point mean point PMP =020 dyCu(if,jf)*delta(if,Id) -!!? mean point point MPP =200 dxCv(if,jf)*delta(jf,Jd) -!!w mean mean point MMP =220 G%areaT(if,jf) -!!h*theta mean mean sum MMS =221 G%areaT(if,jf) +!! \verbatim +!! Example x_cell y_cell v_cell algorithm_id implemented weight(if,jf) +!! --------------------------------------------------------------------------------------- +!! theta mean mean mean MMM =222 G%areaT(if,jf)*h(if,jf) +!! u point mean mean PMM =022 dyCu(if,jf)*h(if,jf)*delta(if,Id) +!! v mean point mean MPM =202 dxCv(if,jf)*h(if,jf)*delta(jf,Jd) +!! ? point sum mean PSM =012 h(if,jf)*delta(if,Id) +!! volcello sum sum sum SSS =111 1 +!! T_dfxy_co sum sum point SSP =110 1 +!! umo point sum sum PSS =011 1*delta(if,Id) +!! vmo sum point sum SPS =101 1*delta(jf,Jd) +!! umo_2d point sum point PSP =010 1*delta(if,Id) +!! vmo_2d sum point point SPP =100 1*delta(jf,Jd) +!! ? point mean point PMP =020 dyCu(if,jf)*delta(if,Id) +!! ? mean point point MPP =200 dxCv(if,jf)*delta(jf,Jd) +!! w mean mean point MMP =220 G%areaT(if,jf) +!! h*theta mean mean sum MMS =221 G%areaT(if,jf) !! -!!delta is the Kroneker delta +!! delta is the Kronecker delta +!! \endverbatim -!> This subroutine allocates and computes a downsampled array given an input array -!! The downsample method is based on the "cell_methods" for the diagnostics as explained +!> This subroutine allocates and computes a down sampled 3d array given an input array +!! The down sample method is based on the "cell_methods" for the diagnostics as explained !! in the above table -!! 3d interface subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, diag,isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d) - real, dimension(:,:,:) , pointer :: field_in - real, dimension(:,:,:) , allocatable :: field_out - integer , intent(in) :: dl - integer, intent(in) :: method !< sampling method - real, dimension(:,:,:), pointer :: mask - type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output - type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post - integer , intent(in) :: isv_o,jsv_o !< original indices, In practice isv_o=jsv_o=1 - integer , intent(in) :: isv_d,iev_d,jsv_d,jev_d !< dsampaed indices - !locals + real, dimension(:,:,:), pointer :: field_in !< Original field to be down sampled + real, dimension(:,:,:), allocatable :: field_out !< down sampled field + integer, intent(in) :: dl !< Level of down sampling + integer, intent(in) :: method !< Sampling method + real, dimension(:,:,:), pointer :: mask !< Mask for field + type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output + type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post + integer, intent(in) :: isv_o !< Original i-start index + integer, intent(in) :: jsv_o !< Original j-start index + integer, intent(in) :: isv_d !< i-start index of down sampled data + integer, intent(in) :: iev_d !< i-end index of down sampled data + integer, intent(in) :: jsv_d !< j-start index of down sampled data + integer, intent(in) :: jev_d !< j-end index of down sampled data + ! Locals character(len=240) :: mesg integer :: i,j,ii,jj,i0,j0,f1,f2,f_in1,f_in2 integer :: k,ks,ke @@ -3726,7 +3759,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d real :: epsilon = 1.0e-20 ks=1 ; ke =size(field_in,3) - !Allocate the downsampled field on the downsampled data domain + ! Allocate the down sampled field on the down sampled data domain ! allocate(field_out(diag_cs%dsamp(dl)%isd:diag_cs%dsamp(dl)%ied,diag_cs%dsamp(dl)%jsd:diag_cs%dsamp(dl)%jed,ks:ke)) ! allocate(field_out(1:size(field_in,1)/dl,1:size(field_in,2)/dl,ks:ke)) f_in1 = size(field_in,1) @@ -3740,7 +3773,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d endif allocate(field_out(1:f1,1:f2,ks:ke)) - !Fill the downsampled field on the downsampled diagnostics (almost always compuate) domain + ! Fill the down sampled field on the down sampled diagnostics (almost always compuate) domain if(method .eq. MMM) then do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) @@ -3871,31 +3904,39 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d end subroutine downsample_field_3d -subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag,isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d) - real, dimension(:,:) , pointer :: field_in - real, dimension(:,:) , allocatable :: field_out - integer , intent(in) :: dl - integer, intent(in) :: method !< sampling method - real, dimension(:,:), pointer :: mask +!> This subroutine allocates and computes a down sampled 2d array given an input array +!! The down sample method is based on the "cell_methods" for the diagnostics as explained +!! in the above table +subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, diag, & + isv_o, jsv_o, isv_d, iev_d, jsv_d, jev_d) + real, dimension(:,:), pointer :: field_in !< Original field to be down sampled + real, dimension(:,:), allocatable :: field_out !< Down sampled field + integer, intent(in) :: dl !< Level of down sampling + integer, intent(in) :: method !< Sampling method + real, dimension(:,:), pointer :: mask !< Mask for field type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output - type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post - integer , intent(in) :: isv_o,jsv_o !< original indices, In practice isv_o=jsv_o=1 - integer , intent(in) :: isv_d,iev_d,jsv_d,jev_d !< dsampaed indices - !locals + type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post + integer, intent(in) :: isv_o !< Original i-start index + integer, intent(in) :: jsv_o !< Original j-start index + integer, intent(in) :: isv_d !< i-start index of down sampled data + integer, intent(in) :: iev_d !< i-end index of down sampled data + integer, intent(in) :: jsv_d !< j-start index of down sampled data + integer, intent(in) :: jev_d !< j-end index of down sampled data + ! Locals character(len=240) :: mesg integer :: i,j,ii,jj,i0,j0,f1,f2,f_in1,f_in2 real :: ave,total_weight,weight real :: epsilon = 1.0e-20 - !Allocate the downsampled field on the downsampled data domain + ! Allocate the down sampled field on the down sampled data domain ! allocate(field_out(diag_cs%dsamp(dl)%isd:diag_cs%dsamp(dl)%ied,diag_cs%dsamp(dl)%jsd:diag_cs%dsamp(dl)%jed)) ! allocate(field_out(1:size(field_in,1)/dl,1:size(field_in,2)/dl)) - !Fill the downsampled field on the downsampled diagnostics (almost always compuate) domain + ! Fill the down sampled field on the down sampled diagnostics (almost always compuate) domain f_in1 = size(field_in,1) f_in2 = size(field_in,2) f1 = f_in1/dl f2 = f_in2/dl - !Correction for the symmetric case + ! Correction for the symmetric case if (diag_cs%G%symmetric) then f1 = f1 + mod(f_in1,dl) f2 = f2 + mod(f_in2,dl) @@ -4004,19 +4045,28 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs,di end subroutine downsample_field_2d -!> Allocate and compute the downsampled masks -!! The masks are downsampled based on a minority rule, i.e., a coarse cell is open (1) +!> Allocate and compute the 2d down sampled mask +!! The masks are down sampled based on a minority rule, i.e., a coarse cell is open (1) !! if at least one of the sub-cells are open, otherwise it's closed (0) -subroutine downsample_mask_2d(field_in, field_out, dl, isc_o,jsc_o, isc_d,iec_d,jsc_d,jec_d , isd_d,ied_d,jsd_d,jed_d) - real, dimension(:,:) , intent(in) :: field_in - real, dimension(:,:) , pointer :: field_out - integer , intent(in) :: dl - integer , intent(in) :: isc_o,jsc_o - integer , intent(in) :: isc_d,iec_d,jsc_d,jec_d !< downsampled mask compute indices - integer , intent(in) :: isd_d,ied_d,jsd_d,jed_d !< downsampled mask data indices +subroutine downsample_mask_2d(field_in, field_out, dl, isc_o, jsc_o, isc_d, iec_d, jsc_d, jec_d, & + isd_d, ied_d, jsd_d, jed_d) + real, dimension(:,:), intent(in) :: field_in !< Original field to be down sampled + real, dimension(:,:), pointer :: field_out !< Down sampled field + integer, intent(in) :: dl !< Level of down sampling + integer, intent(in) :: isc_o !< Original i-start index + integer, intent(in) :: jsc_o !< Original j-start index + integer, intent(in) :: isc_d !< Computational i-start index of down sampled data + integer, intent(in) :: iec_d !< Computational i-end index of down sampled data + integer, intent(in) :: jsc_d !< Computational j-start index of down sampled data + integer, intent(in) :: jec_d !< Computational j-end index of down sampled data + integer, intent(in) :: isd_d !< Computational i-start index of down sampled data + integer, intent(in) :: ied_d !< Computational i-end index of down sampled data + integer, intent(in) :: jsd_d !< Computational j-start index of down sampled data + integer, intent(in) :: jed_d !< Computational j-end index of down sampled data + ! Locals integer :: i,j,ii,jj,i0,j0 real :: tot_non_zero - !downsampled mask = 0 unless the mask value of one of the downsampling cells is 1 + ! down sampled mask = 0 unless the mask value of one of the down sampling cells is 1 allocate(field_out(isd_d:ied_d,jsd_d:jed_d)) field_out(:,:) = 0.0 do j=jsc_d,jec_d ; do i=isc_d,iec_d @@ -4030,16 +4080,28 @@ subroutine downsample_mask_2d(field_in, field_out, dl, isc_o,jsc_o, isc_d,iec_d, enddo; enddo end subroutine downsample_mask_2d -subroutine downsample_mask_3d(field_in, field_out, dl, isc_o,jsc_o, isc_d,iec_d,jsc_d,jec_d , isd_d,ied_d,jsd_d,jed_d) - real, dimension(:,:,:) , intent(in) :: field_in - real, dimension(:,:,:) , pointer :: field_out - integer , intent(in) :: dl - integer , intent(in) :: isc_o,jsc_o - integer , intent(in) :: isc_d,iec_d,jsc_d,jec_d !< downsampled mask compute indices - integer , intent(in) :: isd_d,ied_d,jsd_d,jed_d !< downsampled mask data indices +!> Allocate and compute the 3d down sampled mask +!! The masks are down sampled based on a minority rule, i.e., a coarse cell is open (1) +!! if at least one of the sub-cells are open, otherwise it's closed (0) +subroutine downsample_mask_3d(field_in, field_out, dl, isc_o, jsc_o, isc_d, iec_d, jsc_d, jec_d, & + isd_d, ied_d, jsd_d, jed_d) + real, dimension(:,:,:), intent(in) :: field_in !< Original field to be down sampled + real, dimension(:,:,:), pointer :: field_out !< down sampled field + integer, intent(in) :: dl !< Level of down sampling + integer, intent(in) :: isc_o !< Original i-start index + integer, intent(in) :: jsc_o !< Original j-start index + integer, intent(in) :: isc_d !< Computational i-start index of down sampled data + integer, intent(in) :: iec_d !< Computational i-end index of down sampled data + integer, intent(in) :: jsc_d !< Computational j-start index of down sampled data + integer, intent(in) :: jec_d !< Computational j-end index of down sampled data + integer, intent(in) :: isd_d !< Computational i-start index of down sampled data + integer, intent(in) :: ied_d !< Computational i-end index of down sampled data + integer, intent(in) :: jsd_d !< Computational j-start index of down sampled data + integer, intent(in) :: jed_d !< Computational j-end index of down sampled data + ! Locals integer :: i,j,ii,jj,i0,j0,k,ks,ke real :: tot_non_zero - !downsampled mask = 0 unless the mask value of one of the downsampling cells is 1 + ! down sampled mask = 0 unless the mask value of one of the down sampling cells is 1 ks = lbound(field_in,3) ; ke = ubound(field_in,3) allocate(field_out(isd_d:ied_d,jsd_d:jed_d,ks:ke)) field_out(:,:,:) = 0.0 diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 55e6e47b63..e53ec98f5c 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -1825,10 +1825,20 @@ subroutine get_domain_extent_dsamp2(Domain, isc_d2, iec_d2, jsc_d2, jec_d2,& isd_d2, ied_d2, jsd_d2, jed_d2,& isg_d2, ieg_d2, jsg_d2, jeg_d2) type(MOM_domain_type), & - intent(in) :: Domain !< The MOM domain from which to extract information - integer, intent(out) :: isc_d2, iec_d2, jsc_d2, jec_d2 - integer, intent(out) :: isd_d2, ied_d2, jsd_d2, jed_d2 - integer, intent(out) :: isg_d2, ieg_d2, jsg_d2, jeg_d2 + intent(in) :: Domain !< The MOM domain from which to extract information + integer, intent(out) :: isc_d2 !< The start i-index of the computational domain + integer, intent(out) :: iec_d2 !< The end i-index of the computational domain + integer, intent(out) :: jsc_d2 !< The start j-index of the computational domain + integer, intent(out) :: jec_d2 !< The end j-index of the computational domain + integer, intent(out) :: isd_d2 !< The start i-index of the data domain + integer, intent(out) :: ied_d2 !< The end i-index of the data domain + integer, intent(out) :: jsd_d2 !< The start j-index of the data domain + integer, intent(out) :: jed_d2 !< The end j-index of the data domain + integer, intent(out) :: isg_d2 !< The start i-index of the global domain + integer, intent(out) :: ieg_d2 !< The end i-index of the global domain + integer, intent(out) :: jsg_d2 !< The start j-index of the global domain + integer, intent(out) :: jeg_d2 !< The end j-index of the global domain + call mpp_get_compute_domain(Domain%mpp_domain_d2, isc_d2, iec_d2, jsc_d2, jec_d2) call mpp_get_data_domain(Domain%mpp_domain_d2, isd_d2, ied_d2, jsd_d2, jed_d2) call mpp_get_global_domain (Domain%mpp_domain_d2, isg_d2, ieg_d2, jsg_d2, jeg_d2) From 2eeac36eb9300e4bc365d7e7df0fba995d218983 Mon Sep 17 00:00:00 2001 From: "Jessica.Meixner" Date: Thu, 11 Apr 2019 13:30:18 +0000 Subject: [PATCH 73/77] update from Rocky so that NEMS can run with later ESMF beta snapshot --- config_src/nuopc_driver/mom_cap.F90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 25bb8c69aa..fc52b87cdd 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -817,19 +817,29 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! reset shr logging to my log file if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + call NUOPC_CompAttributeGet(gcomp, name="diro", & isPresent=isPresentDiro, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, & + call NUOPC_CompAttributeGet(gcomp, name="logfile", & isPresent=isPresentLogfile, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return if (isPresentDiro .and. isPresentLogfile) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else logunit = output_unit From e4ff4191788e15ddebf03e6acc80a09dd6f37043 Mon Sep 17 00:00:00 2001 From: "Jessica.Meixner" Date: Thu, 11 Apr 2019 13:36:27 +0000 Subject: [PATCH 74/77] remove tabs --- config_src/nuopc_driver/mom_cap.F90 | 206 ++++++------ config_src/nuopc_driver/mom_cap_methods.F90 | 332 ++++++++++---------- config_src/nuopc_driver/mom_cap_time.F90 | 170 +++++----- 3 files changed, 354 insertions(+), 354 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index fc52b87cdd..24e60388b4 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1971,7 +1971,7 @@ subroutine ModelAdvance(gcomp, rc) call ocean_model_restart(ocean_state, restartname=restartname) if (is_root_pe()) then - write(logunit,*) subname//' writing restart file ',trim(restartname) + write(logunit,*) subname//' writing restart file ',trim(restartname) endif endif @@ -2080,59 +2080,59 @@ subroutine ModelSetRunClock(gcomp, rc) restart_ymd = 0 call NUOPC_CompAttributeGet(gcomp, name="restart_option", isPresent=isPresent, & - isSet=isSet, value=restart_option, rc=rc) + isSet=isSet, value=restart_option, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent .and. isSet) then - read(cvalue,*) restart_n - endif - call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent .and. isSet) then - read(cvalue,*) restart_ymd - endif + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) restart_n + endif + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) restart_ymd + endif else - restart_option = "none" + restart_option = "none" endif call AlarmInit(mclock, & - alarm = restart_alarm, & - option = trim(restart_option), & - opt_n = restart_n, & - opt_ymd = restart_ymd, & - RefTime = mcurrTime, & - alarmname = 'alarm_restart', rc=rc) + alarm = restart_alarm, & + option = trim(restart_option), & + opt_n = restart_n, & + opt_ymd = restart_ymd, & + RefTime = mcurrTime, & + alarmname = 'alarm_restart', rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out first_time = .false. call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out endif @@ -2243,8 +2243,8 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ if (scalar_id < 0 .or. scalar_id > scalar_count) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ERROR in scalar_id", & - line=__LINE__, file=__FILE__, rcToReturn=rc) + msg=subname//": ERROR in scalar_id", & + line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -2281,84 +2281,84 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) if (field_defs(i)%shortname == scalar_field_name) then - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=rc) - call SetScalarField(field, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call SetScalarField(field, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out else - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) - - if (present(grid)) then - - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! initialize fldptr to zero - call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - fldptr2d(:,:) = 0.0 - - else if (present(mesh)) then - - field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! initialize fldptr to zero - call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - fldptr1d(:) = 0.0 - - endif + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=rc) + + if (present(grid)) then + + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr2d(:,:) = 0.0 + + else if (present(mesh)) then + + field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr1d(:) = 0.0 + + endif endif ! Realize connected field call NUOPC_Realize(state, field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out else ! field is not connected call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=rc) ! remove a not connected Field from State call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out endif diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 46559fb22a..d893685aec 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -175,14 +175,14 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! rotate taux and tauy from true zonal/meridional to local coordinates do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & - - ocean_grid%sin_rot(ig,jg)*tauy(i,j) - ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & - + ocean_grid%sin_rot(ig,jg)*taux(i,j) - enddo + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & + - ocean_grid%sin_rot(ig,jg)*tauy(i,j) + ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & + + ocean_grid%sin_rot(ig,jg)*taux(i,j) + enddo enddo deallocate(taux, tauy) @@ -191,41 +191,41 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! sensible heat flux (W/m2) !---- call state_getimport(importState, 'mean_sensi_heat_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! evaporation flux (W/m2) !---- call state_getimport(importState, 'mean_evap_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! liquid precipitation (rain) !---- call state_getimport(importState, 'mean_prec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! frozen precipitation (snow) !---- call state_getimport(importState, 'mean_fprec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! runoff and heat content of runoff @@ -236,38 +236,38 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! liquid runoff ice_ocean_boundary%rofl_flux (:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'Foxx_rofl', & - isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! ice runoff ice_ocean_boundary%rofi_flux (:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'Foxx_rofi', & - isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! total runoff ice_ocean_boundary%runoff (:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_runoff_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! heat content of runoff ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_runoff_heat_flux', & - isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! calving rate and heat flux @@ -277,29 +277,29 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ice_ocean_boundary%calving(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_calving_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_calving_heat_flux', & - isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! salt flux from ice !---- call state_getimport(importState, 'mean_salt_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! !---- ! ! snow&ice melt heat flux (W/m^2) @@ -406,8 +406,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do j = jsc, jec jg = j + ocean_grid%jsc - jsc do i = isc, iec - ig = i + ocean_grid%isc - isc - omask(i,j) = nint(ocean_grid%mask2dT(ig,jg)) + ig = i + ocean_grid%isc - isc + omask(i,j) = nint(ocean_grid%mask2dT(ig,jg)) enddo enddo @@ -455,11 +455,11 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do j = jsc, jec jg = j + ocean_grid%jsc - jsc do i = isc, iec - ig = i + ocean_grid%isc - isc - ocz(i,j) = ocean_public%u_surf(i,j) - ocm(i,j) = ocean_public%v_surf(i,j) - ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) + ocean_grid%sin_rot(ig,jg)*ocm(i,j) - ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) - ocean_grid%sin_rot(ig,jg)*ocz(i,j) + ig = i + ocean_grid%isc - isc + ocz(i,j) = ocean_public%u_surf(i,j) + ocm(i,j) = ocean_public%v_surf(i,j) + ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) + ocean_grid%sin_rot(ig,jg)*ocm(i,j) + ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) - ocean_grid%sin_rot(ig,jg)*ocz(i,j) enddo enddo @@ -485,11 +485,11 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, call ESMF_StateGet(exportState, 'So_bldepth', itemFlag, rc=rc) if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then call State_SetExport(exportState, 'So_bldepth', & - isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) + isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out endif ! ------- @@ -502,12 +502,12 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do j = jsc,jec do i = isc,iec - if (ocean_public%frazil(i,j) > 0.0) then - melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int - else - melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int - if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 - endif + if (ocean_public%frazil(i,j) > 0.0) then + melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int + else + melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int + if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 + endif enddo enddo @@ -526,11 +526,11 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, call ESMF_StateGet(exportState, 'sea_level', itemFlag, rc=rc) if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then call State_SetExport(exportState, 'sea_level', & - isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) + isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out endif !---------------- @@ -551,8 +551,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do j = ocean_grid%jsc, ocean_grid%jec jloc = j + ocean_grid%jdg_offset do i = ocean_grid%isc,ocean_grid%iec - iloc = i + ocean_grid%idg_offset - ssh(i,j) = ocean_public%sea_lev(iloc,jloc) + iloc = i + ocean_grid%idg_offset + ssh(i,j) = ocean_public%sea_lev(iloc,jloc) enddo enddo @@ -574,15 +574,15 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. slp_C = 0.5 * (slp_L + slp_R) if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 endif dhdx(iglob,jglob) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdx(iglob,jglob) = 0.0 @@ -604,15 +604,15 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. slp_C = 0.5 * (slp_L + slp_R) if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 endif dhdy(iglob,jglob) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdy(iglob,jglob) = 0.0 @@ -625,9 +625,9 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do j = jsc, jec jg = j + ocean_grid%jsc - jsc do i = isc, iec - ig = i + ocean_grid%isc - isc - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) - dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) + ig = i + ocean_grid%isc - isc + dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) + dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) enddo enddo @@ -735,48 +735,48 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r if (geomtype == ESMF_GEOMTYPE_MESH) then - ! get field pointer - call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! determine output array - n = 0 - do j = jsc,jec - do i = isc,iec - n = n + 1 - if (present(do_sum)) then - output(i,j) = output(i,j) + dataPtr1d(n) - else - output(i,j) = dataPtr1d(n) - endif - enddo - enddo + ! get field pointer + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! determine output array + n = 0 + do j = jsc,jec + do i = isc,iec + n = n + 1 + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr1d(n) + else + output(i,j) = dataPtr1d(n) + endif + enddo + enddo else if (geomtype == ESMF_GEOMTYPE_GRID) then - call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr2d,1) - lbnd2 = lbound(dataPtr2d,2) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - if (present(do_sum)) then - output(i,j) = output(i,j) + dataPtr2d(i1,j1) - else - output(i,j) = dataPtr2d(i1,j1) - endif - enddo - enddo + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr2d(i1,j1) + else + output(i,j) = dataPtr2d(i1,j1) + endif + enddo + enddo endif @@ -820,42 +820,42 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid if (geomtype == ESMF_GEOMTYPE_MESH) then - call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - n = 0 - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - n = n+1 - dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) - enddo - enddo + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + n = 0 + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + n = n+1 + dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) + enddo + enddo else if (geomtype == ESMF_GEOMTYPE_GRID) then - call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr2d,1) - lbnd2 = lbound(dataPtr2d,2) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + ocean_grid%isc - isc - dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) - enddo - enddo + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) + enddo + enddo endif diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 index dc4f81e90e..3f36a131f9 100644 --- a/config_src/nuopc_driver/mom_cap_time.F90 +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -109,18 +109,18 @@ subroutine AlarmInit( clock, alarm, option, & trim(option) == optNYears .or. trim(option) == optNYear .or. & trim(option) == optIfdays0) then if (.not. present(opt_n)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' requires opt_n', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_n', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return endif if (opt_n <= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' invalid opt_n', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' invalid opt_n', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return endif endif @@ -162,157 +162,157 @@ subroutine AlarmInit( clock, alarm, option, & case (optNONE, optNever) call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return update_nextalarm = .false. case (optDate) if (.not. present(opt_ymd)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' requires opt_ymd', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_ymd', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return endif if (lymd < 0 .or. ltod < 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return endif call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return call TimeInit(NextAlarm, lymd, cal, tod=ltod, desc="optDate", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return update_nextalarm = .false. case (optIfdays0) if (.not. present(opt_ymd)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' requires opt_ymd', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_ymd', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return endif call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return update_nextalarm = .true. case (optNSteps, optNStep) call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNSeconds, optNSecond) call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNMinutes, optNMinute) call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNHours, optNHour) call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNDays, optNDay) call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNMonths, optNMonth) call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optMonthly) call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return update_nextalarm = .true. case (optNYears, optNYear) call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optYearly) call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return update_nextalarm = .true. case default call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//' unknown option: '//trim(option), & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) + msg=subname//' unknown option: '//trim(option), & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) return end select @@ -327,7 +327,7 @@ subroutine AlarmInit( clock, alarm, option, & if (update_nextalarm) then NextAlarm = NextAlarm - AlarmInterval do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval + NextAlarm = NextAlarm + AlarmInterval enddo endif @@ -365,13 +365,13 @@ subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) if ( (ymd < 0) .or. (ltod < 0) .or. (ltod > SecPerDay) )then if (present(logunit)) then - write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & - 'time-of-day out of bounds', ymd, ltod + write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & + 'time-of-day out of bounds', ymd, ltod endif call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//' yymmdd is negative or time-of-day out of bounds ', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) + msg=subname//' yymmdd is negative or time-of-day out of bounds ', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) return endif From f7f32862d5aac69fab026a1434be029b33bd0a33 Mon Sep 17 00:00:00 2001 From: John Krasting Date: Thu, 11 Apr 2019 11:38:42 -0400 Subject: [PATCH 75/77] Logic to flag obsolete restart fields - Added entries to the MOM restart control structure to carry a list of restart variables that are no longer used - Introduced register_restart_field_as_obsolete() subroutine - Default behavior is to bring down the model if attempting to use an old restart file --- src/framework/MOM_restart.F90 | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 4d89dccc7b..9f66871d65 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -25,6 +25,7 @@ module MOM_restart public restart_init, restart_end, restore_state, register_restart_field public save_restart, query_initialized, restart_init_end, vardesc public restart_files_exist, determine_is_new_run, is_new_run +public register_restart_field_as_obsolete !> A type for making arrays of pointers to 4-d arrays type p4d @@ -61,11 +62,17 @@ module MOM_restart character(len=32) :: var_name !< A name by which a variable may be queried. end type field_restart +type obsolete_restart + character(len=32) :: field_name !< Name of restart field that is no longer in use + character(len=32) :: replacement_name !< Name of replacement restart field, if applicable +end type obsolete_restart + !> A restart registry and the control structure for restarts type, public :: MOM_restart_CS ; private logical :: restart !< restart is set to .true. if the run has been started from a full restart !! file. Otherwise some fields must be initialized approximately. integer :: novars = 0 !< The number of restart fields that have been registered. + integer :: num_obsolete_vars = 0 !< The number of obsolete restart fields that have been registered. logical :: parallel_restartfiles !< If true, each PE writes its own restart file, !! otherwise they are combined internally. logical :: large_file_support !< If true, NetCDF 3.6 or later is being used @@ -82,6 +89,9 @@ module MOM_restart !> An array of descriptions of the registered fields type(field_restart), pointer :: restart_field(:) => NULL() + !> An array of obsolete restart fields + type(obsolete_restart), pointer :: restart_obsolete(:) => NULL() + !>@{ Pointers to the fields that have been registered for restarts type(p0d), pointer :: var_ptr0d(:) => NULL() type(p1d), pointer :: var_ptr1d(:) => NULL() @@ -112,6 +122,16 @@ module MOM_restart end interface contains +!!> Register a restart field as obsolete +subroutine register_restart_field_as_obsolete(field_name, replacement_name, CS) + character(len=32), intent(in) :: field_name !< Name of restart field that is no longer in use + character(len=32), intent(in) :: replacement_name !< Name of replacement restart field, if applicable + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + + CS%num_obsolete_vars = CS%num_obsolete_vars+1 + CS%restart_obsolete(CS%num_obsolete_vars)%field_name = field_name + CS%restart_obsolete(CS%num_obsolete_vars)%replacement_name = replacement_name +end subroutine register_restart_field_as_obsolete !> Register a 3-d field for restarts, providing the metadata in a structure subroutine register_restart_field_ptr3d(f_ptr, var_desc, mandatory, CS) @@ -1062,6 +1082,16 @@ subroutine restore_state(filename, directory, day, G, CS) allocate(fields(nvar)) call get_file_fields(unit(n),fields(1:nvar)) + do m=1, nvar + call get_file_atts(fields(i),name=varname) + do i=1,CS%num_obsolete_vars + if (lowercase(trim(varname)) == lowercase(trim(CS%restart_obsolete(i)%field_name))) then + call MOM_error(FATAL, "MOM_restart restore_state: Attempting to use obsolete restart field "//& + trim(varname)) + endif + enddo + enddo + missing_fields = 0 do m=1,CS%novars @@ -1433,6 +1463,7 @@ subroutine restart_init(param_file, CS, restart_root) default=.true.) allocate(CS%restart_field(CS%max_fields)) + allocate(CS%restart_obsolete(CS%max_fields)) allocate(CS%var_ptr0d(CS%max_fields)) allocate(CS%var_ptr1d(CS%max_fields)) allocate(CS%var_ptr2d(CS%max_fields)) @@ -1456,6 +1487,7 @@ subroutine restart_end(CS) type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object if (associated(CS%restart_field)) deallocate(CS%restart_field) + if (associated(CS%restart_obsolete)) deallocate(CS%restart_obsolete) if (associated(CS%var_ptr0d)) deallocate(CS%var_ptr0d) if (associated(CS%var_ptr1d)) deallocate(CS%var_ptr1d) if (associated(CS%var_ptr2d)) deallocate(CS%var_ptr2d) From a2988802336ab3dbb0544d234988f2820addc124 Mon Sep 17 00:00:00 2001 From: John Krasting Date: Thu, 11 Apr 2019 11:41:13 -0400 Subject: [PATCH 76/77] Registering Kd_turb and Kv_turb as obsolete restart fields - Uses register_restart_field_as_obsolete subroutine --- src/parameterizations/vertical/MOM_set_viscosity.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 7eba2fbac0..9f452d1402 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -19,6 +19,7 @@ module MOM_set_visc use MOM_cvmix_conv, only : cvmix_conv_is_used use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS +use MOM_restart, only : register_restart_field_as_obsolete use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type @@ -2025,6 +2026,9 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS diag%axesCv1, Time, 'Number of layers in viscous mixed layer at v points', 'm') endif + call register_restart_field_as_obsolete('Kd_turb','Kd_shear', restart_CS) + call register_restart_field_as_obsolete('Kv_turb','Kv_shear', restart_CS) + if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= US%m_to_Z)) then Z_rescale = US%m_to_Z / US%m_to_Z_restart if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then From 2c89df5ab4847668c0eed3b69eb715110b8d8929 Mon Sep 17 00:00:00 2001 From: John Krasting Date: Fri, 12 Apr 2019 10:16:27 -0400 Subject: [PATCH 77/77] dOxygenize for obsolete restarts, tweak to FATAL message - Cosmetic clean up of comments - added adjustl() to string comparison - for some reason a leading whitespace was present with Intel compiler but not GNU. --- src/framework/MOM_restart.F90 | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 9f66871d65..9f1b645604 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -62,8 +62,9 @@ module MOM_restart character(len=32) :: var_name !< A name by which a variable may be queried. end type field_restart +!> A structure to store information about restart fields that are no longer used type obsolete_restart - character(len=32) :: field_name !< Name of restart field that is no longer in use + character(len=32) :: field_name !< Name of restart field that is no longer in use character(len=32) :: replacement_name !< Name of replacement restart field, if applicable end type obsolete_restart @@ -124,9 +125,9 @@ module MOM_restart contains !!> Register a restart field as obsolete subroutine register_restart_field_as_obsolete(field_name, replacement_name, CS) - character(len=32), intent(in) :: field_name !< Name of restart field that is no longer in use - character(len=32), intent(in) :: replacement_name !< Name of replacement restart field, if applicable - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + character(*), intent(in) :: field_name !< Name of restart field that is no longer in use + character(*), intent(in) :: replacement_name !< Name of replacement restart field, if applicable + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) CS%num_obsolete_vars = CS%num_obsolete_vars+1 CS%restart_obsolete(CS%num_obsolete_vars)%field_name = field_name @@ -1083,13 +1084,14 @@ subroutine restore_state(filename, directory, day, G, CS) call get_file_fields(unit(n),fields(1:nvar)) do m=1, nvar - call get_file_atts(fields(i),name=varname) + call get_file_atts(fields(m),name=varname) do i=1,CS%num_obsolete_vars - if (lowercase(trim(varname)) == lowercase(trim(CS%restart_obsolete(i)%field_name))) then + if (adjustl(lowercase(trim(varname))) == adjustl(lowercase(trim(CS%restart_obsolete(i)%field_name)))) then call MOM_error(FATAL, "MOM_restart restore_state: Attempting to use obsolete restart field "//& - trim(varname)) + trim(varname)//" - the new corresponding restart field is "//& + trim(CS%restart_obsolete(i)%replacement_name)) endif - enddo + enddo enddo missing_fields = 0