diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index a90bf338d..b0b01f785 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -19,12 +19,10 @@ jobs: CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: ESMF_8_2_0_beta_snapshot_14 - PNETCDF_VERSION: pnetcdf-1.12.2 + ESMF_VERSION: v8.3.0b13 + PNETCDF_VERSION: pnetcdf-1.12.3 NETCDF_FORTRAN_VERSION: v4.5.2 - # PIO version is awkward - PIO_VERSION_DIR: pio2_5_3 - PIO_VERSION: pio-2.5.3 + PIO_VERSION: pio2_5_7 steps: - uses: actions/checkout@v2 # Build the ESMF library, if the cache contains a previous build @@ -38,12 +36,19 @@ jobs: run: | sudo apt-get update sudo apt-get install gfortran wget openmpi-bin netcdf-bin libopenmpi-dev libnetcdf-dev + - id: checkout-ESMF + uses: actions/checkout@v3 + with: + repository: esmf-org/esmf + path: esmf-src + ref: ${{ env.ESMF_VERSION }} - id: build-ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' run: | - wget https://github.com/esmf-org/esmf/archive/${{ env.ESMF_VERSION }}.tar.gz - tar -xzvf ${{ env.ESMF_VERSION }}.tar.gz - pushd esmf-${{ env.ESMF_VERSION }} + #wget https://github.com/esmf-org/esmf/archive/${{ env.ESMF_VERSION }}.tar.gz + #tar -xzvf ${{ env.ESMF_VERSION }}.tar.gz + #pushd esmf-${{ env.ESMF_VERSION }} + pushd esmf-src export ESMF_DIR=`pwd` export ESMF_COMM=openmpi export ESMF_YAMLCPP="internal" @@ -95,14 +100,18 @@ jobs: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran ${{ runner.os }}-${{ env.PNETCDF_VERSION }}-pnetcdf + - id: checkout-PIO + uses: actions/checkout@v3 + with: + repository: NCAR/ParallelIO + path: parallelio-src + ref: ${{ env.PIO_VERSION }} - name: Build PIO if: steps.cache-PIO.outputs.cache-hit != 'true' run: | - wget https://github.com/NCAR/ParallelIO/releases/download/${{ env.PIO_VERSION_DIR }}/${{ env.PIO_VERSION }}.tar.gz - tar -xzvf ${{ env.PIO_VERSION }}.tar.gz mkdir build-pio pushd build-pio - cmake -Wno-dev -DNetCDF_C_LIBRARY=/usr/lib/x86_64-linux-gnu/libnetcdf.so -DNetCDF_C_INCLUDE_DIR=/usr/include -DCMAKE_PREFIX_PATH=/usr -DCMAKE_INSTALL_PREFIX=$HOME/pio -DPIO_HDF5_LOGGING=On -DPIO_USE_MALLOC=On -DPIO_ENABLE_TESTS=Off -DPIO_ENABLE_LOGGING=On -DPIO_ENABLE_EXAMPLES=Off -DPIO_ENABLE_TIMING=Off -DNetCDF_Fortran_PATH=$HOME/netcdf-fortran -DPnetCDF_PATH=$HOME/pnetcdf ../${{ env.PIO_VERSION }} + cmake -Wno-dev -DNetCDF_C_LIBRARY=/usr/lib/x86_64-linux-gnu/libnetcdf.so -DNetCDF_C_INCLUDE_DIR=/usr/include -DCMAKE_PREFIX_PATH=/usr -DCMAKE_INSTALL_PREFIX=$HOME/pio -DPIO_HDF5_LOGGING=On -DPIO_USE_MALLOC=On -DPIO_ENABLE_TESTS=Off -DPIO_ENABLE_LOGGING=On -DPIO_ENABLE_EXAMPLES=Off -DPIO_ENABLE_TIMING=Off -DNetCDF_Fortran_PATH=$HOME/netcdf-fortran -DPnetCDF_PATH=$HOME/pnetcdf ../parallelio-src make VERBOSE=1 make install popd diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index bd124639f..f788c2478 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -1203,6 +1203,8 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) use netcdf, only : nf90_inq_dimid, nf90_inquire_dimension, nf90_inq_varid, nf90_get_var use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM, ESMF_VMGet, ESMF_SUCCESS + use ESMF , only : ESMF_Mesh, ESMF_MeshCreate, ESMF_FILEFORMAT_ESMFMESH, ESMF_MeshGet, ESMF_MESHLOC_ELEMENT + use ESMF , only : ESMF_Field, ESMF_FieldCreate, ESMF_FieldGet, ESMF_FieldRegridGetArea, ESMF_TYPEKIND_r8 ! input/output variables character(len=*) , intent(in) :: compname @@ -1212,6 +1214,7 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) ! local variables type(ESMF_VM) :: vm character(len=CL) :: single_column_lnd_domainfile + character(len=CL) :: single_column_global_meshfile real(r8) :: scol_lon real(r8) :: scol_lat real(r8) :: scol_area @@ -1219,7 +1222,16 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) real(r8) :: scol_lndfrac integer :: scol_ocnmask real(r8) :: scol_ocnfrac - integer :: i,j,ni,nj + integer :: scol_mesh_n + type(ESMF_Mesh) :: mesh + type(ESMF_Field) :: lfield + integer :: lsize + integer :: spatialdim + real(r8), pointer :: ownedElemCoords(:) + real(r8), pointer :: latMesh(:) + real(r8), pointer :: lonMesh(:) + real(r8), pointer :: dataptr(:) + integer :: i,j,ni,nj,n integer :: ncid integer :: dimid integer :: varid_xc @@ -1243,7 +1255,6 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) character(len=*), parameter :: subname= ' (esm_get_single_column_attributes) ' !------------------------------------------------------------------------------- - rc = ESMF_SUCCESS ! obtain the single column lon and lat @@ -1255,6 +1266,8 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) read(cvalue,*) scol_lat call NUOPC_CompAttributeGet(gcomp, name='single_column_lnd_domainfile', value=single_column_lnd_domainfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=single_column_global_meshfile, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeAdd(gcomp, attrList=(/'scol_spval'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1349,6 +1362,7 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) do j = 1,nj lats(j) = glob_grid(1,j) end do + ! find nearest neighbor indices of scol_lon and scol_lat in single_column_lnd_domain file ! convert lons array and scol_lon to 0,360 and find index of value closest to 0 ! and obtain single-column longitude/latitude indices to retrieve @@ -1388,26 +1402,53 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) //' ocean and land mask cannot both be zero') end if + status = nf90_close(ncid) + if (status /= nf90_noerr) call shr_sys_abort (trim(subname) //': closing '//& + trim(single_column_lnd_domainfile)) + + ! Now read in mesh file to get exact values of scol_lon and scol_lat that will be used + ! by the models - assume that this occurs only on 1 processor + mesh = ESMF_MeshCreate(filename=trim(single_column_global_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=lsize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(ownedElemCoords(spatialDim*lsize)) + allocate(lonMesh(lsize), latMesh(lsize)) + call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize + lonMesh(n) = ownedElemCoords(2*n-1) + latMesh(n) = ownedElemCoords(2*n) + if (abs(lonMesh(n) - scol_lon) < 1.e-4 .and. abs(latMesh(n) - scol_lat) < 1.e-4) then + scol_mesh_n = n + scol_mesh_n = n + exit + end if + end do + scol_lon = lonMesh(scol_mesh_n) + scol_lat = latMesh(scol_mesh_n) + + ! Obtain mesh info areas + lfield = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_r8, name='area', meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridGetArea(lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + scol_area = dataptr(scol_mesh_n) + + ! Set single column attribute values for all components write(cvalue,*) scol_lon call NUOPC_CompAttributeSet(gcomp, name='scol_lon', value=trim(cvalue), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(cvalue,*) scol_lat call NUOPC_CompAttributeSet(gcomp, name='scol_lat', value=trim(cvalue), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - write(cvalue,*) ni - call NUOPC_CompAttributeSet(gcomp, name='scol_ni', value=trim(cvalue), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - write(cvalue,*) nj - call NUOPC_CompAttributeSet(gcomp, name='scol_nj', value=trim(cvalue), rc=rc) + write(cvalue,*) scol_area + call NUOPC_CompAttributeSet(gcomp, name='scol_area', value=trim(cvalue), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - status = nf90_close(ncid) - if (status /= nf90_noerr) call shr_sys_abort (trim(subname) //': closing '//& - trim(single_column_lnd_domainfile)) - + ! Write out diagnostic info write(logunit,'(a,2(f13.5,2x))')trim(subname)//' nearest neighbor scol_lon and scol_lat in '& //trim(single_column_lnd_domainfile)//' are ',scol_lon,scol_lat if (trim(compname) == 'LND') then @@ -1419,6 +1460,12 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) else write(logunit,'(a)')trim(subname)//' atm point has unit mask and unit fraction ' end if + write(cvalue,*) ni + call NUOPC_CompAttributeSet(gcomp, name='scol_ni', value=trim(cvalue), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(cvalue,*) nj + call NUOPC_CompAttributeSet(gcomp, name='scol_nj', value=trim(cvalue), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else @@ -1431,12 +1478,11 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) scol_ocnfrac = 1._r8 scol_area = 1.e30 + write(cvalue,*) 1 call NUOPC_CompAttributeSet(gcomp, name='scol_ni', value=trim(cvalue), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(cvalue,*) 1 call NUOPC_CompAttributeSet(gcomp, name='scol_nj', value=trim(cvalue), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(cvalue,*) 1 write(logunit,'(a)')' single point mode is active' write(logunit,'(a,f13.5,a,f13.5,a)')' scol_lon is ',scol_lon,' and scol_lat is ' diff --git a/cime_config/buildnml b/cime_config/buildnml index 4cdcb7aac..23354c522 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -62,11 +62,15 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config['lnd_grid'] = lnd_grid config['ice_grid'] = ice_grid config['ocn_grid'] = ocn_grid - config['samegrid_atm_lnd'] = 'true' if atm_grid == lnd_grid else 'false' - config['samegrid_atm_ice'] = 'true' if atm_grid == ice_grid else 'false' - config['samegrid_atm_ocn'] = 'true' if atm_grid == ocn_grid else 'false' - config['samegrid_atm_wav'] = 'true' if atm_grid == wav_grid else 'false' - config['samegrid_lnd_rof'] = 'true' if lnd_grid == rof_grid else 'false' + + atm_mesh = case.get_value("ATM_DOMAIN_MESH") + lnd_mesh = case.get_value("LND_DOMAIN_MESH") + rof_mesh = case.get_value("ROF_DOMAIN_MESH") + config['samegrid_atm_lnd'] = 'true' if atm_mesh == case.get_value("LND_DOMAIN_MESH") else 'false' + config['samegrid_atm_ocn'] = 'true' if atm_mesh == case.get_value("OCN_DOMAIN_MESH") else 'false' + config['samegrid_atm_ice'] = 'true' if atm_mesh == case.get_value("ICE_DOMAIN_MESH") else 'false' + config['samegrid_atm_wav'] = 'true' if atm_mesh == case.get_value("WAV_DOMAIN_MESH") else 'false' + config['samegrid_lnd_rof'] = 'true' if lnd_mesh == rof_mesh else 'false' # determine if need to set atm_domainfile scol_lon = float(case.get_value('PTS_LON')) @@ -102,6 +106,12 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): #---------------------------------------------------- nmlgen.init_defaults(infile, config, skip_default_for_groups=["modelio"]) + #-------------------------------- + # Overwrite: wav-ice coupling (assumes cice6 as the ice component + #-------------------------------- + if (case.get_value("COMP_WAV") == 'ww3dev' and case.get_value("COMP_ICE") == 'cice'): + nmlgen.set_value('wavice_coupling', value='.true.') + #-------------------------------- # Overwrite: set brnch_retain_casename #-------------------------------- @@ -307,7 +317,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): model = model.lower() config = {} config['component'] = model - nmlgen.init_defaults(infile, config, skip_entry_loop=True) + nmlgen.init_defaults([], config, skip_entry_loop=True) if model == 'cpl': newgroup = "MED_modelio" else: @@ -340,16 +350,14 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): nmlgen.set_value("diro", case.get_value('RUNDIR')) if model == 'cpl': logfile = 'med' + inst_string + ".log." + str(lid) + elif model == 'drv': + logfile = model + ".log." + str(lid) else: logfile = model + inst_string + ".log." + str(lid) nmlgen.set_value("logfile", logfile) inst_index = inst_index + 1 nmlgen.write_nuopc_config_file(conffile) - - - - #-------------------------------- # Update nuopc.runconfig file if component needs it #-------------------------------- diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 611c36619..a535a0fa6 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1992,7 +1992,7 @@ MED_attributes atm to ocn mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2002,7 +2002,7 @@ MED_attributes atm to ocn mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2012,7 +2012,7 @@ MED_attributes atm to lnd mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2022,7 +2022,7 @@ MED_attributes ocn to atm mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2032,7 +2032,7 @@ MED_attributes ice to atm mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2042,7 +2042,7 @@ MED_attributes lnd to atm mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2053,7 +2053,7 @@ MED_attributes lnd to rof mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2064,7 +2064,7 @@ MED_attributes rof to lnd mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -2074,7 +2074,7 @@ MED_attributes atm to wav mapping, 'unset' or 'idmap' are normal possible values - unset + unset idmap @@ -3789,6 +3789,18 @@ + + logical + expdef + ALLCOMP_attributes + + If true, wav-ice coupling is active + + + .false. + + + @@ -3806,13 +3818,12 @@ char mapping abs - ATM_attributes + ALLCOMP_attributes MESH description of atm grid $ATM_DOMAIN_MESH - null @@ -3866,13 +3877,12 @@ char mapping abs - ICE_attributes + ALLCOMP_attributes MESH description of ice grid $ICE_DOMAIN_MESH - null @@ -3899,7 +3909,6 @@ $GLC_DOMAIN_MESH - null @@ -3920,13 +3929,12 @@ char mapping abs - LND_attributes + ALLCOMP_attributes MESH description of lnd grid $LND_DOMAIN_MESH - null @@ -3947,13 +3955,12 @@ char mapping abs - OCN_attributes + ALLCOMP_attributes MESH description of ocn grid $OCN_DOMAIN_MESH - null @@ -3980,7 +3987,6 @@ $ROF_DOMAIN_MESH - null @@ -4007,7 +4013,6 @@ $WAV_DOMAIN_MESH - null diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 4ee15aba1..9bf8062eb 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -93,11 +93,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) integer :: n, ns character(len=CL) :: cvalue character(len=CS) :: name + logical :: wavice_coupling + logical :: ocn2glc_coupling character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' !-------------------------------------- rc = ESMF_SUCCESS + call NUOPC_CompAttributeGet(gcomp, name='wavice_coupling', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) wavice_coupling + + call NUOPC_CompAttributeGet(gcomp, name='ocn2glc_coupling', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ocn2glc_coupling + !--------------------------------------- ! Get the internal state !--------------------------------------- @@ -2790,6 +2800,23 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to ice: wave elevation spectrum (field with ungridded dimensions) + ! --------------------------------------------------------------------- + if (wavice_coupling) then + if (phase == 'advertise') then + call addfld(fldListFr(compwav)%flds, 'Sw_elevation_spectrum') + call addfld(fldListTo(compice)%flds, 'Sw_elevation_spectrum') + else + if ( fldchk(is_local%wrap%FBExp(compice) , 'Sw_elevation_spectrum', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_elevation_spectrum', rc=rc)) then + call addmap(fldListFr(compwav)%flds, 'Sw_elevation_spectrum', compice, mapbilnr, 'one', 'unset') + call addmrg(fldListTo(compice)%flds, 'Sw_elevation_spectrum', & + mrg_from=compwav, mrg_fld='Sw_elevation_spectrum', mrg_type='copy') + end if + end if + end if + !===================================================================== ! FIELDS TO WAVE (compwav) !===================================================================== @@ -2808,7 +2835,36 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if end if - + !---------------------------------------------------------- + ! to wav: ice thickness from ice + !---------------------------------------------------------- + if (wavice_coupling) then + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Si_thick') + call addfld(fldListTo(compwav)%flds, 'Si_thick') + else + if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_thick', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_thick', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_thick', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrg(fldListTo(compwav)%flds, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') + end if + end if + end if + !---------------------------------------------------------- + ! to wav: ice floe diameter from ice + !---------------------------------------------------------- + if (wavice_coupling) then + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Si_floediam') + call addfld(fldListTo(compwav)%flds, 'Si_floediam') + else + if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_floediam', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_floediam', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_floediam', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrg(fldListTo(compwav)%flds, 'Si_floediam', mrg_from=compice, mrg_fld='Si_floediam', mrg_type='copy') + end if + end if + end if ! --------------------------------------------------------------------- ! to wav: ocean surface temperature from ocn ! --------------------------------------------------------------------- @@ -2823,7 +2879,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg(fldListTo(compwav)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') end if end if - ! --------------------------------------------------------------------- ! to wav: ocean currents from ocn ! --------------------------------------------------------------------- diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 436232652..9fe5b70ba 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -37,6 +37,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use esmFlds , only : addmap => med_fldList_AddMap use esmFlds , only : addmrg => med_fldList_AddMrg use esmflds , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb + use med_internalstate_mod , only : InternalState, mastertask, logunit ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -132,6 +133,39 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) deallocate(flds) end if + if (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs') then + allocate(flds(12)) + flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot ', 'Sa_pbot ', & + 'Sa_pslv ', 'Sa_shum ', 'Sa_ptem ', 'Sa_dens ', 'Sa_u10m ', & + 'Sa_v10m ', 'Faxa_lwdn'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) )then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset') + end if + end if + end do + deallocate(flds) + + ! fields returned by the atm/ocn flux computation which are otherwise unadvertised + allocate(flds(13)) + flds = (/'So_tref ', 'So_qref ','So_u10 ', 'So_ustar ','So_ssq ', & + 'So_re ', 'So_duu10n','Faox_lwup', 'Faox_sen ','Faox_lat ', & + 'Faox_evap', 'Faox_taux','Faox_tauy'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds, trim(fldname)) + end if + end do + deallocate(flds) + end if + ! TODO: unused, but required to maintain B4B repro for mediator restarts; should be removed if (phase == 'advertise') then call addfld(fldListFr(compice)%flds, 'mean_sw_pen_to_ocn') @@ -215,6 +249,35 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end if end if + ! to atm: unmerged from mediator, merge will be done under FV3/CCPP composite step + ! - zonal surface stress, meridional surface stress + ! - surface latent heat flux, + ! - surface sensible heat flux + ! - surface upward longwave heat flux + ! - evaporation water flux from water, not in the list do we need to send it to atm? + if (trim(coupling_mode) == 'nems_frac_aoflux') then + if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then + allocate(flds(5)) + flds = (/ 'lat ', 'sen ', 'lwup', 'taux', 'tauy' /) + if (phase == 'advertise') then + do n = 1,size(flds) + call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(flds(n))) + call addfld(fldListTo(compatm)%flds, 'Faox_'//trim(flds(n))) + end do + else + do n = 1,size(flds) + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_'//trim(flds(n)), rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap(fldListMed_aoflux%flds, 'Faox_'//trim(flds(n)), compatm, maptype, 'ofrac', 'unset') + end if + call addmrg(fldListTo(compatm)%flds, 'Faox_'//trim(flds(n)), mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='copy') + end if + end do + end if + deallocate(flds) + end if + end if + ! to atm: surface roughness length from wav if (phase == 'advertise') then if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compatm)) then @@ -310,7 +373,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then + if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then ! to ocn: merge surface stress (custom merge calculation in med_phases_prep_ocn) allocate(oflds(2)) allocate(aflds(2)) @@ -379,7 +443,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf_aofrac, 'aofrac', 'unset') end if end if - else + else if (trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then ! nems_orig_data ! to ocn: surface stress from mediator and ice stress via auto merge allocate(flds(2)) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 9196090d8..648a4fed2 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -740,6 +740,14 @@ canonical_units: m description: sea-ice export - volume of snow per unit area # + - standard_name: Si_thick + canonical_units: m + description: sea-ice export - ice thickness + # + - standard_name: Si_floediam + canonical_units: m + description: sea-ice export - ice floe diameter + # #----------------------------------- # section: ocean export to mediator #----------------------------------- @@ -1157,6 +1165,13 @@ - standard_name: Sw_pstokes_y canonical_units: m/s description: Northward partitioned stokes drift components + + # + - standard_name: Sw_elevation_spectrum + alias: wave_elevation_spectrum + canonical_units: m2/s + description: wave elevation spectrum + #----------------------------------- # mediator fields #----------------------------------- diff --git a/mediator/med.F90 b/mediator/med.F90 index 92be267e1..ac92f2638 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -43,7 +43,7 @@ module MED use med_internalstate_mod , only : med_internalstate_defaultmasks, logunit, mastertask use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc - use med_internalstate_mod , only : coupling_mode + use med_internalstate_mod , only : coupling_mode, aoflux_code, aoflux_ccpp_suite use esmFlds , only : fldListMed_ocnalb use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, med_fldList_GetFldInfo use esmFlds , only : med_fldList_Document_Mapping, med_fldList_Document_Merging @@ -762,6 +762,36 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) end if is_local%wrap%aoflux_grid = trim(cvalue) + ! Determine aoflux scheme that will be used to compute atmosphere-ocean fluxes [cesm|ccpp] + ! TODO: If ccpp is not available it will be always run in cesm mode independent from aoflux_code option + call NUOPC_CompAttributeGet(gcomp, name='aoflux_code', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (.not. isPresent .and. .not. isSet) then + cvalue = 'cesm' + end if + aoflux_code = trim(cvalue) + if (mastertask) then + write(logunit,*) '========================================================' + write(logunit,'(a)')trim(subname)//' Mediator aoflux scheme is '//trim(aoflux_code) + write(logunit,*) '========================================================' + end if + + ! Determine CCPP suite if aoflux scheme set to 'ccpp' + if (trim(aoflux_code) == 'ccpp') then + call NUOPC_CompAttributeGet(gcomp, name='aoflux_ccpp_suite', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (.not. isPresent .and. .not. isSet) then + call ESMF_LogWrite("aoflux_ccpp_suite need to be provided when aoflux_code is set to 'ccpp'", ESMF_LOGMSG_INFO) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + aoflux_ccpp_suite = trim(cvalue) + if (mastertask) then + write(logunit,*) '========================================================' + write(logunit,'(a)')trim(subname)//' Mediator aoflux CCPP suite is '//trim(aoflux_ccpp_suite) + write(logunit,*) '========================================================' + end if + end if + !------------------ ! Initialize mediator flds !------------------ diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 5b7944c7d..521ba0007 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -367,7 +367,10 @@ subroutine med_fraction_init(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set 'aofrac' in FBfrac(compatm) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then + if (trim(coupling_mode) == 'nems_orig' .or. & + trim(coupling_mode) == 'nems_frac' .or. & + trim(coupling_mode) == 'nems_frac_aoflux' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', Sa_ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBFrac(compatm), 'aofrac', aofrac, rc) @@ -789,7 +792,10 @@ subroutine med_fraction_set(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Set 'aofrac' from FBImp(compatm) to FBfrac(compatm) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then + if (trim(coupling_mode) == 'nems_orig' .or. & + trim(coupling_mode) == 'nems_frac' .or. & + trim(coupling_mode) == 'nems_frac_aoflux' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', Sa_ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBFrac(compatm), 'aofrac', aofrac, rc) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index b9b61e85e..99baa2fe1 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -5,7 +5,7 @@ module med_internalstate_mod !----------------------------------------------------------------------------- use ESMF , only : ESMF_RouteHandle, ESMF_FieldBundle, ESMF_State, ESMF_Field, ESMF_VM - use ESMF , only : ESMF_GridComp, ESMF_MAXSTR, ESMF_LOGMSG_INFO, ESMF_LOGWRITE + use ESMF , only : ESMF_GridComp, ESMF_Mesh, ESMF_MAXSTR, ESMF_LOGMSG_INFO, ESMF_LOGWRITE use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_utils_mod, only : chkerr => med_utils_ChkErr @@ -47,7 +47,13 @@ module med_internalstate_mod character(len=CS), public :: glc_name = '' ! Coupling mode - character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data,hafs] + character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data,hafs,nems_frac_aoflux,nems_frac_aoflux_sbs] + + ! Atmosphere-ocean flux algorithm + character(len=CS), public :: aoflux_code ! valid values are [cesm,ccpp] + + ! Atmosphere-ocean CCPP suite name + character(len=CL), public :: aoflux_ccpp_suite ! Default src and destination masks for mapping integer, public, allocatable :: defaultMasks(:,:) @@ -153,6 +159,7 @@ module med_internalstate_mod ! Mediator field bundles and other info for atm/ocn flux computation character(len=CS) :: aoflux_grid ! 'ogrid', 'agrid' or 'xgrid' + type(ESMF_Mesh) :: aoflux_mesh ! Mesh used for atm/ocn flux computation type(ESMF_FieldBundle) :: FBMed_aoflux_a ! Ocn/Atm flux output fields on atm grid type(ESMF_FieldBundle) :: FBMed_aoflux_o ! Ocn/Atm flux output fields on ocn grid type(packed_data_type), pointer :: packed_data_aoflux_o2a(:) ! packed data for mapping ocn->atm diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 1a1541475..6d9b8d2f6 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -1111,12 +1111,14 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) end if end do - else if (rank == 1) then + else if (rank == 1 .or. rank == 0) then name1 = trim(lpre)//'_'//trim(itemc) rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) call pio_setframe(io_file(lfile_ind),varid,frame) + ! fix for writing data on exchange grid, which has no data in some PETs + if (rank == 0) nullify(fldptr1) call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr1, rcode, fillval=lfillvalue) - end if ! end if rank is 2 or 1 + end if ! end if rank is 2 or 1 or 0 end if ! end if not "hgt" end do ! end loop over fields in FB diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 794b84293..582a622a4 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -11,25 +11,34 @@ module med_phases_aofluxes_mod ! map aoflux_out from xgrid to both atm and ocn grid ! -------------------------------------------------------------------------- - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : operator(/=) + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_CoordSys_Flag use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldIsCreated, ESMF_FieldDestroy - use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldRegridGetArea use ESMF , only : ESMF_FieldBundleCreate, ESMF_FieldBundleAdd use ESMF , only : ESMF_RouteHandle, ESMF_FieldRegrid, ESMF_FieldRegridStore use ESMF , only : ESMF_REGRIDMETHOD_CONSERVE_2ND, ESMF_REGRIDMETHOD_CONSERVE - use ESMF , only : ESMF_REGRIDMETHOD_PATCH, ESMF_REGRIDMETHOD_BILINEAR + use ESMF , only : ESMF_REGRIDMETHOD_PATCH, ESMF_REGRIDMETHOD_BILINEAR, ESMF_COORDSYS_CART use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_REGION_TOTAL, ESMF_MESHLOC_ELEMENT, ESMF_MAXSTR use ESMF , only : ESMF_XGRIDSIDE_B, ESMF_XGRIDSIDE_A, ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU use ESMF , only : ESMF_Mesh, ESMF_MeshGet, ESMF_XGrid, ESMF_XGridCreate, ESMF_TYPEKIND_R8 use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LOGMSG_ERROR, ESMF_FAILURE use ESMF , only : ESMF_Finalize, ESMF_LogFoundError + use ESMF , only : ESMF_XGridGet, ESMF_MeshCreate, ESMF_MeshWrite, ESMF_KIND_R8 use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod , only : InternalState, mastertask, logunit - use med_internalstate_mod , only : compatm, compocn, coupling_mode, mapconsd, mapconsf, mapfcopy + use med_internalstate_mod , only : compatm, compocn, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_chkerr use perf_mod , only : t_startf, t_stopf +#ifndef CESMCOUPLED + use ufs_const_mod , only : rearth => SHR_CONST_REARTH + use ufs_const_mod , only : pi => SHR_CONST_PI +#else + use shr_const_mod , only : rearth => SHR_CONST_REARTH + use shr_const_mod , only : pi => SHR_CONST_PI +#endif implicit none private @@ -105,18 +114,23 @@ module med_phases_aofluxes_mod real(R8) , pointer :: zbot (:) => null() ! atm level height real(R8) , pointer :: ubot (:) => null() ! atm velocity, zonal real(R8) , pointer :: vbot (:) => null() ! atm velocity, meridional + real(R8) , pointer :: usfc (:) => null() ! atm surface velocity, zonal + real(R8) , pointer :: vsfc (:) => null() ! atm surface velocity, meridional real(R8) , pointer :: thbot (:) => null() ! atm potential T real(R8) , pointer :: shum (:) => null() ! atm specific humidity real(R8) , pointer :: pbot (:) => null() ! atm bottom pressure + real(R8) , pointer :: psfc (:) => null() ! atm surface pressure real(R8) , pointer :: dens (:) => null() ! atm bottom density real(R8) , pointer :: tbot (:) => null() ! atm bottom surface T real(R8) , pointer :: shum_16O (:) => null() ! atm H2O tracer real(R8) , pointer :: shum_HDO (:) => null() ! atm HDO tracer real(R8) , pointer :: shum_18O (:) => null() ! atm H218O tracer - ! local size and computational mask: on aoflux grid + real(R8) , pointer :: lwdn (:) => null() ! atm downward longwave heat flux + ! local size and computational mask and area: on aoflux grid integer :: lsize ! local size integer , pointer :: mask (:) => null() ! integer ocn domain mask: 0 <=> inactive cell real(R8) , pointer :: rmask (:) => null() ! real ocn domain mask: 0 <=> inactive cell + real(R8) , pointer :: garea (:) => null() ! atm grid area end type aoflux_in_type type aoflux_out_type @@ -284,6 +298,7 @@ subroutine med_phases_aofluxes_run(gcomp, rc) else aoflux_created = .false. end if + ! Now set first_call to .false. first_call = .false. end if @@ -480,6 +495,10 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) character(len=CX) :: tmpstr integer :: lsize integer :: fieldcount + type(ESMF_Field) :: lfield + type(ESMF_Mesh) :: lmesh + real(R8), pointer :: garea(:) => null() + type(ESMF_CoordSys_Flag) :: coordSys character(len=*),parameter :: subname=' (med_aofluxes_init_ocngrid) ' !----------------------------------------------------------------------- @@ -515,6 +534,27 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) write(tmpstr,'(i12,g22.12,i12)') lsize,sum(aoflux_in%rmask),sum(aoflux_in%mask) call ESMF_LogWrite(trim(subname)//" : maskB= "//trim(tmpstr), ESMF_LOGMSG_INFO) + ! ------------------------ + ! setup grid area + ! ------------------------ + + call ESMF_FieldBundleGet(is_local%wrap%FBArea(compocn), 'area', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(aoflux_in%garea(lsize)) + call ESMF_FieldGet(lfield, farrayPtr=garea, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%aoflux_mesh = ESMF_MeshCreate(lmesh, rc=rc) + call ESMF_MeshGet(lmesh, coordSys=coordSys, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (coordSys /= ESMF_COORDSYS_CART) then + ! Convert square radians to square meters + aoflux_in%garea(:) = garea(:)*(rearth**2) + else + aoflux_in%garea(:) = garea(:) + end if + ! ------------------------ ! create packed mapping from ocn->atm if aoflux_grid is ocn ! ------------------------ @@ -565,6 +605,10 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: mesh_src type(ESMF_Mesh) :: mesh_dst integer :: maptype + type(ESMF_Field) :: lfield + type(ESMF_Mesh) :: lmesh + real(R8), pointer :: garea(:) => null() + type(ESMF_CoordSys_Flag) :: coordSys character(len=*),parameter :: subname=' (med_aofluxes_init_atmgrid) ' !----------------------------------------------------------------------- @@ -641,6 +685,27 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) end if enddo + ! ------------------------ + ! setup grid area + ! ------------------------ + + call ESMF_FieldBundleGet(is_local%wrap%FBArea(compatm), 'area', field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(aoflux_in%garea(lsize)) + call ESMF_FieldGet(lfield, farrayPtr=garea, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%aoflux_mesh = ESMF_MeshCreate(lmesh, rc=rc) + call ESMF_MeshGet(lmesh, coordSys=coordSys, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (coordSys /= ESMF_COORDSYS_CART) then + ! Convert square radians to square meters + aoflux_in%garea(:) = garea(:)*(rearth**2) + else + aoflux_in%garea(:) = garea(:) + end if + ! ------------------------ ! set one normalization for ocn-atm mapping if needed ! ------------------------ @@ -695,11 +760,14 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Field) :: field_a type(ESMF_Field) :: field_o type(ESMF_Field) :: lfield - integer :: elementCount + type(ESMF_Mesh) :: lmesh type(ESMF_Mesh) :: ocn_mesh type(ESMF_Mesh) :: atm_mesh + type(ESMF_Mesh) :: xch_mesh real(r8), pointer :: dataptr(:) integer :: fieldcount + type(ESMF_CoordSys_Flag) :: coordSys + real(ESMF_KIND_R8) ,allocatable :: garea(:) character(ESMF_MAXSTR),allocatable :: fieldNameList(:) character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' !----------------------------------------------------------------------- @@ -732,6 +800,17 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) storeOverlay=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! write meshes for debug purpose + if (dbug_flag > 20) then + call ESMF_MeshWrite(atm_mesh, filename="atm_mesh", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshWrite(ocn_mesh, filename="ocn_mesh", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_XGridGet(xgrid, mesh=xch_mesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshWrite(xch_mesh, filename="xch_mesh", rc=rc) + end if + ! create module field on exchange grid and set its initial value to 1 field_x = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -789,12 +868,14 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid_2ndord, & regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_bilinr, & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_patch, & - regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (trim(coupling_mode) == 'cesm') then + call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_bilinr, & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_patch, & + regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if ! create xgrid->zgrid route handle call ESMF_FieldRegridStore(xgrid, field_x, field_a, routehandle=rh_xgrid2agrid, rc=rc) @@ -832,6 +913,23 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) allocate(aoflux_in%mask(lsize)) aoflux_in%mask(:) = 1 + ! ------------------------ + ! setup grid area + ! ------------------------ + + allocate(garea(lsize)) + allocate(aoflux_in%garea(lsize)) + call ESMF_XGridGet(xgrid, mesh=lmesh, coordSys=coordSys, area=garea, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%aoflux_mesh = ESMF_MeshCreate(lmesh, rc=rc) + if (coordSys /= ESMF_COORDSYS_CART) then + ! Convert square radians to square meters + aoflux_in%garea(:) = garea(:)*(rearth**2) + else + aoflux_in%garea(:) = garea(:) + end if + deallocate(garea) + end subroutine med_aofluxes_init_xgrid !=============================================================================== @@ -854,6 +952,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) #else use flux_atmocn_mod, only : flux_atmocn #endif +#ifdef UFS_AOFLUX + use flux_atmocn_ccpp_mod, only : flux_atmocn_ccpp +#endif ! Arguments type(ESMF_GridComp) :: gcomp @@ -862,13 +963,18 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) integer , intent(out) :: rc ! ! Local variables - type(InternalState) :: is_local - type(ESMF_Field) :: field_src - type(ESMF_Field) :: field_dst - integer :: n,i,nf ! indices - real(r8), pointer :: data_normdst(:) - real(r8), pointer :: data_dst(:) - character(*),parameter :: subName = '(med_aofluxes_update) ' + type(InternalState) :: is_local + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst + integer :: n,i,nf ! indices + real(r8), pointer :: data_normdst(:) + real(r8), pointer :: data_dst(:) + integer :: maptype + real(r8), parameter :: qmin = 1.0e-8_r8 + real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa + real(r8), parameter :: rcp = 0.286_r8 ! gas constant of air / specific heat capacity at a constant pressure + real(r8), parameter :: rdair = 287.058_r8 ! dry air gas constant in J/K/kg + character(*),parameter :: subName = '(med_aofluxes_update) ' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -908,15 +1014,29 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) ! Note pbot, tbot and shum have already been mapped or are available on the aoflux grid if (compute_atm_thbot) then do n = 1,aoflux_in%lsize - if (aoflux_in%mask(n) /= 0._r8) then - aoflux_in%thbot(n) = aoflux_in%tbot(n)*((100000._R8/aoflux_in%pbot(n))**0.286_R8) + if (aoflux_in%mask(n) /= 0.0_r8) then + aoflux_in%thbot(n) = aoflux_in%tbot(n)*((p0/aoflux_in%pbot(n))**rcp) end if end do end if if (compute_atm_dens) then + if (trim(aoflux_code) == 'ccpp' .and. & + (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs')) then + ! Add limiting factor to humidity to be consistent with UFS aoflux calculation + do n = 1,aoflux_in%lsize + if (aoflux_in%mask(n) /= 0.0_r8) then + aoflux_in%shum(n) = max(aoflux_in%shum(n), qmin) + end if + end do + ! Use pbot as psfc for the initial pass since psfc provided by UFS atm is zero + if (maxval(aoflux_in%psfc, mask=(aoflux_in%mask/= 0.0_r8)) < 100.0_r8) then + aoflux_in%psfc(:) = aoflux_in%pbot(:) + call ESMF_LogWrite(trim(subname)//" : using pbot as psfc for initial pass!", ESMF_LOGMSG_INFO) + end if + end if do n = 1,aoflux_in%lsize - if (aoflux_in%mask(n) /= 0._r8) then - aoflux_in%dens(n) = aoflux_in%pbot(n)/(287.058_R8*(1._R8 + 0.608_R8*aoflux_in%shum(n))*aoflux_in%tbot(n)) + if (aoflux_in%mask(n) /= 0.0_r8) then + aoflux_in%dens(n) = aoflux_in%pbot(n)/(rdair*(1.0_r8 + 0.608_r8*aoflux_in%shum(n))*aoflux_in%tbot(n)) end if end do end if @@ -926,7 +1046,6 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) !---------------------------------- #ifdef CESMCOUPLED - call flux_atmocn (logunit=logunit, & nMax=aoflux_in%lsize, & zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & @@ -942,15 +1061,30 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) missval=0.0_r8) #else - - call flux_atmocn (logunit=logunit, & - nMax=aoflux_in%lsize, mask=aoflux_in%mask, & - zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & - rbot=aoflux_in%dens, tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, ts=aoflux_in%tocn, & - ocn_surface_flux_scheme=ocn_surface_flux_scheme, & - sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evap=aoflux_out%evap, & - taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & - duu10n=aoflux_out%duu10n, missval=0.0_r8) +#ifdef UFS_AOFLUX + if (trim(aoflux_code) == 'ccpp') then + call flux_atmocn_ccpp(gcomp=gcomp, mastertask=mastertask, logunit=logunit, & + nMax=aoflux_in%lsize, psfc=aoflux_in%psfc, & + pbot=aoflux_in%pbot, tbot=aoflux_in%tbot, qbot=aoflux_in%shum, lwdn=aoflux_in%lwdn, & + zbot=aoflux_in%zbot, garea=aoflux_in%garea, ubot=aoflux_in%ubot, usfc=aoflux_in%usfc, vbot=aoflux_in%vbot, & + vsfc=aoflux_in%vsfc, rbot=aoflux_in%dens, ts=aoflux_in%tocn, mask=aoflux_in%mask, & + sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evp=aoflux_out%evap, & + taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & + duu10n=aoflux_out%duu10n, ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & + missval=0.0_r8) + else +#endif + call flux_atmocn (logunit=logunit, & + nMax=aoflux_in%lsize, mask=aoflux_in%mask, & + zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & + rbot=aoflux_in%dens, tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, ts=aoflux_in%tocn, & + ocn_surface_flux_scheme=ocn_surface_flux_scheme, & + sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evap=aoflux_out%evap, & + taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & + duu10n=aoflux_out%duu10n, missval=0.0_r8) +#ifdef UFS_AOFLUX + end if +#endif #endif @@ -1008,7 +1142,7 @@ subroutine med_aofluxes_map_ogrid2agrid_input(gcomp, rc) real(r8), pointer :: data_dst(:) integer :: nf,n integer :: maptype - character(*),parameter :: subName = '(med_aofluxes_map_ogrid2agrid_output) ' + character(*),parameter :: subName = '(med_aofluxes_map_ogrid2agrid_input) ' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1043,6 +1177,7 @@ subroutine med_aofluxes_map_ogrid2agrid_input(gcomp, rc) ! Map ocn->atm conservatively without fractions call ESMF_FieldRegrid(field_src, field_dst, routehandle=is_local%wrap%RH(compocn,compatm, maptype), & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Normalization of map by 'one' if (maptype /= mapfcopy) then @@ -1076,7 +1211,7 @@ subroutine med_aofluxes_map_agrid2xgrid_input(gcomp, rc) type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst integer :: nf - character(*),parameter :: subName = '(med_aofluxes_map_ogrid2agrid_output) ' + character(*),parameter :: subName = '(med_aofluxes_map_agrid2xgrid_input) ' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1096,11 +1231,23 @@ subroutine med_aofluxes_map_agrid2xgrid_input(gcomp, rc) ! Map atm->xgrid if (trim(fldnames_atm_in(nf)) == 'Sa_u' .or. (trim(fldnames_atm_in(nf)) == 'Sa_v')) then - call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_agrid2xgrid_patch, & - termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (trim(coupling_mode) == 'cesm') then + call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_agrid2xgrid_patch, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + else + call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_agrid2xgrid_2ndord, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + end if + if (chkerr(rc,__LINE__,u_FILE_u)) return else - call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_agrid2xgrid_bilinr, & - termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (trim(coupling_mode) == 'cesm') then + call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_agrid2xgrid_bilinr, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + else + call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_agrid2xgrid, & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + end if + if (chkerr(rc,__LINE__,u_FILE_u)) return end if if (chkerr(rc,__LINE__,u_FILE_u)) return end do @@ -1121,7 +1268,7 @@ subroutine med_aofluxes_map_ogrid2xgrid_input(gcomp, rc) type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst integer :: nf - character(*),parameter :: subName = '(med_aofluxes_map_ogrid2agrid_output) ' + character(*),parameter :: subName = '(med_aofluxes_map_ogrid2xgrid_input) ' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1402,6 +1549,16 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! extra fields for nems_frac_aoflux + if (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs') then + call fldbun_getfldptr(fldbun_a, 'Sa_u10m', aoflux_in%usfc, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_a, 'Sa_v10m', aoflux_in%vsfc, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun_a, 'Faxa_lwdn', aoflux_in%lwdn, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + ! bottom level potential temperature will need to be computed if not received from the atm if (compute_atm_thbot) then allocate(aoflux_in%thbot(lsize)) @@ -1422,6 +1579,10 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (compute_atm_dens .or. compute_atm_thbot) then call fldbun_getfldptr(fldbun_a, 'Sa_pbot', aoflux_in%pbot, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs') then + call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if if (flds_wiso) then diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 485cdaf9b..8d41adbb8 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -113,7 +113,10 @@ subroutine med_phases_prep_atm(gcomp, rc) !--------------------------------------- !--- map atm/ocn fluxes from ocn to atm grid if appropriate !--------------------------------------- - if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'hafs') then + if (trim(coupling_mode) == 'cesm' .or. & + trim(coupling_mode) == 'hafs' .or. & + trim(coupling_mode) == 'nems_frac_aoflux' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then if (is_local%wrap%aoflux_grid == 'ogrid') then call med_aofluxes_map_ogrid2agrid_output(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -128,7 +131,9 @@ subroutine med_phases_prep_atm(gcomp, rc) !--------------------------------------- !--- merge all fields to atm !--------------------------------------- - if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'hafs') then + if (trim(coupling_mode) == 'cesm' .or. & + trim(coupling_mode) == 'nems_frac_aoflux' .or. & + trim(coupling_mode) == 'hafs') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compatm), & is_local%wrap%FBExp(compatm), & @@ -138,7 +143,9 @@ subroutine med_phases_prep_atm(gcomp, rc) FBMed1=is_local%wrap%FBMed_ocnalb_a, & FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'nems_frac' .or. trim(coupling_mode) == 'nems_orig') then + else if (trim(coupling_mode) == 'nems_frac' .or. & + trim(coupling_mode) == 'nems_orig' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compatm), & is_local%wrap%FBExp(compatm), & diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index de4599ffb..35208a109 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -117,6 +117,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! auto merges to ocn if ( trim(coupling_mode) == 'cesm' .or. & trim(coupling_mode) == 'nems_orig_data' .or. & + trim(coupling_mode) == 'nems_frac_aoflux' .or. & trim(coupling_mode) == 'hafs') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compocn), & @@ -126,7 +127,9 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) fldListTo(compocn), & FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'nems_frac' .or. trim(coupling_mode) == 'nems_orig') then + else if (trim(coupling_mode) == 'nems_frac' .or. & + trim(coupling_mode) == 'nems_orig' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compocn), & is_local%wrap%FBExp(compocn), & @@ -653,7 +656,9 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) lsize = size(ofrac) allocate(customwgt(lsize)) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then + if (trim(coupling_mode) == 'nems_orig' .or. & + trim(coupling_mode) == 'nems_frac' .or. & + trim(coupling_mode) == 'nems_frac_aoflux_sbs') then customwgt(:) = -ofrac(:) / const_lhvap call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_evap', & FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_lat' , wgtA=customwgt, rc=rc) @@ -665,13 +670,13 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return customwgt(:) = -ofrac(:) - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_taux', & - FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_taux' , wgtA=ifrac, & - FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_taux' , wgtB=customwgt, rc=rc) + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_taux', & + FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_taux', wgtA=ifrac, & + FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_taux', wgtB=customwgt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_tauy', & - FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_tauy' , wgtA=ifrac, & - FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_tauy' , wgtB=customwgt, rc=rc) + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_tauy', & + FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_tauy', wgtA=ifrac, & + FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_tauy', wgtB=customwgt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/ufs/ccpp/config/ccpp_prebuild_config.py b/ufs/ccpp/config/ccpp_prebuild_config.py new file mode 100755 index 000000000..d2872972e --- /dev/null +++ b/ufs/ccpp/config/ccpp_prebuild_config.py @@ -0,0 +1,107 @@ +#!/usr/bin/env python + +############################################################################### +# Used modules # +############################################################################### + +import os + +############################################################################### +# Query required information/s # +############################################################################### + +fv3_path = os.environ['FV3_PATH'] + +############################################################################### +# Definitions # +############################################################################### + +HOST_MODEL_IDENTIFIER = "CMEPS" + +# Add all files with metadata tables on the host model side and in CCPP, +# relative to basedir = top-level directory of host model. This includes +# kind and type definitions used in CCPP physics. Also add any internal +# dependencies of these files to the list. +VARIABLE_DEFINITION_FILES = [ + # actual variable definition files + '{}/ccpp/framework/src/ccpp_types.F90'.format(fv3_path), + '{}/ccpp/physics/physics/machine.F'.format(fv3_path), + 'CMEPS/ufs/ccpp/data/MED_typedefs.F90', + 'CMEPS/ufs/ccpp/data/MED_data.F90' + ] + +TYPEDEFS_NEW_METADATA = { + 'ccpp_types' : { + 'ccpp_t' : 'cdata', + 'ccpp_types' : '', + }, + 'machine' : { + 'machine' : '', + }, + 'MED_typedefs' : { + 'MED_init_type' : 'physics%init', + 'MED_statein_type' : 'physics%Statein', + 'MED_stateout_type' : 'physics%Stateout', + 'MED_interstitial_type' : 'physics%Interstitial', + 'MED_control_type' : 'physics%Model', + 'MED_coupling_type' : 'physics%Coupling', + 'MED_grid_type' : 'physics%Grid', + 'MED_sfcprop_type' : 'physics%Sfcprop', + 'MED_diag_type' : 'physics%Diag', + 'MED_typedefs' : '', + }, + 'MED_data' : { + 'MED_data' : '', + 'physics_type' : 'physics', + } + } + +# Add all physics scheme files relative to basedir +SCHEME_FILES = [ + '{}/ccpp/physics/physics/sfc_ocean.F'.format(fv3_path), + '{}/ccpp/physics/physics/sfc_diff.f'.format(fv3_path), + '{}/ccpp/physics/physics/GFS_surface_loop_control_part1.F90'.format(fv3_path), + '{}/ccpp/physics/physics/GFS_surface_loop_control_part2.F90'.format(fv3_path), + '{}/ccpp/physics/physics/GFS_surface_composites_pre.F90'.format(fv3_path), + '{}/ccpp/physics/physics/GFS_surface_composites_post.F90'.format(fv3_path), + '{}/ccpp/physics/physics/sfc_diag.f'.format(fv3_path) + ] + +# Default build dir, relative to current working directory, +# if not specified as command-line argument +DEFAULT_BUILD_DIR = 'CMEPS' + +# Auto-generated makefile/cmakefile snippets that contain all type definitions +TYPEDEFS_MAKEFILE = '{build_dir}/physics/CCPP_TYPEDEFS.mk' +TYPEDEFS_CMAKEFILE = '{build_dir}/physics/CCPP_TYPEDEFS.cmake' +TYPEDEFS_SOURCEFILE = '{build_dir}/physics/CCPP_TYPEDEFS.sh' + +# Auto-generated makefile/cmakefile snippets that contain all schemes +SCHEMES_MAKEFILE = '{build_dir}/physics/CCPP_SCHEMES.mk' +SCHEMES_CMAKEFILE = '{build_dir}/physics/CCPP_SCHEMES.cmake' +SCHEMES_SOURCEFILE = '{build_dir}/physics/CCPP_SCHEMES.sh' + +# Auto-generated makefile/cmakefile snippets that contain all caps +CAPS_MAKEFILE = '{build_dir}/physics/CCPP_CAPS.mk' +CAPS_CMAKEFILE = '{build_dir}/physics/CCPP_CAPS.cmake' +CAPS_SOURCEFILE = '{build_dir}/physics/CCPP_CAPS.sh' + +# Directory where to put all auto-generated physics caps +CAPS_DIR = '{build_dir}/physics' + +# Directory where the suite definition files are stored +SUITES_DIR = 'CMEPS/ufs/ccpp/suites' + +# Directory where to write static API to +STATIC_API_DIR = '{build_dir}/physics' +STATIC_API_CMAKEFILE = '{build_dir}/physics/CCPP_STATIC_API.cmake' +STATIC_API_SOURCEFILE = '{build_dir}/physics/CCPP_STATIC_API.sh' + +# Directory for writing HTML pages generated from metadata files +METADATA_HTML_OUTPUT_DIR = '{build_dir}/physics/physics/docs' + +# HTML document containing the model-defined CCPP variables +HTML_VARTABLE_FILE = '{build_dir}/physics/CCPP_VARIABLES_CMEPS.html' + +# LaTeX document containing the provided vs requested CCPP variables +LATEX_VARTABLE_FILE = '{build_dir}/framework/doc/DevelopersGuide/CCPP_VARIABLES_CMEPS.tex' diff --git a/ufs/ccpp/data/MED_data.F90 b/ufs/ccpp/data/MED_data.F90 new file mode 100644 index 000000000..edaf9dffa --- /dev/null +++ b/ufs/ccpp/data/MED_data.F90 @@ -0,0 +1,45 @@ +!> \file MED_data.F90 +!! Contains type definitions for CMEPS-related and physics-related variables + +module MED_data + +!> \section arg_table_MED_data +!! \htmlinclude MED_data.html +!! + + use MED_typedefs, only: MED_statein_type + use MED_typedefs, only: MED_stateout_type + use MED_typedefs, only: MED_init_type + use MED_typedefs, only: MED_interstitial_type + use MED_typedefs, only: MED_control_type + use MED_typedefs, only: MED_coupling_type + use MED_typedefs, only: MED_grid_type + use MED_typedefs, only: MED_sfcprop_type + use MED_typedefs, only: MED_diag_type + use ccpp_types, only: ccpp_t + + implicit none + + public physics + +!! \section arg_table_physics_type +!! \htmlinclude physics_type.html +!! + type physics_type + type(MED_init_type) :: init + type(MED_statein_type) :: statein + type(MED_stateout_type) :: stateout + type(MED_interstitial_type) :: interstitial + type(MED_control_type) :: model + type(MED_coupling_type) :: coupling + type(MED_grid_type) :: grid + type(MED_sfcprop_type) :: sfcprop + type(MED_diag_type) :: diag + end type physics_type + + type(physics_type), save, target :: physics + type(ccpp_t), save, target :: cdata + +contains + +end module MED_data diff --git a/ufs/ccpp/data/MED_data.meta b/ufs/ccpp/data/MED_data.meta new file mode 100644 index 000000000..91148f4f8 --- /dev/null +++ b/ufs/ccpp/data/MED_data.meta @@ -0,0 +1,84 @@ +[ccpp-table-properties] + name = physics_type + type = ddt + dependencies = MED_typedefs.F90 + +[ccpp-arg-table] + name = physics_type + type = ddt +[Init] + standard_name = MED_init_type_instance + long_name = instance of derived type MED_init_type + units = DDT + dimensions = () + type = MED_init_type +[Statein] + standard_name = MED_statein_type_instance + long_name = instance of derived type MED_statein_type + units = DDT + dimensions = () + type = MED_statein_type +[Interstitial] + standard_name = MED_interstitial_type_instance + long_name = instance of derived type MED_interstitial_type + units = DDT + dimensions = () + type = MED_interstitial_type +[Model] + standard_name = MED_control_type_instance + long_name = instance of derived type MED_control_type + units = DDT + dimensions = () + type = MED_control_type +[Coupling] + standard_name = MED_coupling_type_instance + long_name = instance of derived type MED_coupling_type + units = DDT + dimensions = () + type = MED_coupling_type +[Grid] + standard_name = MED_grid_type_instance + long_name = instance of derived type MED_grid_type + units = DDT + dimensions = () + type = MED_grid_type +[Sfcprop] + standard_name = MED_sfcprop_type_instance + long_name = instance of derived type MED_sfcprop_type + units = DDT + dimensions = () + type = MED_sfcprop_type +[Diag] + standard_name = MED_diag_type_instance + long_name = fields targeted for diagnostic output + units = DDT + dimensions = () + type = MED_diag_type + +######################################################################## +[ccpp-table-properties] + name = MED_data + type = module + dependencies = MED_typedefs.F90 + +[ccpp-arg-table] + name = MED_data + type = module +[physics_type] + standard_name = physics_type + long_name = definition of type physics_type + units = DDT + dimensions = () + type = physics_type +[physics] + standard_name = physics_type_instance + long_name = instance of derived data type physics_type + units = DDT + dimensions = () + type = physics_type +[cdata] + standard_name = ccpp_t_instance + long_name = instance of derived data type ccpp_t + units = DDT + dimensions = () + type = ccpp_t diff --git a/ufs/ccpp/data/MED_typedefs.F90 b/ufs/ccpp/data/MED_typedefs.F90 new file mode 100644 index 000000000..1b2ce51c5 --- /dev/null +++ b/ufs/ccpp/data/MED_typedefs.F90 @@ -0,0 +1,751 @@ +module MED_typedefs + +!> \section arg_table_MED_typedefs +!! \htmlinclude MED_typedefs.html +!! + use machine, only: kind_phys + use physcons, only: con_hvap, con_cp, con_rd, con_eps + use physcons, only: con_epsm1, con_fvirt, con_g + use physcons, only: con_tice + + implicit none + + !--- parameter constants used for default initializations + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys + real(kind=kind_phys), parameter :: clear_val = zero + real(kind=kind_phys), parameter :: huge = 9.9692099683868690E36 + + !--- data containers + +!! \section arg_table_MED_init_type +!! \htmlinclude MED_init_type.html +!! + type MED_init_type + integer :: im !< horizontal loop extent + end type MED_init_type + +!! \section arg_table_MED_statein_type +!! \htmlinclude MED_statein_type.html +!! + type MED_statein_type + real(kind=kind_phys), pointer :: pgr(:) => null() !< surface pressure (Pa) + real(kind=kind_phys), pointer :: ugrs(:) => null() !< u component of layer wind (m/s) + real(kind=kind_phys), pointer :: vgrs(:) => null() !< v component of layer wind (m/s) + real(kind=kind_phys), pointer :: tgrs(:) => null() !< model layer mean temperature (K) + real(kind=kind_phys), pointer :: qgrs(:) => null() !< layer mean tracer concentration (kg/kg) + real(kind=kind_phys), pointer :: prsl(:) => null() !< model layer mean pressure (Pa) + real(kind=kind_phys), pointer :: zlvl(:) => null() !< layer 1 height above ground (m) + real(kind=kind_phys), pointer :: prsik(:) => null() !< dimensionless Exner function at lowest model interface + real(kind=kind_phys), pointer :: prslk(:) => null() !< dimensionless Exner function at lowest model layer + real(kind=kind_phys), pointer :: u10m(:) => null() !< 10 meter u wind speed (m/s) + real(kind=kind_phys), pointer :: v10m(:) => null() !< 10 meter v wind speed (m/s) + real(kind=kind_phys), pointer :: stc(:,:) => null() !< soil temperature (K) + contains + procedure :: create => statein_create !< allocate array data + end type MED_statein_type + +!! \section arg_table_MED_stateout_type +!! \htmlinclude MED_stateout_type.html +!! + type MED_stateout_type + real(kind=kind_phys), pointer :: gu0(:) => null() !< updated zonal wind + real(kind=kind_phys), pointer :: gv0(:) => null() !< updated meridional wind + real(kind=kind_phys), pointer :: gt0(:) => null() !< updated temperature + real(kind=kind_phys), pointer :: gq0(:) => null() !< updated tracers + contains + procedure :: create => stateout_create !< allocate array data + end type MED_stateout_type + +!! \section arg_table_MED_interstitial_type +!! \htmlinclude MED_interstitial_type.html +!! + type MED_interstitial_type + ! water + real(kind=kind_phys), pointer :: tsfc_water(:) => null() !< surface skin temperature over water (K) + real(kind=kind_phys), pointer :: cd_water(:) => null() !< surface exchange coeff for momentum over water + real(kind=kind_phys), pointer :: cdq_water(:) => null() !< surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over water + real(kind=kind_phys), pointer :: ffmm_water(:) => null() !< Monin-Obukhov similarity function for momentum over water + real(kind=kind_phys), pointer :: fm10_water(:) => null() !< Monin-Obukhov similarity parameter for momentum at 10m over water + real(kind=kind_phys), pointer :: prslki(:) => null() !< Exner function ratio bt midlayer and interface at 1st layer + logical, pointer :: wet(:) => null() !< flag indicating presence of some ocean or lake surface area fraction + logical, pointer :: use_flake(:) => null() !< flag indicating lake points using flake model + real(kind=kind_phys), pointer :: wind(:) => null() !< wind speed at lowest model level (m/s) + logical, pointer :: flag_iter(:) => null() !< flag for iteration + real(kind=kind_phys), pointer :: qss_water(:) => null() !< surface air saturation specific humidity over water (kg/kg) + real(kind=kind_phys), pointer :: cmm_water(:) => null() !< momentum exchange coefficient over water (m/s) + real(kind=kind_phys), pointer :: chh_water(:) => null() !< thermal exchange coefficient over water (kg/m2s) + real(kind=kind_phys), pointer :: gflx_water(:) => null() !< soil heat flux over water (W/m2) + real(kind=kind_phys), pointer :: evap_water(:) => null() !< kinematic surface upward latent heat flux over water (m/s) + real(kind=kind_phys), pointer :: hflx_water(:) => null() !< kinematic surface upward sensible heat flux over water (Km/s) + real(kind=kind_phys), pointer :: ep1d_water(:) => null() !< surface upward potential latent heat flux over water (W/m2) + real(kind=kind_phys), pointer :: tsurf_water(:) => null() !< surface skin temperature after iteration over water (K) + real(kind=kind_phys), pointer :: uustar_water(:) => null() !< surface friction velocity over water (m/s) + real(kind=kind_phys), pointer :: rb_water(:) => null() !< bulk Richardson number at the surface over water + real(kind=kind_phys), pointer :: stress_water(:) => null() !< surface wind stress over water + real(kind=kind_phys), pointer :: ffhh_water(:) => null() !< Monin-Obukhov similarity function for heat over water + real(kind=kind_phys), pointer :: fh2_water(:) => null() !< Monin-Obukhov similarity parameter for heat at 2m over water + real(kind=kind_phys), pointer :: ztmax_water(:) => null() !< bounded surface roughness length for heat over water (m) + logical, pointer :: lake(:) => null() !< flag indicating presence of some lake surface area fraction + real(kind=kind_phys), pointer :: tprcp_water(:) => null() !< total precipitation amount in each time step over water + + ! land, not used to calculate aofluxes + real(kind=kind_phys), pointer :: zvfun(:) => null() !< function of surface roughness length and green vegetation fraction + real(kind=kind_phys), pointer :: sigmaf(:) => null() !< areal fractional cover of green vegetation bounded on the bottom + logical, pointer :: dry(:) => null() !< flag indicating presence of some land surface area fraction + real(kind=kind_phys), pointer :: tsfcl(:) => null() !< surface skin temperature over land (K) + real(kind=kind_phys), pointer :: tsurf_land(:) => null() !< surface skin temperature after iteration over land (K) + real(kind=kind_phys), pointer :: uustar_land(:) => null() !< surface friction velocity over land (m/s) + real(kind=kind_phys), pointer :: cd_land(:) => null() !< surface exchange coeff for momentum over land + real(kind=kind_phys), pointer :: cdq_land(:) => null() !< surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over land + real(kind=kind_phys), pointer :: rb_land(:) => null() !< bulk Richardson number at the surface over land + real(kind=kind_phys), pointer :: stress_land(:) => null() !< surface wind stress over land + real(kind=kind_phys), pointer :: ffmm_land(:) => null() !< Monin-Obukhov similarity function for momentum over land + real(kind=kind_phys), pointer :: ffhh_land(:) => null() !< Monin-Obukhov similarity function for heat over land + real(kind=kind_phys), pointer :: fm10_land(:) => null() !< Monin-Obukhov similarity parameter for momentum at 10m over land + real(kind=kind_phys), pointer :: fh2_land(:) => null() !< Monin-Obukhov similarity parameter for heat at 2m over land + real(kind=kind_phys), pointer :: ztmax_land(:) => null() !< bounded surface roughness length for heat over land (m) + real(kind=kind_phys), pointer :: frland(:) => null() !< land area fraction used in microphysics schemes + real(kind=kind_phys), pointer :: tprcp_land(:) => null() !< total precipitation amount in each time step over land + real(kind=kind_phys), pointer :: qss_land(:) => null() !< surface air saturation specific humidity over land (kg/kg) + real(kind=kind_phys), pointer :: evap_land(:) => null() !< kinematic surface upward latent heat flux over land (m/s) + real(kind=kind_phys), pointer :: hflx_land(:) => null() !< kinematic surface upward sensible heat flux over land (Km/s) + real(kind=kind_phys), pointer :: hflxq(:) => null() !< kinematic surface upward sensible heat flux reduced by surface roughness and vegetation + real(kind=kind_phys), pointer :: chh_land(:) => null() !< thermal exchange coefficient over land (kg/m2s) + real(kind=kind_phys), pointer :: cmm_land(:) => null() !< momentum exchange coefficient over land (m/s) + real(kind=kind_phys), pointer :: gflx_land(:) => null() !< soil heat flux over land (W/m2) + real(kind=kind_phys), pointer :: ep1d_land(:) => null() !< surface upward potential latent heat flux over land (W/m2) + + ! ice, not used to calculate aofluxes + logical, pointer :: icy(:) => null() !< flag indicating presence of some sea ice surface area fraction + real(kind=kind_phys), pointer :: tisfc(:) => null() !< surface skin temperature over ice (K) + real(kind=kind_phys), pointer :: tsurf_ice(:) => null() !< surface skin temperature after iteration over ice (K) + real(kind=kind_phys), pointer :: uustar_ice(:) => null() !< surface friction velocity over ice (m/s) + real(kind=kind_phys), pointer :: cd_ice(:) => null() !< surface exchange coeff for momentum over ice + real(kind=kind_phys), pointer :: cdq_ice(:) => null() !< surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over ice + real(kind=kind_phys), pointer :: rb_ice(:) => null() !< bulk Richardson number at the surface over ice + real(kind=kind_phys), pointer :: stress_ice(:) => null() !< surface wind stress over ice + real(kind=kind_phys), pointer :: ffmm_ice(:) => null() !< Monin-Obukhov similarity function for momentum over ice + real(kind=kind_phys), pointer :: ffhh_ice(:) => null() !< Monin-Obukhov similarity function for heat over ice + real(kind=kind_phys), pointer :: fm10_ice(:) => null() !< Monin-Obukhov similarity parameter for momentum at 10m over ice + real(kind=kind_phys), pointer :: fh2_ice(:) => null() !< Monin-Obukhov similarity parameter for heat at 2m over ice + real(kind=kind_phys), pointer :: ztmax_ice(:) => null() !< bounded surface roughness length for heat over ice (m) + logical, pointer :: flag_cice(:) => null() !< flag for cice + real(kind=kind_phys), pointer :: tprcp_ice(:) => null() !< total precipitation amount in each time step over ice + integer, pointer :: islmsk(:) => null() !< sea/land/ice mask (=0/1/2) + integer, pointer :: islmsk_cice(:) => null() !< sea/land/ice mask cice (=0/1/2) + real(kind=kind_phys), pointer :: ep1d_ice(:) => null() !< surface upward potential latent heat flux over ice (W/m2) + real(kind=kind_phys), pointer :: gflx_ice(:) => null() !< soil heat flux over ice + real(kind=kind_phys), pointer :: qss_ice(:) => null() !< surface air saturation specific humidity over ice (kg/kg) + real(kind=kind_phys), pointer :: evap_ice(:) => null() !< kinematic surface upward latent heat flux over ice (m/s) + real(kind=kind_phys), pointer :: hflx_ice(:) => null() !< kinematic surface upward sensible heat flux over ice (Km/s) + real(kind=kind_phys), pointer :: chh_ice(:) => null() !< thermal exchange coefficient over ice (kg/m2s) + real(kind=kind_phys), pointer :: cmm_ice(:) => null() !< momentum exchange coefficient over ice (m/s) + + ! others + real(kind=kind_phys), pointer :: z01d(:) => null() !< perturbation of momentum roughness length + real(kind=kind_phys), pointer :: zt1d(:) => null() !< perturbation of heat to momentum roughness length ratio + logical, pointer :: flag_guess(:) => null() !< flag for guess run + real(kind=kind_phys), pointer :: rb(:) => null() !< bulk Richardson number at the surface + real(kind=kind_phys), pointer :: fh2(:) => null() !< Monin-Obukhov similarity parameter for heat at 2m + real(kind=kind_phys), pointer :: fm10(:) => null() !< Monin-Obukhov similarity parameter for momentum at 10m + real(kind=kind_phys), pointer :: cdq(:) => null() !< surface exchange coeff heat & moisture + real(kind=kind_phys), pointer :: cd(:) => null() !< surface exchange coeff for momentum + real(kind=kind_phys), pointer :: hffac(:) => null() !< surface upward sensible heat flux reduction factor from canopy heat storage + real(kind=kind_phys), pointer :: stress(:) => null() !< surface wind stress + real(kind=kind_phys), pointer :: gflx(:) => null() !< soil heat flux + real(kind=kind_phys), pointer :: ep1d(:) => null() !< surface upward potential latent heat flux + contains + procedure :: create => interstitial_create !< allocate array data + procedure :: phys_reset => interstitial_phys_reset !< reset array data for physics + end type MED_interstitial_type + +!! \section arg_table_MED_control_type +!! \htmlinclude MED_control_type.html +!! + type MED_control_type + logical :: lseaspray !< flag for sea spray parameterization + logical :: use_med_flux !< flag for using atmosphere-ocean fluxes form mediator + integer :: ivegsrc !< land use dataset choice 0 => USGS, 1 => IGBP, 2 => UMD + integer :: lsm !< flag for land surface model + integer :: lsm_noahmp !< flag for NOAH MP land surface model + logical :: redrag !< flag for reduced drag coeff. over sea + integer :: sfc_z0_type !< surface roughness options over water + logical :: thsfc_loc !< flag for reference pressure in theta calculation + integer :: nstf_name(5) !< NSSTM flag: off/uncoupled/coupled=0/1/2 + integer :: lkm !< flag for flake model + logical :: first_time_step !< flag signaling first time step for time integration routine + logical :: frac_grid !< flag for fractional grid + logical :: cplwav2atm !< default no wav->atm coupling + logical :: restart !< flag whether this is a coldstart (.false.) or a warmstart/restart (.true.) + logical :: cplice !< default no cplice collection (used together with cplflx) + logical :: cplflx !< flag controlling cplflx collection (default off) + integer :: kdt !< current forecast iteration + real(kind=kind_phys) :: min_lakeice !< minimum lake ice value + real(kind=kind_phys) :: min_seaice !< minimum sea ice value + real(kind=kind_phys) :: huge !< definition of NetCDF float FillValue + logical :: lheatstrg !< flag for canopy heat storage parameterization + real(kind=kind_phys) :: h0facu !< canopy heat storage factor for sensible heat flux in unstable surface layer + real(kind=kind_phys) :: h0facs !< canopy heat storage factor for sensible heat flux in stable surface layer + integer :: lsoil !< number of soil layers + integer :: kice !< vertical loop extent for ice levels, start at 1 + integer :: lsm_ruc !< flag for RUC land surface model + contains + procedure :: init => control_initialize + end type MED_control_type + +!! \section arg_table_MED_coupling_type +!! \htmlinclude MED_coupling_type.html +!! + type MED_coupling_type + real(kind=kind_phys), pointer :: dtsfcin_med(:) => null() !< sfc latent heat flux over ocean + real(kind=kind_phys), pointer :: dqsfcin_med(:) => null() !< sfc sensible heat flux over ocean + contains + procedure :: create => coupling_create !< allocate array data + end type MED_coupling_type + +!! \section arg_table_MED_grid_type +!! \htmlinclude MED_grid_type.html +!! + type MED_grid_type + real(kind=kind_phys), pointer :: area(:) => null() !< area of the grid cell + contains + procedure :: create => grid_create !< allocate array data + end type MED_grid_type + +!! \section arg_table_MED_sfcprop_type +!! \htmlinclude MED_sfcprop_type.html +!! + type MED_sfcprop_type + real(kind=kind_phys), pointer :: zorlw(:) => null() !< surface roughness length over water (cm) + integer, pointer :: vtype(:) => null() !< vegetation type + real(kind=kind_phys), pointer :: shdmax(:) => null() !< max fractional coverage of green vegetation + real(kind=kind_phys), pointer :: zorll(:) => null() !< surface roughness length over land (cm) + real(kind=kind_phys), pointer :: zorli(:) => null() !< surface roughness length over ice (cm) + real(kind=kind_phys), pointer :: zorlwav(:) => null() !< surface roughness length from wave model (cm) + real(kind=kind_phys), pointer :: zorl(:) => null() !< surface roughness length (cm) + real(kind=kind_phys), pointer :: slmsk(:) => null() !< sea/land mask array (sea:0,land:1,sea-ice:2) + real(kind=kind_phys), pointer :: lakefrac(:) => null() !< lake fraction [0:1] + real(kind=kind_phys), pointer :: lakedepth(:) => null() !< lake depth (m) + real(kind=kind_phys), pointer :: landfrac(:) => null() !< fraction of horizontal grid area occupied by land + real(kind=kind_phys), pointer :: snowd(:) => null() !< snow depth water equivalent in mm ; same as snwdph + real(kind=kind_phys), pointer :: weasd(:) => null() !< water equiv of acc snow depth over land and sea ice + real(kind=kind_phys), pointer :: tprcp(:) => null() !< total precipitation amount in each time step + real(kind=kind_phys), pointer :: oceanfrac(:) => null() !< ocean fraction [0:1] + real(kind=kind_phys), pointer :: fice(:) => null() !< ice fraction over open water + real(kind=kind_phys), pointer :: hice(:) => null() !< sea ice thickness (m) + real(kind=kind_phys), pointer :: tsfco(:) => null() !< sea surface temperature + real(kind=kind_phys), pointer :: uustar(:) => null() !< boundary layer parameter + real(kind=kind_phys), pointer :: tsfc(:) => null() !< surface skin temperature + real(kind=kind_phys), pointer :: snodi(:) => null() !< water equivalent snow depth over ice (mm) + real(kind=kind_phys), pointer :: snodl(:) => null() !< water equivalent snow depth over land (mm) + real(kind=kind_phys), pointer :: qss(:) => null() !< surface air saturation specific humidity (kg/kg) + real(kind=kind_phys), pointer :: weasdi(:) => null() !< water equiv of acc snow depth over ice (mm) + real(kind=kind_phys), pointer :: weasdl(:) => null() !< water equiv of acc snow depth over land (mm) + real(kind=kind_phys), pointer :: ffhh(:) => null() !< Monin-Obukhov similarity function for heat + real(kind=kind_phys), pointer :: ffmm(:) => null() !< Monin-Obukhov similarity function for momentum + real(kind=kind_phys), pointer :: evap(:) => null() !< kinematic surface upward latent heat flux (kg kg-1 m s-1) + real(kind=kind_phys), pointer :: hflx(:) => null() !< kinematic surface upward sensible heat flux (K m/s) + real(kind=kind_phys), pointer :: tiice(:,:) => null() !< sea ice internal temperature + real(kind=kind_phys), pointer :: t2m(:) => null() !< temperature at 2 m + real(kind=kind_phys), pointer :: q2m(:) => null() !< specific humidity at 2 m + real(kind=kind_phys), pointer :: f10m(:) => null() !< ratio of sigma level 1 wind and 10m wind + contains + procedure :: create => sfcprop_create !< allocate array data + end type MED_sfcprop_type + +!! \section arg_table_MED_diag_type +!! \htmlinclude MED_diag_type.html +!! + type MED_diag_type + real(kind=kind_phys), pointer :: chh(:) => null() !< thermal exchange coefficient (kg m-2 s-1) + real(kind=kind_phys), pointer :: cmm(:) => null() !< momentum exchange coefficient (m/s) + contains + procedure :: create => diag_create !< allocate array data + end type MED_diag_type + + public MED_init_type + public MED_statein_type + public MED_coupling_type + public MED_control_type + public MED_interstitial_type + public MED_grid_type + public MED_sfcprop_type + public MED_diag_type + + contains + + subroutine statein_create(statein, im, model) + implicit none + class(MED_statein_type) :: statein + integer, intent(in) :: im + type(MED_control_type), intent(in) :: model + + allocate(statein%pgr(im)) + statein%pgr = clear_val + allocate(statein%ugrs(im)) + statein%ugrs = clear_val + allocate(statein%vgrs(im)) + statein%vgrs = clear_val + allocate(statein%tgrs(im)) + statein%tgrs = clear_val + allocate(statein%qgrs(im)) + statein%qgrs = clear_val + allocate(statein%prsl(im)) + statein%prsl = clear_val + allocate(statein%zlvl(im)) + statein%zlvl = clear_val + allocate(statein%prsik(im)) + statein%prsik = clear_val + allocate(statein%prslk(im)) + statein%prslk = clear_val + allocate(statein%u10m(im)) + statein%u10m = clear_val + allocate(statein%v10m(im)) + statein%v10m = clear_val + allocate(statein%stc(im,model%lsoil)) + statein%stc = clear_val + + end subroutine statein_create + + subroutine stateout_create(stateout, im) + implicit none + class(MED_stateout_type) :: stateout + integer, intent(in) :: im + + allocate(stateout%gu0(im)) + stateout%gu0 = clear_val + allocate(stateout%gv0(im)) + stateout%gv0 = clear_val + allocate(stateout%gt0(im)) + stateout%gt0 = clear_val + allocate(stateout%gq0(im)) + stateout%gq0 = clear_val + + end subroutine stateout_create + + subroutine interstitial_create(interstitial, im) + implicit none + class(MED_interstitial_type) :: interstitial + integer, intent(in) :: im + + ! water + allocate(interstitial%tsfc_water(im)) + interstitial%tsfc_water = huge + allocate(interstitial%cd_water(im)) + interstitial%cd_water = huge + allocate(interstitial%cdq_water(im)) + interstitial%cdq_water = huge + allocate(interstitial%ffmm_water(im)) + interstitial%ffmm_water = huge + allocate(interstitial%fm10_water(im)) + interstitial%fm10_water = huge + allocate(interstitial%prslki(im)) + interstitial%prslki = clear_val + allocate(interstitial%wet(im)) + interstitial%wet = .false. + allocate(interstitial%use_flake(im)) + interstitial%use_flake = .false. + allocate(interstitial%wind(im)) + interstitial%wind = huge + allocate(interstitial%flag_iter(im)) + interstitial%flag_iter = .true. + allocate(interstitial%qss_water(im)) + interstitial%qss_water = huge + allocate(interstitial%cmm_ice(im)) + interstitial%cmm_ice = huge + allocate(interstitial%cmm_land(im)) + interstitial%cmm_land = huge + allocate(interstitial%cmm_water(im)) + interstitial%cmm_water = huge + allocate(interstitial%chh_ice(im)) + interstitial%chh_ice = huge + allocate(interstitial%chh_land(im)) + interstitial%chh_land = huge + allocate(interstitial%chh_water(im)) + interstitial%chh_water = huge + allocate(interstitial%gflx_water(im)) + interstitial%gflx_water = clear_val + allocate(interstitial%evap_water(im)) + interstitial%evap_water = huge + allocate(interstitial%hflx_water(im)) + interstitial%hflx_water = huge + allocate(interstitial%hflx_land(im)) + interstitial%hflx_land = huge + allocate(interstitial%hflx_ice(im)) + interstitial%hflx_ice = huge + allocate(interstitial%ep1d_water(im)) + interstitial%ep1d_water = huge + allocate(interstitial%tsurf_water(im)) + interstitial%tsurf_water = huge + allocate(interstitial%uustar_water(im)) + interstitial%uustar_water = huge + allocate(interstitial%rb_water(im)) + interstitial%rb_water = huge + allocate(interstitial%stress_water(im)) + interstitial%stress_water = huge + allocate(interstitial%ffhh_water(im)) + interstitial%ffhh_water = huge + allocate(interstitial%fh2_water(im)) + interstitial%fh2_water = huge + allocate(interstitial%ztmax_water(im)) + interstitial%ztmax_water = clear_val + allocate(interstitial%lake(im)) + interstitial%lake = .false. + allocate(interstitial%tprcp_water(im)) + interstitial%tprcp_water = huge + + ! land + allocate(interstitial%zvfun(im)) + interstitial%zvfun = clear_val + allocate(interstitial%sigmaf(im)) + interstitial%sigmaf = clear_val + allocate(interstitial%dry(im)) + interstitial%dry = .false. + allocate(interstitial%tsfcl(im)) + interstitial%tsfcl = clear_val + allocate(interstitial%tsurf_land(im)) + interstitial%tsurf_land = huge + allocate(interstitial%uustar_land(im)) + interstitial%uustar_land = huge + allocate(interstitial%cd_land(im)) + interstitial%cd_land = huge + allocate(interstitial%cdq_land(im)) + interstitial%cdq_land = huge + allocate(interstitial%rb_land(im)) + interstitial%rb_land = huge + allocate(interstitial%stress_land(im)) + interstitial%stress_land = huge + allocate(interstitial%ffmm_land(im)) + interstitial%ffmm_land = huge + allocate(interstitial%ffhh_land(im)) + interstitial%ffhh_land = huge + allocate(interstitial%fm10_land(im)) + interstitial%fm10_land = huge + allocate(interstitial%fh2_land(im)) + interstitial%fh2_land = huge + allocate(interstitial%ztmax_land(im)) + interstitial%ztmax_land = clear_val + allocate(interstitial%frland(im)) + interstitial%frland = clear_val + allocate(interstitial%tprcp_land(im)) + interstitial%tprcp_land = huge + allocate(interstitial%qss_land(im)) + interstitial%qss_land = huge + allocate(interstitial%evap_land(im)) + interstitial%evap_land = huge + allocate(interstitial%hflxq(im)) + interstitial%hflxq = clear_val + allocate(interstitial%ep1d_land(im)) + interstitial%ep1d_land = huge + allocate(interstitial%gflx_land(im)) + interstitial%gflx_land = clear_val + + ! ice + allocate(interstitial%icy(im)) + interstitial%icy = .false. + allocate(interstitial%tisfc(im)) + interstitial%tisfc = clear_val + allocate(interstitial%tsurf_ice(im)) + interstitial%tsurf_ice = huge + allocate(interstitial%uustar_ice(im)) + interstitial%uustar_ice = huge + allocate(interstitial%cd_ice(im)) + interstitial%cd_ice = huge + allocate(interstitial%cdq_ice(im)) + interstitial%cdq_ice = huge + allocate(interstitial%rb_ice(im)) + interstitial%rb_ice = huge + allocate(interstitial%stress_ice(im)) + interstitial%stress_ice = huge + allocate(interstitial%ffmm_ice(im)) + interstitial%ffmm_ice = huge + allocate(interstitial%ffhh_ice(im)) + interstitial%ffhh_ice = huge + allocate(interstitial%fm10_ice(im)) + interstitial%fm10_ice = huge + allocate(interstitial%fh2_ice(im)) + interstitial%fh2_ice = huge + allocate(interstitial%ztmax_ice(im)) + interstitial%ztmax_ice = clear_val + allocate(interstitial%flag_cice(im)) + interstitial%flag_cice = .false. + allocate(interstitial%tprcp_ice(im)) + interstitial%tprcp_ice = huge + allocate(interstitial%islmsk(im)) + interstitial%islmsk = 0 + allocate(interstitial%islmsk_cice(im)) + interstitial%islmsk_cice = 0 + allocate(interstitial%qss_ice(im)) + interstitial%qss_ice = huge + allocate(interstitial%ep1d_ice(im)) + interstitial%ep1d_ice = huge + allocate(interstitial%gflx_ice(im)) + interstitial%gflx_ice = clear_val + allocate(interstitial%evap_ice(im)) + interstitial%evap_ice = huge + + ! others + allocate(interstitial%z01d(im)) + interstitial%z01d = clear_val + allocate(interstitial%zt1d(im)) + interstitial%zt1d = clear_val + allocate(interstitial%flag_guess(im)) + interstitial%flag_guess = .false. + allocate(interstitial%rb(im)) + interstitial%rb = clear_val + allocate(interstitial%fh2(im)) + interstitial%fh2 = clear_val + allocate(interstitial%fm10(im)) + interstitial%fm10 = clear_val + allocate(interstitial%cdq(im)) + interstitial%cdq_water = clear_val + allocate(interstitial%cd(im)) + interstitial%cd = clear_val + allocate(interstitial%ep1d(im)) + interstitial%ep1d = clear_val + allocate(interstitial%hffac(im)) + interstitial%hffac = clear_val + allocate(interstitial%stress(im)) + interstitial%stress = clear_val + allocate(interstitial%gflx(im)) + interstitial%gflx = clear_val + + end subroutine interstitial_create + + subroutine interstitial_phys_reset(interstitial) + implicit none + class(MED_interstitial_type) :: interstitial + + interstitial%cd = clear_val + interstitial%cd_ice = huge + interstitial%cd_land = huge + interstitial%cd_water = huge + interstitial%cdq = clear_val + interstitial%cdq_ice = huge + interstitial%cdq_land = huge + interstitial%cdq_water = huge + interstitial%chh_ice = huge + interstitial%chh_land = huge + interstitial%chh_water = huge + interstitial%cmm_ice = huge + interstitial%cmm_land = huge + interstitial%cmm_water = huge + interstitial%dry = .false. + interstitial%ep1d = clear_val + interstitial%ep1d_ice = huge + interstitial%ep1d_land = huge + interstitial%ep1d_water = huge + interstitial%evap_water = huge + interstitial%evap_land = huge + interstitial%evap_ice = huge + interstitial%ffhh_ice = huge + interstitial%ffhh_land = huge + interstitial%ffhh_water = huge + interstitial%ffmm_ice = huge + interstitial%ffmm_land = huge + interstitial%ffmm_water = huge + Interstitial%fh2 = clear_val + interstitial%fh2_ice = huge + interstitial%fh2_land = huge + interstitial%fh2_water = huge + Interstitial%fm10 = clear_val + interstitial%flag_cice = .false. + interstitial%flag_guess = .false. + interstitial%flag_iter = .true. + interstitial%fm10_ice = huge + interstitial%fm10_land = huge + interstitial%fm10_water = huge + interstitial%frland = clear_val + interstitial%gflx = clear_val + interstitial%gflx_ice = clear_val + interstitial%gflx_land = clear_val + interstitial%gflx_water = clear_val + interstitial%hffac = clear_val + interstitial%hflx_ice = huge + interstitial%hflx_land = huge + interstitial%hflx_water = huge + interstitial%hflxq = clear_val + interstitial%icy = .false. + interstitial%islmsk = 0 + interstitial%islmsk_cice = 0 + interstitial%lake = .false. + interstitial%prslki = clear_val + interstitial%rb = clear_val + interstitial%qss_ice = huge + interstitial%qss_land = huge + interstitial%qss_water = huge + interstitial%rb_ice = huge + interstitial%rb_land = huge + interstitial%rb_water = huge + interstitial%sigmaf = clear_val + interstitial%stress = clear_val + interstitial%stress_ice = huge + interstitial%stress_land = huge + interstitial%stress_water = huge + interstitial%tisfc = clear_val + interstitial%tprcp_water = huge + interstitial%tprcp_land = huge + interstitial%tprcp_ice = huge + interstitial%tsfc_water = huge + interstitial%tsfcl = clear_val + interstitial%tsurf_ice = huge + interstitial%tsurf_land = huge + interstitial%tsurf_water = huge + interstitial%use_flake = .false. + interstitial%uustar_ice = huge + interstitial%uustar_land = huge + interstitial%uustar_water = huge + interstitial%wet = .false. + interstitial%wind = huge + interstitial%z01d = clear_val + interstitial%zt1d = clear_val + interstitial%ztmax_ice = clear_val + interstitial%ztmax_land = clear_val + interstitial%ztmax_water = clear_val + interstitial%zvfun = clear_val + + end subroutine interstitial_phys_reset + + subroutine control_initialize(model) + implicit none + class(MED_control_type) :: model + + model%lseaspray = .false. + model%use_med_flux = .false. + model%ivegsrc = 2 + model%redrag = .false. + model%sfc_z0_type = 0 + model%thsfc_loc = .true. + model%lsm = 1 + model%lsm_noahmp = 2 + model%nstf_name = (/0,0,1,0,5/) + model%lkm = 0 + model%first_time_step = .true. + model%frac_grid = .false. + model%cplwav2atm = .false. + model%restart = .false. + model%cplice = .false. + model%cplflx = .false. + model%kdt = 0 ! nint(Model%fhour*con_hr/Model%dtp) + model%min_lakeice = 0.15d0 + model%min_seaice = 1.0d-11 + model%huge = 9.9692099683868690e36 + model%lheatstrg = .false. + model%h0facu = 0.25 + model%h0facs = 1.0 + model%lsoil = 4 + model%kice = 2 + model%lsm_ruc = 3 + + end subroutine control_initialize + + subroutine coupling_create(coupling, im) + implicit none + class(MED_coupling_type) :: coupling + integer, intent(in) :: im + + allocate(coupling%dtsfcin_med(im)) + coupling%dtsfcin_med = clear_val + allocate(coupling%dqsfcin_med(im)) + coupling%dqsfcin_med = clear_val + + end subroutine coupling_create + + subroutine grid_create(grid, im) + implicit none + class(MED_grid_type) :: grid + integer, intent(in) :: im + + allocate(grid%area(im)) + grid%area = clear_val + + end subroutine grid_create + + subroutine sfcprop_create(sfcprop, im, model) + implicit none + class(MED_sfcprop_type) :: sfcprop + integer, intent(in) :: im + type(MED_control_type), intent(in) :: model + + allocate(sfcprop%vtype(im)) + sfcprop%vtype = zero + allocate(sfcprop%shdmax(im)) + sfcprop%shdmax = clear_val + allocate(sfcprop%zorl(im)) + sfcprop%zorl = clear_val + allocate(sfcprop%zorlw(im)) + sfcprop%zorlw = clear_val + allocate(sfcprop%zorll(im)) + sfcprop%zorll = clear_val + allocate(sfcprop%zorli(im)) + sfcprop%zorli = clear_val + allocate(sfcprop%zorlwav(im)) + sfcprop%zorlwav = clear_val + allocate(sfcprop%slmsk(im)) + sfcprop%slmsk = clear_val + allocate(sfcprop%lakefrac(im)) + sfcprop%lakefrac = clear_val + allocate(sfcprop%lakedepth(im)) + sfcprop%lakedepth = clear_val + allocate(sfcprop%landfrac(im)) + sfcprop%landfrac = clear_val + allocate(sfcprop%snowd(im)) + sfcprop%snowd = clear_val + allocate(sfcprop%weasd(im)) + sfcprop%weasd = clear_val + allocate(sfcprop%tprcp(im)) + sfcprop%tprcp = clear_val + allocate(sfcprop%oceanfrac(im)) + sfcprop%oceanfrac = clear_val + allocate(sfcprop%fice(im)) + sfcprop%fice = clear_val + allocate(sfcprop%hice(im)) + sfcprop%hice = clear_val + allocate(sfcprop%tsfco(im)) + sfcprop%tsfco = clear_val + allocate(sfcprop%uustar(im)) + sfcprop%uustar = clear_val + allocate(sfcprop%tsfc(im)) + sfcprop%tsfc = clear_val + allocate(sfcprop%snodi(im)) + sfcprop%snodi = clear_val + allocate(sfcprop%snodl(im)) + sfcprop%snodl = clear_val + allocate(sfcprop%qss(im)) + sfcprop%qss = clear_val + allocate(sfcprop%weasdi(im)) + sfcprop%weasdi = clear_val + allocate(sfcprop%weasdl(im)) + sfcprop%weasdl = clear_val + allocate(sfcprop%ffhh(im)) + sfcprop%ffhh = clear_val + allocate(sfcprop%ffmm(im)) + sfcprop%ffmm = clear_val + allocate(sfcprop%evap(im)) + sfcprop%evap = clear_val + allocate(sfcprop%hflx(im)) + sfcprop%hflx = clear_val + allocate(sfcprop%tiice(im,model%kice)) + sfcprop%tiice = clear_val + allocate(sfcprop%t2m(im)) + sfcprop%t2m = clear_val + allocate(sfcprop%q2m(im)) + sfcprop%q2m = clear_val + allocate(sfcprop%f10m(im)) + sfcprop%f10m = clear_val + + end subroutine sfcprop_create + + subroutine diag_create(diag, im) + implicit none + class(MED_diag_type) :: diag + integer, intent(in) :: im + + allocate(diag%chh(im)) + diag%chh = clear_val + allocate(diag%cmm(im)) + diag%cmm = clear_val + + end subroutine diag_create + +end module MED_typedefs diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta new file mode 100644 index 000000000..6204c6a21 --- /dev/null +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -0,0 +1,1345 @@ +[ccpp-table-properties] + name = MED_init_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = MED_init_type + type = ddt +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + +######################################################################## +[ccpp-table-properties] + name = MED_statein_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = MED_statein_type + type = ddt +[pgr] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ugrs] + standard_name = x_wind_at_surface_adjacent_layer + long_name = zonal wind at lowest model layer + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[vgrs] + standard_name = y_wind_at_surface_adjacent_layer + long_name = meridional wind at lowest model layer + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tgrs] + standard_name = air_temperature_at_surface_adjacent_layer + long_name = mean temperature at lowest model layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[qgrs] + standard_name = specific_humidity_at_surface_adjacent_layer + long_name = water vapor specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[prsl] + standard_name = air_pressure_at_surface_adjacent_layer + long_name = mean pressure at lowest model layer + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zlvl] + standard_name = height_above_ground_at_lowest_model_layer + long_name = layer 1 height above ground (not MSL) + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[prsik] + standard_name = surface_dimensionless_exner_function + long_name = dimensionless Exner function at lowest model interface + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[prslk] + standard_name = dimensionless_exner_function_at_surface_adjacent_layer + long_name = dimensionless Exner function at lowest model layer + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[u10m] + standard_name = x_wind_at_10m + long_name = 10 meter u wind speed + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[v10m] + standard_name = y_wind_at_10m + long_name = 10 meter v wind speed + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_loop_extent,vertical_dimension_of_soil) + type = real + kind = kind_phys + +######################################################################## +[ccpp-table-properties] + name = MED_stateout_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = MED_stateout_type + type = ddt +[gu0] + standard_name = x_wind_of_new_state_at_surface_adjacent_layer + long_name = zonal wind at lowest model layer updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gv0] + standard_name = y_wind_of_new_state_at_surface_adjacent_layer + long_name = meridional wind at lowest model layer updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gt0] + standard_name = air_temperature_of_new_state_at_surface_adjacent_layer + long_name = temperature at lowest model layer updated by physics + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gq0] + standard_name = specific_humidity_of_new_state_at_surface_adjacent_layer + long_name = water vapor specific humidity at lowest model layer updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + +######################################################################## +[ccpp-table-properties] + name = MED_interstitial_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = MED_interstitial_type + type = ddt +[tsfc_water] + standard_name = surface_skin_temperature_over_water + long_name = surface skin temperature over water + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cd_water] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_water + long_name = surface exchange coeff for momentum over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cdq_water] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_water + long_name = surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffmm_water] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_water + long_name = Monin-Obukhov similarity function for momentum over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fm10_water] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_water + long_name = Monin-Obukhov similarity parameter for momentum at 10m over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[use_flake] + standard_name = flag_for_using_flake + long_name = flag indicating lake points using flake model + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[qss_water] + standard_name = surface_specific_humidity_over_water + long_name = surface air saturation specific humidity over water + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cmm_water] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_water + long_name = momentum exchange coefficient over water + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[chh_water] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water + long_name = thermal exchange coefficient over water + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gflx_water] + standard_name = upward_heat_flux_in_soil_over_water + long_name = soil heat flux over water + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[evap_water] + standard_name = kinematic_surface_upward_latent_heat_flux_over_water + long_name = kinematic surface upward latent heat flux over water + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[evap_land] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[evap_ice] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ice + long_name = kinematic surface upward latent heat flux over ice + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hflx_water] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_water + long_name = kinematic surface upward sensible heat flux over water + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hflx_land] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hflx_ice] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice + long_name = kinematic surface upward sensible heat flux over ice + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ep1d_water] + standard_name = surface_upward_potential_latent_heat_flux_over_water + long_name = surface upward potential latent heat flux over water + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zvfun] + standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction + long_name = function of surface roughness length and green vegetation fraction + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[sigmaf] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[z01d] + standard_name = perturbation_of_momentum_roughness_length + long_name = perturbation of momentum roughness length + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zt1d] + standard_name = perturbation_of_heat_to_momentum_roughness_length_ratio + long_name = perturbation of heat to momentum roughness length ratio + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[tsfcl] + standard_name = surface_skin_temperature_over_land + long_name = surface skin temperature over land + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tisfc] + standard_name = surface_skin_temperature_over_ice + long_name = surface skin temperature over ice + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsurf_water] + standard_name = surface_skin_temperature_after_iteration_over_water + long_name = surface skin temperature after iteration over water + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsurf_land] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsurf_ice] + standard_name = surface_skin_temperature_after_iteration_over_ice + long_name = surface skin temperature after iteration over ice + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[uustar_water] + standard_name = surface_friction_velocity_over_water + long_name = surface friction velocity over water + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[uustar_land] + standard_name = surface_friction_velocity_over_land + long_name = surface friction velocity over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[uustar_ice] + standard_name = surface_friction_velocity_over_ice + long_name = surface friction velocity over ice + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cd] + standard_name = surface_drag_coefficient_for_momentum_in_air + long_name = surface exchange coeff for momentum + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cd_land] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cd_ice] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice + long_name = surface exchange coeff for momentum over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cdq] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air + long_name = surface exchange coeff heat & moisture + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cdq_land] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cdq_ice] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice + long_name = surface exchange coeff heat & moisture over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[rb_water] + standard_name = bulk_richardson_number_at_lowest_model_level_over_water + long_name = bulk Richardson number at the surface over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[rb_land] + standard_name = bulk_richardson_number_at_lowest_model_level_over_land + long_name = bulk Richardson number at the surface over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[rb_ice] + standard_name = bulk_richardson_number_at_lowest_model_level_over_ice + long_name = bulk Richardson number at the surface over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[stress_water] + standard_name = surface_wind_stress_over_water + long_name = surface wind stress over water + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[stress_land] + standard_name = surface_wind_stress_over_land + long_name = surface wind stress over land + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[stress_ice] + standard_name = surface_wind_stress_over_ice + long_name = surface wind stress over ice + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffmm_land] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land + long_name = Monin-Obukhov similarity function for momentum over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffmm_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ice + long_name = Monin-Obukhov similarity function for momentum over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffhh_water] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_water + long_name = Monin-Obukhov similarity function for heat over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffhh_land] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_land + long_name = Monin-Obukhov similarity function for heat over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffhh_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_ice + long_name = Monin-Obukhov similarity function for heat over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fm10_land] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land + long_name = Monin-Obukhov similarity parameter for momentum at 10m over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fm10_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice + long_name = Monin-Obukhov similarity parameter for momentum at 10m over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fh2_water] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_water + long_name = Monin-Obukhov similarity parameter for heat at 2m over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fh2_land] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_land + long_name = Monin-Obukhov similarity parameter for heat at 2m over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fh2_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice + long_name = Monin-Obukhov similarity parameter for heat at 2m over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ztmax_water] + standard_name = bounded_surface_roughness_length_for_heat_over_water + long_name = bounded surface roughness length for heat over water + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ztmax_land] + standard_name = bounded_surface_roughness_length_for_heat_over_land + long_name = bounded surface roughness length for heat over land + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ztmax_ice] + standard_name = bounded_surface_roughness_length_for_heat_over_ice + long_name = bounded surface roughness length for heat over ice + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[flag_cice] + standard_name = flag_for_cice + long_name = flag for cice + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[lake] + standard_name = flag_nonzero_lake_surface_fraction + long_name = flag indicating presence of some lake surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical +[frland] + standard_name = land_area_fraction_for_microphysics + long_name = land area fraction used in microphysics schemes + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tprcp_water] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_water + long_name = total precipitation amount in each time step over water + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tprcp_land] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land + long_name = total precipitation amount in each time step over land + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tprcp_ice] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice + long_name = total precipitation amount in each time step over ice + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[islmsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_loop_extent) + type = integer +[islmsk_cice] + standard_name = sea_land_ice_mask_cice + long_name = sea/land/ice mask cice (=0/1/2) + units = flag + dimensions = (horizontal_loop_extent) + type = integer +[qss_land] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[qss_ice] + standard_name = surface_specific_humidity_over_ice + long_name = surface air saturation specific humidity over ice + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ep1d_ice] + standard_name = surface_upward_potential_latent_heat_flux_over_ice + long_name = surface upward potential latent heat flux over ice + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gflx_ice] + standard_name = upward_heat_flux_in_soil_over_ice + long_name = soil heat flux over ice + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[rb] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hflxq] + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness_and_vegetation + long_name = kinematic surface upward sensible heat flux reduced by surface roughness and vegetation + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fh2] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m + long_name = Monin-Obukhov similarity parameter for heat at 2m + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fm10] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m + long_name = Monin-Obukhov similarity parameter for momentum at 10m + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[chh_land] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land + long_name = thermal exchange coefficient over land + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[chh_ice] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice + long_name = thermal exchange coefficient over ice + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cmm_land] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land + long_name = momentum exchange coefficient over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cmm_ice] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ice + long_name = momentum exchange coefficient over ice + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ep1d] + standard_name = surface_upward_potential_latent_heat_flux + long_name = surface upward potential latent heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ep1d_land] + standard_name = surface_upward_potential_latent_heat_flux_over_land + long_name = surface upward potential latent heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hffac] + standard_name = surface_upward_sensible_heat_flux_reduction_factor + long_name = surface upward sensible heat flux reduction factor from canopy heat storage + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gflx] + standard_name = upward_heat_flux_in_soil + long_name = soil heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[gflx_land] + standard_name = upward_heat_flux_in_soil_over_land + long_name = soil heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + +######################################################################## +[ccpp-table-properties] + name = MED_control_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = MED_control_type + type = ddt +[lseaspray] + standard_name = flag_for_sea_spray + long_name = flag for sea spray parameterization + units = flag + dimensions = () + type = logical +[use_med_flux] + standard_name = do_mediator_atmosphere_ocean_fluxes + long_name = flag for using atmosphere-ocean fluxes form mediator (default false) + units = flag + dimensions = () + type = logical +[ivegsrc] + standard_name = control_for_vegetation_dataset + long_name = land use dataset choice + units = index + dimensions = () + type = integer +[redrag] + standard_name = flag_for_limited_surface_roughness_length_over_ocean + long_name = flag for reduced drag coeff. over sea + units = flag + dimensions = () + type = logical +[sfc_z0_type] + standard_name = flag_for_surface_roughness_option_over_water + long_name = surface roughness options over water + units = flag + dimensions = () + type = integer +[thsfc_loc] + standard_name = flag_for_reference_pressure_theta + long_name = flag for reference pressure in theta calculation + units = flag + dimensions = () + type = logical +[lsm] + standard_name = control_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer +[lsm_noahmp] + standard_name = identifier_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer +[nstf_name(1)] + standard_name = control_for_nsstm + long_name = NSSTM flag: off/uncoupled/coupled=0/1/2 + units = flag + dimensions = () + type = integer +[lkm] + standard_name = control_for_lake_surface_scheme + long_name = flag for lake surface model + units = flag + dimensions = () + type = integer +[first_time_step] + standard_name = flag_for_first_timestep + long_name = flag for first time step for time integration loop (cold/warmstart) + units = flag + dimensions = () + type = logical +[frac_grid] + standard_name = flag_for_fractional_landmask + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical +[cplwav2atm] + standard_name = flag_for_one_way_ocean_wave_coupling_to_atmosphere + long_name = flag controlling ocean wave coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical +[restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical +[cplice] + standard_name = flag_for_sea_ice_coupling + long_name = flag controlling cplice collection (default on) + units = flag + dimensions = () + type = logical +[cplflx] + standard_name = flag_for_surface_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer +[min_lakeice] + standard_name = min_lake_ice_area_fraction + long_name = minimum lake ice value + units = frac + dimensions = () + type = real + kind = kind_phys +[min_seaice] + standard_name = min_sea_ice_area_fraction + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys +[huge] + standard_name = netcdf_float_fillvalue + long_name = definition of NetCDF float FillValue + units = none + dimensions = () + type = real + kind = kind_phys +[lheatstrg] + standard_name = flag_for_canopy_heat_storage_in_land_surface_scheme + long_name = flag for canopy heat storage parameterization + units = flag + dimensions = () + type = logical +[h0facu] + standard_name = multiplicative_tuning_parameter_for_reduced_surface_heat_fluxes_due_to_canopy_heat_storage + long_name = canopy heat storage factor for sensible heat flux in unstable surface layer + units = none + dimensions = () + type = real + kind = kind_phys +[h0facs] + standard_name = multiplicative_tuning_parameter_for_reduced_latent_heat_flux_due_to_canopy_heat_storage + long_name = canopy heat storage factor for sensible heat flux in stable surface layer + units = none + dimensions = () + type = real + kind = kind_phys +[lsoil] + standard_name = vertical_dimension_of_soil + long_name = number of soil layers + units = count + dimensions = () + type = integer +[kice] + standard_name = vertical_dimension_of_sea_ice + long_name = vertical loop extent for ice levels, start at 1 + units = count + dimensions = () + type = integer +[lsm_ruc] + standard_name = identifier_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + +######################################################################## +[ccpp-table-properties] + name = MED_coupling_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = MED_coupling_type + type = ddt +[dtsfcin_med] + standard_name = surface_upward_sensible_heat_flux_over_ocean_from_mediator + long_name = sfc sensible heat flux input over ocean for coupling + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[dqsfcin_med] + standard_name = surface_upward_latent_heat_flux_over_ocean_from_mediator + long_name = sfc latent heat flux input over ocean for coupling + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + +######################################################################## +[ccpp-table-properties] + name = MED_grid_type + type = ddt + dependencies = +[ccpp-arg-table] + name = MED_grid_type + type = ddt +[area] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + +######################################################################## +[ccpp-table-properties] + name = MED_sfcprop_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = MED_sfcprop_type + type = ddt +[vtype] + standard_name = vegetation_type_classification + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_loop_extent) + type = integer +[shdmax] + standard_name = max_vegetation_area_fraction + long_name = max fractional coverage of green vegetation + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zorlw] + standard_name = surface_roughness_length_over_water + long_name = surface roughness length over water + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zorll] + standard_name = surface_roughness_length_over_land + long_name = surface roughness length over land + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zorli] + standard_name = surface_roughness_length_over_ice + long_name = surface roughness length over ice + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zorlwav] + standard_name = surface_roughness_length_from_wave_model + long_name = surface roughness length from wave model + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[slmsk] + standard_name = area_type + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[lakedepth] + standard_name = lake_depth + long_name = lake depth + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tprcp] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep + long_name = total precipitation amount in each time step + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[fice] + standard_name = sea_ice_area_fraction_of_sea_area_fraction + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hice] + standard_name = sea_ice_thickness + long_name = sea ice thickness + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsfco] + standard_name = sea_surface_temperature + long_name = sea surface temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[uustar] + standard_name = surface_friction_velocity + long_name = boundary layer parameter + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[snodi] + standard_name = surface_snow_thickness_water_equivalent_over_ice + long_name = water equivalent snow depth over ice + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[snodl] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[qss] + standard_name = surface_specific_humidity + long_name = surface air saturation specific humidity + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[weasdi] + standard_name = water_equivalent_accumulated_snow_depth_over_ice + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[weasdl] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[snowd] + standard_name = lwe_surface_snow + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[weasd] + standard_name = lwe_thickness_of_surface_snow_amount + long_name = water equiv of acc snow depth over land and sea ice + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffhh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[ffmm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[evap] + standard_name = surface_upward_specific_humidity_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[hflx] + standard_name = surface_upward_temperature_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[tiice] + standard_name = temperature_in_ice_layer + long_name = sea ice internal temperature + units = K + dimensions = (horizontal_loop_extent,vertical_dimension_of_sea_ice) + type = real + kind = kind_phys +[t2m] + standard_name = air_temperature_at_2m + long_name = 2 meter temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[q2m] + standard_name = specific_humidity_at_2m + long_name = 2 meter specific humidity + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[f10m] + standard_name = ratio_of_wind_at_surface_adjacent_layer_to_wind_at_10m + long_name = ratio of sigma level 1 wind and 10m wind + units = ratio + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + +######################################################################## +[ccpp-table-properties] + name = MED_diag_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = MED_diag_type + type = ddt +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air + long_name = thermal exchange coefficient + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air + long_name = momentum exchange coefficient + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + +######################################################################## +[ccpp-table-properties] + name = MED_typedefs + type = module + relative_path = ../../../../../FV3/ccpp/physics/physics + dependencies = machine.F,physcons.F90,physparam.f + +[ccpp-arg-table] + name = MED_typedefs + type = module +[MED_init_type] + standard_name = MED_init_type + long_name = definition of type MED_init_type + units = DDT + dimensions = () + type = MED_init_type +[MED_statein_type] + standard_name = MED_statein_type + long_name = definition of type MED_statein_type + units = DDT + dimensions = () + type = MED_statein_type +[MED_interstitial_type] + standard_name = MED_interstitial_type + long_name = definition of type MED_interstitial_type + units = DDT + dimensions = () + type = MED_interstitial_type +[MED_control_type] + standard_name = MED_control_type + long_name = definition of type MED_control_type + units = DDT + dimensions = () + type = MED_control_type +[MED_coupling_type] + standard_name = MED_coupling_type + long_name = definition of type MED_coupling_type + units = DDT + dimensions = () + type = MED_coupling_type +[MED_grid_type] + standard_name = MED_grid_type + long_name = definition of type MED_grid_type + units = DDT + dimensions = () + type = MED_grid_type +[MED_sfcprop_type] + standard_name = MED_sfcprop_type + long_name = definition of type MED_sfcprop_type + units = DDT + dimensions = () + type = MED_sfcprop_type +[MED_diag_type] + standard_name = MED_diag_type + long_name = definition of type MED_diag_type + units = DDT + dimensions = () + type = MED_diag_type +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys +[con_epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys +[con_tice] + standard_name = freezing_point_temperature_of_seawater + long_name = freezing point temperature of seawater + units = K + dimensions = () + type = real + kind = kind_phys diff --git a/ufs/ccpp/driver/med_ccpp_driver.F90 b/ufs/ccpp/driver/med_ccpp_driver.F90 new file mode 100644 index 000000000..8a867e1cd --- /dev/null +++ b/ufs/ccpp/driver/med_ccpp_driver.F90 @@ -0,0 +1,91 @@ +module med_ccpp_driver + + use ccpp_types, only: ccpp_t + use ccpp_static_api_med, only: ccpp_physics_init + use ccpp_static_api_med, only: ccpp_physics_run + use ccpp_static_api_med, only: ccpp_physics_finalize + + use MED_data, only: physics, cdata + + implicit none + + private ! default private + + public :: med_ccpp_driver_init + public :: med_ccpp_driver_run + public :: med_ccpp_driver_finalize + +!=============================================================================== +contains +!=============================================================================== + + subroutine med_ccpp_driver_init(ccpp_suite) + implicit none + + !--- input arguments -------------------------------- + character(len=*), intent(in) :: ccpp_suite + + !--- local variables -------------------------------- + integer :: ierr + + ! for physics running over the entire domain, block and thread + ! number are not used; set to safe values + cdata%blk_no = 1 + cdata%thrd_no = 1 + + ! initialize CCPP physics (run all _init routines) + call ccpp_physics_init(cdata, suite_name=trim(ccpp_suite), ierr=ierr) + if (ierr /= 0) then + write(0,'(a)') "An error occurred in ccpp_physics_init" + write(0,'(a)') trim(cdata%errmsg) + return + end if + + end subroutine med_ccpp_driver_init + + !============================================================================= + subroutine med_ccpp_driver_run(ccpp_suite, group) + implicit none + + !--- input arguments -------------------------------- + character(len=*), intent(in) :: ccpp_suite + character(len=*), optional, intent(in) :: group + + !--- local variables -------------------------------- + integer :: ierr + + ! run CCPP physics (run all _run routines) + if (present(group)) then + call ccpp_physics_run(cdata, suite_name=trim(ccpp_suite), group_name=trim(group), ierr=ierr) + else + call ccpp_physics_run(cdata, suite_name=trim(ccpp_suite), ierr=ierr) + end if + if (ierr /= 0) then + write(0,'(a)') "An error occurred in ccpp_physics_run" + write(0,'(a)') trim(cdata%errmsg) + return + end if + + end subroutine med_ccpp_driver_run + + !============================================================================= + subroutine med_ccpp_driver_finalize(ccpp_suite) + implicit none + + !--- input arguments -------------------------------- + character(len=*), intent(in) :: ccpp_suite + + !--- local variables -------------------------------- + integer :: ierr + + ! finalize CCPP physics (run all _finalize routines) + call ccpp_physics_finalize(cdata, suite_name=trim(ccpp_suite), ierr=ierr) + if (ierr /= 0) then + write(0,'(a)') "An error occurred in ccpp_physics_finalize" + write(0,'(a)') trim(cdata%errmsg) + return + end if + + end subroutine med_ccpp_driver_finalize + +end module med_ccpp_driver diff --git a/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml b/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml new file mode 100644 index 000000000..5017d407e --- /dev/null +++ b/ufs/ccpp/suites/suite_FV3_sfc_ocean.xml @@ -0,0 +1,19 @@ + + + + + + GFS_surface_composites_pre + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_ocean + GFS_surface_loop_control_part2 + + + GFS_surface_composites_post + sfc_diag + + + diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 new file mode 100644 index 000000000..9dafda8eb --- /dev/null +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -0,0 +1,556 @@ +module flux_atmocn_ccpp_mod + + use ESMF, only : operator(-), operator(/) + use ESMF, only : ESMF_GridComp, ESMF_Time, ESMF_SUCCESS, ESMF_FAILURE + use ESMF, only : ESMF_Clock, ESMF_TimeInterval, ESMF_ClockGet + use ESMF, only : ESMF_GridCompGetInternalState, ESMF_LOGMSG_INFO + use ESMF, only : ESMF_LogWrite + use NUOPC, only : NUOPC_CompAttributeGet + use NUOPC_Mediator, only : NUOPC_MediatorGet + + use physcons, only : p0 => con_p0 + use physcons, only : cappa => con_rocp + use physcons, only : cp => con_cp + use physcons, only : hvap => con_hvap + use physcons, only : sbc => con_sbc + + use MED_data, only : physics + use med_ccpp_driver, only : med_ccpp_driver_init + use med_ccpp_driver, only : med_ccpp_driver_run + use med_ccpp_driver, only : med_ccpp_driver_finalize + + use ufs_const_mod + use ufs_io_mod, only : read_initial, read_restart, write_restart + use med_kind_mod, only : R8=>SHR_KIND_R8, CS=>SHR_KIND_CS + use med_kind_mod, only : CL=>SHR_KIND_CL + use med_utils_mod, only : chkerr => med_utils_chkerr + use med_internalstate_mod, only : aoflux_ccpp_suite, logunit + use med_internalstate_mod, only : InternalState, mastertask + use med_constants_mod, only : dbug_flag => med_constants_dbug_flag + + implicit none + + private ! default private + + public :: flux_atmOcn_ccpp ! computes atm/ocn fluxes + + integer, save :: restart_freq + integer :: layout(2) + real(r8), save :: semis_water + character(len=cs), save :: starttype + character(len=cl), save :: ini_file + character(len=cl), save :: rst_file + character(len=cl), save :: mosaic_file + character(len=cl), save :: input_dir + character(len=1) , save :: listDel = "," + logical , save :: ini_read + + character(*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, & + tbot, qbot, zbot, garea, ubot, usfc, vbot, vsfc, rbot, ts, lwdn, sen, lat, & + lwup, evp, taux, tauy, tref, qref, duu10n, ustar_sv, re_sv, ssq_sv, missval) + + implicit none + + !--- input arguments -------------------------------- + type(ESMF_GridComp), intent(in) :: gcomp ! gridded component + logical , intent(in) :: mastertask ! master task + integer , intent(in) :: logunit ! log file unit number + integer , intent(in) :: nMax ! data vector length + integer , intent(in) :: mask (nMax) ! ocn domain mask + real(r8), intent(in) :: psfc(nMax) ! atm P (surface) (Pa) + real(r8), intent(in) :: pbot(nMax) ! atm P (bottom) (Pa) + real(r8), intent(in) :: tbot(nMax) ! atm T (bottom) (K) + real(r8), intent(in) :: qbot(nMax) ! atm specific humidity (bottom) (kg/kg) + real(r8), intent(in) :: zbot(nMax) ! atm level height (m) + real(r8), intent(in) :: garea(nMax) ! grid area (m^2) + real(r8), intent(in) :: ubot(nMax) ! atm u wind (bottom) (m/s) + real(r8), intent(in) :: usfc(nMax) ! atm u wind (surface) (m/s) + real(r8), intent(in) :: vbot(nMax) ! atm v wind (bottom) (m/s) + real(r8), intent(in) :: vsfc(nMax) ! atm v wind (surface) (m/s) + real(r8), intent(in) :: rbot(nMax) ! atm density (kg/m^3) + real(r8), intent(in) :: lwdn(nMax) ! atm lw downward (W/m^2) + real(r8), intent(in) :: ts(nMax) ! ocn surface temperature (K) + real(r8), intent(in), optional :: missval ! masked value + + !--- output arguments ------------------------------- + real(r8), intent(out) :: sen(nMax) ! heat flux: sensible (W/m^2) + real(r8), intent(out) :: lat(nMax) ! heat flux: latent (W/m^2) + real(r8), intent(out) :: lwup(nMax) ! heat flux: lw upward (W/m^2) + real(r8), intent(out) :: evp(nMax) ! heat flux: evap ((kg/s)/m^2) + real(r8), intent(out) :: taux(nMax) ! surface stress, zonal (N) + real(r8), intent(out) :: tauy(nMax) ! surface stress, maridional (N) + real(r8), intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(r8), intent(out) :: qref(nMax) ! diag: 2m ref humidity (kg/kg) + real(r8), intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(r8), intent(out) :: ustar_sv(nMax) ! diag: ustar + real(r8), intent(out) :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(r8), intent(out) :: ssq_sv(nMax) ! diag: sea surface humidity (kg/kg) + + !--- local variables -------------------------------- + type(ESMF_Clock) :: mclock + type(ESMF_Time) :: currtime, starttime + type(ESMF_TimeInterval) :: timeStep + type(InternalState) :: is_local + integer :: n, rc + real(r8) :: spval + logical :: isPresent, isSet + character(len=cs) :: cvalue, cname + logical, save :: first_call = .true. + character(len=*), parameter :: subname=' (flux_atmOcn_ccpp) ' + !--------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! missing value + if (present(missval)) then + spval = missval + else + spval = shr_const_spval + endif + + !---------------------- + ! Determine clock, starttime and currtime + !---------------------- + + call NUOPC_MediatorGet(gcomp, mediatorClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, currtime=currTime, starttime=startTime, timeStep=timeStep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! init CCPP and setup/allocate variables + if (first_call) then + ! initalize model related parameters + call physics%model%init() + + ! allocate and initalize data structures + call physics%statein%create(nMax,physics%model) + call physics%stateout%create(nMax) + call physics%interstitial%create(nMax) + call physics%coupling%create(nMax) + call physics%grid%create(nMax) + call physics%sfcprop%create(nMax,physics%model) + call physics%diag%create(nMax) + + ! initalize dimension + physics%init%im = nMax + + ! determine CCPP/physics specific options + ! semis_water, surface emissivity for lw radiation + ! semis_wat is constant and set to 0.97 in setemis() call + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_semis_water", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + semis_water = 0.97 + if (isPresent .and. isSet) then + read(cvalue,*) semis_water + end if + + ! lseaspray + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_lseaspray", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%lseaspray = .true. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%lseaspray = .false. + end if + + ! ivegsrc + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_ivegsrc", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%ivegsrc = 1 + if (isPresent .and. isSet) then + read(cvalue,*) physics%model%ivegsrc + end if + + ! redrag + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_redrag", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%redrag = .true. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%redrag = .false. + end if + + ! lsm + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_lsm", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%lsm = 1 + if (isPresent .and. isSet) then + read(cvalue,*) physics%model%lsm + end if + + ! frac_grid + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_frac_grid", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%frac_grid = .true. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%frac_grid = .false. + end if + + ! restart + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_restart", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%restart = .false. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.true.' .or. trim(cvalue) .eq. 'true') physics%model%restart = .true. + end if + + ! cplice + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_cplice", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%cplice = .true. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%cplice = .false. + end if + + ! cplflx + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_cplflx", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%cplflx = .true. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%cplflx = .false. + end if + + ! lheatstrg + call NUOPC_CompAttributeGet(gcomp, name="ccpp_phy_lheatstrg", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + physics%model%lheatstrg = .true. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.false.' .or. trim(cvalue) .eq. 'false') physics%model%lheatstrg = .false. + end if + + ! determine CCPP/host model specific options + ! restart interval, set it to < 0 for no restart + call NUOPC_CompAttributeGet(gcomp, name="ccpp_restart_interval", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) restart_freq + else + restart_freq = 3600 ! write restart file every hour + end if + + ! file name for restart + call NUOPC_CompAttributeGet(gcomp, name='ccpp_restart_file', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + rst_file = trim(cvalue) + else + rst_file = 'unset' + end if + + ! file name for initial conditions + call NUOPC_CompAttributeGet(gcomp, name='ccpp_ini_file_prefix', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + ini_file = trim(cvalue) + else + ini_file = 'INPUT/sfc_data.tile' + end if + + ! name of mosaic file that will be used to read tiled files + call NUOPC_CompAttributeGet(gcomp, name='ccpp_ini_mosaic_file', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (isPresent .and. isSet) then + mosaic_file = trim(cvalue) + else + if (trim(rst_file) == 'unset') then + call ESMF_LogWrite(trim(subname)//': ccpp_ini_mosaic_file is required to read tiled initial condition!', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + end if + + ! input directory for tiled CS grid files + call NUOPC_CompAttributeGet(gcomp, name='ccpp_input_dir', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (isPresent .and. isSet) then + input_dir = trim(cvalue) + else + input_dir = "INPUT/" + end if + + ! layout to read tiled CS grid files + call NUOPC_CompAttributeGet(gcomp, name='ccpp_ini_layout', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + do n = 1, 2 + call string_listGetName(cvalue, n, cname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (rc == ESMF_FAILURE) return + read(cname,*) layout(n) + end do + else + layout(:) = -1 + end if + + ! flag for reading initial conditions + call NUOPC_CompAttributeGet(gcomp, name="ccpp_ini_read", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ini_read = .false. + if (isPresent .and. isSet) then + if (trim(cvalue) .eq. '.true.' .or. trim(cvalue) .eq. 'true') ini_read = .true. + end if + + if (mastertask) then + write(logunit,*) '========================================================' + write(logunit,'(a,f5.2)') trim(subname)//' ccpp_phy_semis_water = ', semis_water + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_lseaspray = ', physics%model%lseaspray + write(logunit,'(a,i2)') trim(subname)//' ccpp_phy_ivegsrc = ', physics%model%ivegsrc + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_redrag = ', physics%model%redrag + write(logunit,'(a,i2)') trim(subname)//' ccpp_phy_lsm = ', physics%model%lsm + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_frac_grid = ', physics%model%frac_grid + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_restart = ', physics%model%restart + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_cplice = ', physics%model%cplice + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_cplflx = ', physics%model%cplflx + write(logunit,'(a,l)') trim(subname)//' ccpp_phy_lheatstrg = ', physics%model%lheatstrg + write(logunit,'(a,i5)') trim(subname)//' ccpp_restart_interval = ', restart_freq + write(logunit,'(a)') trim(subname)//' ccpp_ini_file_prefix = '//trim(ini_file) + write(logunit,'(a)') trim(subname)//' ccpp_ini_mosaic_file = '//trim(mosaic_file) + write(logunit,'(a)') trim(subname)//' ccpp_input_dir = '//trim(input_dir) + write(logunit,'(a)') trim(subname)//' ccpp_restart_file = '//trim(rst_file) + write(logunit,*) '========================================================' + end if + + ! read restart + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) starttype + if (trim(starttype) == trim('startup')) then + ! TODO: this is just extra leyer of protection since reading of initial condition is not stable yet + if (ini_read) call read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) + else + call read_restart(gcomp, rst_file, rc) + end if + + ! run CCPP init + ! TODO: suite name need to be provided by ESMF config file + call med_ccpp_driver_init(trim(aoflux_ccpp_suite)) + end if + + ! fill in atmospheric forcing + physics%statein%pgr(:) = psfc(:) + physics%statein%ugrs(:) = ubot(:) + physics%statein%vgrs(:) = vbot(:) + physics%statein%tgrs(:) = tbot(:) + physics%statein%qgrs(:) = qbot(:) + physics%statein%prsl(:) = pbot(:) + physics%statein%zlvl(:) = zbot(:) + physics%statein%prsik(:) = (psfc(:)/p0)**cappa + physics%statein%prslk(:) = (pbot(:)/p0)**cappa + physics%statein%u10m(:) = usfc(:) + physics%statein%v10m(:) = vsfc(:) + + ! fill in updated states by physics, currently set to statein + physics%stateout%gu0(:) = ubot(:) + physics%stateout%gv0(:) = vbot(:) + physics%stateout%gt0(:) = tbot(:) + physics%stateout%gq0(:) = qbot(:) + + ! fill in grid related variables + physics%grid%area(:) = garea(:) + + ! set counter + physics%model%kdt = ((currTime-StartTime)/timeStep)+1 + if (mastertask .and. dbug_flag > 5) then + write(logunit,'(a,i5)') 'kdt = ', physics%model%kdt + end if + + ! reset physics variables, mimic GFS_suite_interstitial_phys_reset + call physics%interstitial%phys_reset() + + ! init required variables to mimic GFS_surface_generic_pre + ! TODO: the wind calculation in GFS_surface_generic_pre has cnvwind adjustment + physics%interstitial%wind = sqrt(ubot(:)*ubot(:)+vbot(:)*vbot(:)) + physics%interstitial%prslki = physics%statein%prsik(:)/physics%statein%prslk(:) + + ! init required variables to mimic GFS_surface_composites_pre (assumes no ice) + physics%interstitial%uustar_water(:) = physics%sfcprop%uustar(:) + physics%sfcprop%tsfco(:) = ts(:) + physics%sfcprop%tsfc(:) = ts(:) + physics%interstitial%tsfc_water(:) = physics%sfcprop%tsfc(:) + physics%interstitial%tsurf_water(:) = physics%sfcprop%tsfc(:) + physics%sfcprop%zorlw(:) = physics%sfcprop%zorl(:) + do n = 1, nMax + physics%sfcprop%zorlw(n) = max(1.0e-5, min(1.0d0, physics%sfcprop%zorlw(n))) + end do + + ! init other variables + if (first_call .and. trim(starttype) == trim('continue')) then + physics%interstitial%qss_water(:) = physics%sfcprop%qss(:) + else + physics%sfcprop%qss(:) = qbot(:) + physics%interstitial%qss_water(:) = qbot(:) + end if + + ! calculate wet flag and ocean fraction based on masking, assumes full oceean + where (mask(:) /= 0) + physics%interstitial%wet = .true. + physics%sfcprop%oceanfrac = 1.0d0 + elsewhere + physics%sfcprop%oceanfrac = 0.0d0 + end where + + ! run CCPP physics + ! TODO: suite name need to be provided by ESMF config file + call med_ccpp_driver_run(trim(aoflux_ccpp_suite), 'physics') + + ! unit and sign conversion to be consistent with other flux scheme (CESM) + do n = 1, nMax + if (mask(n) /= 0) then + sen(n) = -1.0_r8*physics%interstitial%hflx_water(n)*rbot(n)*cp + lat(n) = -1.0_r8*physics%interstitial%evap_water(n)*rbot(n)*hvap + lwup(n) = -1.0_r8*(semis_water*sbc*ts(n)**4+(1.0_r8-semis_water)*lwdn(n)) + evp(n) = lat(n)/hvap + taux(n) = rbot(n)*physics%interstitial%stress_water(n)*ubot(n)/physics%interstitial%wind(n) + tauy(n) = rbot(n)*physics%interstitial%stress_water(n)*vbot(n)/physics%interstitial%wind(n) + tref(n) = physics%sfcprop%t2m(n) + qref(n) = physics%sfcprop%q2m(n) + duu10n(n) = physics%interstitial%wind(n)*physics%interstitial%wind(n) + ustar_sv(n) = physics%interstitial%uustar_water(n) + re_sv(n) = physics%interstitial%cmm_water(n) + ssq_sv(n) = physics%interstitial%qss_water(n) + else + sen(n) = spval + lat(n) = spval + lwup(n) = spval + evp(n) = spval + taux(n) = spval + tauy(n) = spval + tref(n) = spval + qref(n) = spval + duu10n(n) = spval + ustar_sv(n) = spval + re_sv(n) = spval + ssq_sv(n) = spval + end if + end do + + ! write restart file + call write_restart(gcomp, restart_freq, rc) + + ! set first call flag + first_call = .false. + + end subroutine flux_atmOcn_ccpp + + !=============================================================================== + subroutine string_listGetName(list, k, name, rc) + + ! ---------------------------------------------- + ! Get name of k-th field in list + ! It is adapted from CDEPS, shr_string_listGetName + ! ---------------------------------------------- + + implicit none + + ! input/output variables + character(*) , intent(in) :: list ! list/string + integer , intent(in) :: k ! index of field + character(*) , intent(out) :: name ! k-th name in list + integer , intent(out) :: rc + + ! local variables + integer :: i,n ! generic indecies + integer :: kFlds ! number of fields in list + integer :: i0,i1 ! name = list(i0:i1) + character(*), parameter :: subName = '(shr_string_listGetName)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + !--- check that this is a valid index --- + kFlds = string_listGetNum(list) + if (k < 1 .or. kFlds < k) then + call ESMF_LogWrite(trim(subname)//": ERROR invalid index ", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + end if + + !--- start with whole list, then remove fields before and after desired + !field --- + i0 = 1 + i1 = len_trim(list) + + !--- remove field names before desired field --- + do n=2,k + i = index(list(i0:i1),listDel) + i0 = i0 + i + end do + + !--- remove field names after desired field --- + if ( k < kFlds ) then + i = index(list(i0:i1),listDel) + i1 = i0 + i - 2 + end if + + !--- copy result into output variable --- + name = list(i0:i1)//" " + + end subroutine string_listGetName + + !=============================================================================== + integer function string_listGetNum(str) + + ! ---------------------------------------------- + ! Get number of fields in a string list + ! It is adapted from CDEPS, string_listGetNum + ! ---------------------------------------------- + + implicit none + + ! input/output variables + character(*), intent(in) :: str ! string to search + + ! local variables + integer :: count ! counts occurances of char + character(*), parameter :: subName = '(string_listGetNum)' + ! ---------------------------------------------- + + string_listGetNum = 0 + + if (len_trim(str) > 0) then + count = string_countChar(str,listDel) + string_listGetNum = count + 1 + endif + + end function string_listGetNum + + !=============================================================================== + integer function string_countChar(str,char,rc) + + ! ---------------------------------------------- + ! Count number of occurances of a character + ! It is adapted from CDEPS, string_countChar + ! ---------------------------------------------- + + implicit none + + ! input/output variables + character(*), intent(in) :: str ! string to search + character(1), intent(in) :: char ! char to search for + integer, intent(out), optional :: rc ! return code + + ! local variables + integer :: count ! counts occurances of char + integer :: n ! generic index + character(*), parameter :: subName = '(string_countChar)' + ! ---------------------------------------------- + + count = 0 + do n = 1, len_trim(str) + if (str(n:n) == char) count = count + 1 + end do + string_countChar = count + + end function string_countChar + +end module flux_atmocn_ccpp_mod diff --git a/ufs/ufs_io_mod.F90 b/ufs/ufs_io_mod.F90 new file mode 100644 index 000000000..ee85fa183 --- /dev/null +++ b/ufs/ufs_io_mod.F90 @@ -0,0 +1,882 @@ + module ufs_io_mod + + use ESMF, only : operator(-) + use ESMF, only : ESMF_VM, ESMF_VMGet, ESMF_VMGetCurrent, ESMF_LogWrite + use ESMF, only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS, ESMF_FAILURE + use ESMF, only : ESMF_Field, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR + use ESMF, only : ESMF_Grid, ESMF_Decomp_Flag, ESMF_DECOMP_SYMMEDGEMAX + use ESMF, only : ESMF_GridCreateMosaic, ESMF_INDEX_GLOBAL, ESMF_TYPEKIND_R8 + use ESMF, only : ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER + use ESMF, only : ESMF_GridCompGetInternalState, ESMF_KIND_R8 + use ESMF, only : ESMF_ArraySpec, ESMF_ArraySpecSet, ESMF_MESHLOC_ELEMENT + use ESMF, only : ESMF_FieldCreate, ESMF_FieldGet, ESMF_FieldDestroy + use ESMF, only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated, ESMF_FieldRedist + use ESMF, only : ESMF_MeshGet, ESMF_FieldRegrid, ESMF_FieldRegridStore + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleAdd + use ESMF, only : ESMF_FieldWriteVTK, ESMF_VMAllFullReduce, ESMF_REDUCE_SUM + use ESMF, only : ESMF_Mesh, ESMF_Calendar, ESMF_Clock, ESMF_ClockGet + use ESMF, only : ESMF_ClockGetNextTime, ESMF_TimeIntervalGet + use ESMF, only : ESMF_Time, ESMF_TimeGet, ESMF_TimeInterval + use ESMF, only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet + use ESMF, only : ESMF_FieldBundleRemove, ESMF_FieldBundleDestroy + use ESMF, only : ESMF_FieldWrite, ESMF_FieldBundleRead, ESMF_FieldBundleWrite + use ESMF, only : ESMF_REGRIDMETHOD_CONSERVE_2ND, ESMF_MeshCreate + use ESMF, only : ESMF_TERMORDER_SRCSEQ, ESMF_REGION_TOTAL + use NUOPC, only : NUOPC_CompAttributeGet + use NUOPC_Mediator, only : NUOPC_MediatorGet + + use fms_mod, only : fms_init + use fms2_io_mod, only : open_file, FmsNetcdfFile_t + use mosaic2_mod, only : get_mosaic_ntiles, get_mosaic_grid_sizes + use mosaic2_mod, only : get_mosaic_contact, get_mosaic_ncontacts + use mpp_mod, only : mpp_pe, mpp_root_pe, mpp_error, FATAL + use mpp_domains_mod, only : mpp_define_layout, mpp_get_compute_domain + use mpp_domains_mod, only : mpp_domains_init, mpp_define_mosaic, domain2d + use mpp_io_mod, only : MPP_RDONLY, MPP_NETCDF, MPP_SINGLE, MPP_MULTI + use mpp_io_mod, only : mpp_get_info, mpp_get_fields, mpp_get_atts + use mpp_io_mod, only : mpp_open, mpp_read, fieldtype + + use med_kind_mod, only : r8=>SHR_KIND_R8, cs=>SHR_KIND_CS, cl=>SHR_KIND_CL + use med_utils_mod, only : chkerr => med_utils_chkerr + use med_constants_mod, only : dbug_flag => med_constants_dbug_flag + use med_internalstate_mod, only : InternalState, mastertask, logunit + use med_internalstate_mod, only : compatm, compocn, mapconsf + use med_io_mod, only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date + use ufs_const_mod, only : shr_const_cday + use med_methods_mod, only : fldbun_getdata1d => med_methods_FB_getdata1d + use med_methods_mod, only : fldbun_diagnose => med_methods_FB_diagnose + use med_methods_mod, only : FB_fldchk => med_methods_FB_FldChk + use med_methods_mod, only : FB_getfldptr => med_methods_FB_GetFldPtr + + use MED_data, only : physics + + implicit none + + private ! default private + + public read_initial + public read_restart + public write_restart + + type domain_type + type(ESMF_Grid) :: grid ! ESMF grid object from mosaic file + type(ESMF_Mesh) :: mesh ! ESMF mesh object from CS grid + type(ESMF_RouteHandle) :: rh ! ESMF routehandle object to redist data from CS grid to mesh + type(domain2d) :: mosaic_domain ! domain object created by FMS + integer :: layout(2) ! layout for domain decomposition + integer, allocatable :: nit(:) ! size of tile in i direction + integer, allocatable :: njt(:) ! size of tile in j direction + integer :: ntiles ! number of tiles in case of having CS grid + integer :: ncontacts ! number of contacts in case of having CS grid + integer, allocatable :: tile1(:) ! list of tile numbers in tile 1 of each contact + integer, allocatable :: tile2(:) ! list of tile numbers in tile 2 of each contact + integer, allocatable :: istart1(:) ! list of starting i-index in tile 1 of each contact + integer, allocatable :: iend1(:) ! list of ending i-index in tile 1 of each contact + integer, allocatable :: jstart1(:) ! list of starting j-index in tile 1 of each contact + integer, allocatable :: jend1(:) ! list of ending j-index in tile 1 of each contact + integer, allocatable :: istart2(:) ! list of starting i-index in tile 2 of each contact + integer, allocatable :: iend2(:) ! list of ending i-index in tile 2 of each contact + integer, allocatable :: jstart2(:) ! list of starting j-index in tile 2 of each contact + integer, allocatable :: jend2(:) ! list of ending j-index in tile 2 of each contact + end type domain_type + + character(cl) :: case_name = 'unset' ! case name + + character(*), parameter :: modName = "(ufs_io_mod)" + character(*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) + + implicit none + + ! input/output variables + type(ESMF_GridComp), intent(in) :: gcomp + character(len=cl), intent(in) :: ini_file + character(len=cl), intent(in) :: mosaic_file + character(len=cl), intent(in) :: input_dir + integer :: layout(2) + integer, intent(inout) :: rc + + ! local variables + type(domain_type) :: domain + type(InternalState) :: is_local + type(ESMF_RouteHandle) :: rh + type(ESMF_Field) :: lfield, field, field_dst + real(ESMF_KIND_R8), pointer :: ptr(:) + integer :: n + character(len=cs), allocatable :: flds(:) + character(len=*), parameter :: subname = trim(modName)//': (read_initial) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! --------------------- + ! Create domain + ! --------------------- + + call create_fms_domain(gcomp, domain, mosaic_file, layout, rc) + + ! --------------------- + ! Create grid + ! --------------------- + + call create_grid(gcomp, domain, mosaic_file, input_dir, rc) + + !---------------------- + ! Read data + !---------------------- + + allocate(flds(2)) + flds = (/ 'zorl ', & + 'uustar' /) + do n = 1,size(flds) + ! read from tiled file + call read_tiled_file(gcomp, ini_file, trim(flds(n)), domain, field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create destination field + field_dst = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & + name=trim(flds(n)), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create rh + call ESMF_FieldRegridStore(field, field_dst, routehandle=rh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! map field + if (is_local%wrap%aoflux_grid == 'agrid') then + ! do nothing, just redist in case of haning different decomp. in here and aoflux mesh + call ESMF_FieldRedist(field, field_dst, rh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + ! remap from atm to ocn or exchange grid + call ESMF_FieldRegrid(field, field_dst, rh, termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! debug + if (dbug_flag > 5) then + call ESMF_FieldWriteVTK(field_dst, 'ini_'//trim(flds(n))//'_'//trim(is_local%wrap%aoflux_grid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! return pointer and fill variable + call ESMF_FieldGet(field_dst, localDe=0, farrayPtr=ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) write(logunit,'(a)') 'Reading: '//trim(flds(n)) + if (trim(flds(n)) == 'zorl' ) physics%sfcprop%zorl(:) = ptr(:) + if (trim(flds(n)) == 'uustar') physics%sfcprop%uustar(:)= ptr(:) + nullify(ptr) + + ! free memory + call ESMF_FieldDestroy(field_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + ! free memory + if (allocated(flds)) deallocate(flds) + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + + end subroutine read_initial + + !=============================================================================== + subroutine read_restart(gcomp, rst_file, rc) + implicit none + + ! input/output variables + type(ESMF_GridComp), intent(in) :: gcomp ! gridded component + character(len=cl), intent(inout):: rst_file ! restart file + integer, intent(inout) :: rc ! return code + + ! local variables + type(ESMF_Field) :: field, lfield + type(ESMF_Clock) :: mclock + type(ESMF_Time) :: currtime + type(ESMF_TimeInterval) :: timeStep + type(ESMF_FieldBundle), save :: FBin + type(InternalState) :: is_local + integer :: n, yr, mon, day, sec + real(r8), pointer :: ptr(:) + character(len=cl) :: currtime_str + character(len=cs), allocatable :: flds(:) + character(len=*), parameter :: subname=trim(modName)//': (read_restart) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Set restart file name + !---------------------- + + if (trim(case_name) == 'unset') then + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (trim(rst_file) == 'unset') then + call NUOPC_MediatorGet(gcomp, mediatorClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(mclock, currTime=currTime, timeStep=timeStep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(currTime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + rst_file = trim(case_name)//'.cpl.ccpp.'//trim(currtime_str)//'.nc' + end if + + !---------------------- + ! Now read in the restart file + !---------------------- + + if (mastertask) then + write(logunit,'(a)') 'Reading CCPP restart file: '//trim(rst_file) + end if + + ! create FB + FBin = ESMF_FieldBundleCreate(rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add fields + allocate(flds(3)) + flds = (/ 'zorl ', & + 'uustar', & + 'qss ' /) + do n = 1,size(flds) + field = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & + name=trim(flds(n)), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + call ESMF_FieldGet(field, farrayptr=ptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ptr(:) = 0.0_r8 + nullify(ptr) + call ESMF_FieldBundleAdd(FBin, (/field/), rc=rc) + end do + + ! read file to FB + call ESMF_FieldBundleRead(FBin, trim(rst_file), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! debug + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//' diagnose at '//trim(currtime_str), ESMF_LOGMSG_INFO) + call fldbun_diagnose(FBin, string=trim(subname)//' CCPP FBin ', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + !---------------------- + ! Fill internal data structures + !---------------------- + + do n = 1,size(flds) + if (FB_FldChk(FBin, trim(flds(n)), rc=rc)) then + call FB_getfldptr(FBin, trim(flds(n)), ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (mastertask) write(logunit,'(a)') 'Reading: '//trim(flds(n)) + if (trim(flds(n)) == 'zorl' ) physics%sfcprop%zorl(:) = ptr(:) + if (trim(flds(n)) == 'uustar') physics%sfcprop%uustar(:)= ptr(:) + if (trim(flds(n)) == 'qss' ) physics%sfcprop%qss(:) = ptr(:) + + nullify(ptr) + + ! debug + if (dbug_flag > 5) then + call ESMF_FieldBundleGet(FBin, fieldName=trim(flds(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldWriteVTK(lfield, 'rst_'//trim(flds(n))//'_'//trim(is_local%wrap%aoflux_grid), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end do + + !---------------------- + ! Free memory + !---------------------- + + do n = 1,size(flds) + if (FB_FldChk(FBin, trim(flds(n)), rc=rc)) then + ! get field from FB + call ESMF_FieldBundleGet(FBin, trim(flds(n)), field=field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! remove field from FB + call ESMF_FieldBundleRemove(FBin, (/ trim(flds(n)) /), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! remove field + call ESMF_FieldDestroy(field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do + deallocate(flds) + + ! remove FB + call ESMF_FieldBundleDestroy(FBin, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + + end subroutine read_restart + + !=============================================================================== + subroutine create_fms_domain(gcomp, domain, mosaic_file, layout, rc) + implicit none + + ! input/output variables + type(ESMF_GridComp), intent(in) :: gcomp + type(domain_type), intent(inout) :: domain + character(len=cl), intent(in) :: mosaic_file + integer :: layout(2) + integer, intent(inout) :: rc + + ! local variables + type(ESMF_VM) :: vm + type(FmsNetcdfFile_t) :: mosaic_fileobj + integer :: mpicomm, npes_per_tile + integer :: n, ntiles, npet + integer :: halo = 0 + integer :: global_indices(4,6) + integer :: layout2d(2,6) + integer, allocatable :: pe_start(:), pe_end(:) + character(len=cl) :: msg + character(len=*), parameter :: subname = trim(modName)//': (create_fms_domain) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + ! --------------------- + ! Initialize FMS + ! --------------------- + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm=vm, mpiCommunicator=mpicomm, petCount=npet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call fms_init(mpicomm) + + ! --------------------- + ! Open mosaic file and query some information + ! --------------------- + + if (.not. open_file(mosaic_fileobj, trim(mosaic_file), 'read')) then + call ESMF_LogWrite(trim(subname)//'error in opening file '//trim(mosaic_file), ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + end if + + ! query number of tiles + domain%ntiles = get_mosaic_ntiles(mosaic_fileobj) + + ! query domain sizes for each tile + if (.not. allocated(domain%nit)) allocate(domain%nit(domain%ntiles)) + if (.not. allocated(domain%njt)) allocate(domain%njt(domain%ntiles)) + call get_mosaic_grid_sizes(mosaic_fileobj, domain%nit, domain%njt) + + ! query number of contacts + domain%ncontacts = get_mosaic_ncontacts(mosaic_fileobj) + + ! allocate required arrays to create FMS domain from mosaic file + if (.not. allocated(domain%tile1)) allocate(domain%tile1(domain%ncontacts)) + if (.not. allocated(domain%tile2)) allocate(domain%tile2(domain%ncontacts)) + if (.not. allocated(domain%istart1)) allocate(domain%istart1(domain%ncontacts)) + if (.not. allocated(domain%iend1)) allocate(domain%iend1(domain%ncontacts)) + if (.not. allocated(domain%jstart1)) allocate(domain%jstart1(domain%ncontacts)) + if (.not. allocated(domain%jend1)) allocate(domain%jend1(domain%ncontacts)) + if (.not. allocated(domain%istart2)) allocate(domain%istart2(domain%ncontacts)) + if (.not. allocated(domain%iend2)) allocate(domain%iend2(domain%ncontacts)) + if (.not. allocated(domain%jstart2)) allocate(domain%jstart2(domain%ncontacts)) + if (.not. allocated(domain%jend2)) allocate(domain%jend2(domain%ncontacts)) + + ! query information about contacts + call get_mosaic_contact(mosaic_fileobj, domain%tile1, domain%tile2, & + domain%istart1, domain%iend1, domain%jstart1, domain%jend1, & + domain%istart2, domain%iend2, domain%jstart2, domain%jend2) + + ! print out debug information + if (dbug_flag > 2) then + do n = 1, domain%ncontacts + write(msg, fmt='(A,I2,A,2I5)') trim(subname)//' : tile1, tile2 (', n ,') = ', domain%tile1(n), domain%tile2(n) + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + write(msg, fmt='(A,I2,A,4I5)') trim(subname)//' : istart1, iend1, jstart1, jend1 (', n ,') = ', & + domain%istart1(n), domain%iend1(n), domain%jstart1(n), domain%jend1(n) + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + write(msg, fmt='(A,I2,A,4I5)') trim(subname)//' : istart2, iend2, jstart2, jend2 (', n ,') = ', & + domain%istart2(n), domain%iend2(n), domain%jstart2(n), domain%jend2(n) + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + end do + end if + + !---------------------- + ! Initialize domain + !---------------------- + + call mpp_domains_init() + + !---------------------- + ! Find out layout that will be used to read the data + !---------------------- + + ! setup global indices + do n = 1, domain%ntiles + global_indices(1,n) = 1 + global_indices(2,n) = domain%nit(n) + global_indices(3,n) = 1 + global_indices(4,n) = domain%njt(n) + end do + + ! check total number of PETs + if (mod(npet, domain%ntiles) /= 0) then + write(msg, fmt='(A,I5)') trim(subname)//' : nPet should be multiple of 6 to read initial conditions but it is ', npet + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + end if + + ! calculate layout if it is not provided as configuration option + if (layout(1) < 0 .and. layout(2) < 0) then + npes_per_tile = npet/domain%ntiles + call mpp_define_layout(global_indices(:,1), npes_per_tile, domain%layout) + else + domain%layout(:) = layout(:) + end if + + ! set layout and print out debug information + do n = 1, domain%ntiles + layout2d(:,n) = domain%layout(:) + if (dbug_flag > 2) then + write(msg, fmt='(A,I2,A,2I5)') trim(subname)//' layout (', n ,') = ', layout2d(1,n), layout2d(2,n) + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + write(msg, fmt='(A,I2,A,4I5)') trim(subname)//' global_indices (', n,') = ', & + global_indices(1,n), global_indices(2,n), global_indices(3,n), global_indices(4,n) + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + end if + enddo + + !---------------------- + ! Set pe_start, pe_end + !---------------------- + + allocate(pe_start(domain%ntiles)) + allocate(pe_end(domain%ntiles)) + do n = 1, domain%ntiles + pe_start(n) = mpp_root_pe()+(n-1)*domain%layout(1)*domain%layout(2) + pe_end(n) = mpp_root_pe()+n*domain%layout(1)*domain%layout(2)-1 + if (dbug_flag > 2) then + write(msg, fmt='(A,I2,A,2I5)') trim(subname)//' pe_start, pe_end (', n ,') = ', pe_start(n), pe_end(n) + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + end if + enddo + + !---------------------- + ! Create FMS domain object + !---------------------- + + call mpp_define_mosaic(global_indices, layout2d, domain%mosaic_domain, & + domain%ntiles, domain%ncontacts, domain%tile1, domain%tile2, & + domain%istart1, domain%iend1, domain%jstart1, domain%jend1, & + domain%istart2, domain%iend2, domain%jstart2, domain%jend2, & + pe_start, pe_end, symmetry=.true., & + whalo=halo, ehalo=halo, shalo=halo, nhalo=halo, & + name='atm domain') + + !---------------------- + ! Deallocate temporary arrays + !---------------------- + + deallocate(pe_start) + deallocate(pe_end) + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + + end subroutine create_fms_domain + + !=============================================================================== + subroutine create_grid(gcomp, domain, mosaic_file, input_dir, rc) + implicit none + + ! input/output variables + type(ESMF_GridComp), intent(in) :: gcomp + type(domain_type), intent(inout) :: domain + character(len=cl), intent(in) :: mosaic_file + character(len=cl), intent(in) :: input_dir + integer, intent(inout) :: rc + + ! local variables + type(ESMF_Decomp_Flag) :: decompflagPTile(2,6) + integer :: n + integer :: decomptile(2,6) + character(len=*), parameter :: subname = trim(modName)//': (create_grid) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + ! TODO: currently this is only tested with global application + ! set decomposition + do n = 1, domain%ntiles + decomptile(1,n) = domain%layout(1) + decomptile(2,n) = domain%layout(2) + decompflagPTile(:,n) = (/ ESMF_DECOMP_SYMMEDGEMAX, ESMF_DECOMP_SYMMEDGEMAX /) + end do + + ! create grid + domain%grid = ESMF_GridCreateMosaic(filename=trim(mosaic_file), & + regDecompPTile=decomptile, tileFilePath=trim(input_dir), decompflagPTile=decompflagPTile, & + staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & + indexflag=ESMF_INDEX_GLOBAL, name='input_grid', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create mesh + domain%mesh = ESMF_MeshCreate(domain%grid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + + end subroutine create_grid + + !=============================================================================== + subroutine read_tiled_file(gcomp, filename, varname, domain, field_dst, rc) + implicit none + + ! input/output variables + type(ESMF_GridComp), intent(in) :: gcomp + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: varname + type(domain_type), intent(inout) :: domain + type(ESMF_Field), intent(inout) :: field_dst + integer, intent(inout), optional :: rc + + ! local variables + type(ESMF_Field) :: field_src, field_tmp + type(ESMF_ArraySpec) :: arraySpec + type(InternalState) :: is_local + type(fieldtype), allocatable:: vars(:) + integer :: funit, my_tile + integer :: i, j, n + integer :: isc, iec, jsc, jec + integer :: ndim, nvar, natt, ntime + logical :: not_found, is_root_pe + real(ESMF_KIND_R8), pointer :: ptr2d(:,:) + real(r8), allocatable :: rdata(:,:) + character(len=cl) :: cname + character(len=*), parameter :: subname=trim(modName)//': (read_tiled_file) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' reading '//trim(varname), ESMF_LOGMSG_INFO) + + !---------------------- + ! Get the internal state from the mediator component + !---------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Set tile + !---------------------- + my_tile = int(mpp_pe()/(domain%layout(1)*domain%layout(2)))+1 + + is_root_pe = .false. + if (mpp_pe() == (my_tile-1)*(domain%layout(1)*domain%layout(2))) is_root_pe = .true. + + !---------------------- + ! Open file and query file attributes + !---------------------- + + write(cname, fmt='(A,I1,A)') trim(filename), my_tile, '.nc' + call mpp_open(funit, trim(cname), action=MPP_RDONLY, form=MPP_NETCDF, threading=MPP_MULTI, fileset=MPP_SINGLE, is_root_pe=is_root_pe) + call mpp_get_info(funit, ndim, nvar, natt, ntime) + allocate(vars(nvar)) + call mpp_get_fields(funit, vars(:)) + + !---------------------- + ! Find and read requested variable + !---------------------- + + not_found = .true. + do n = 1, nvar + ! get variable name + call mpp_get_atts(vars(n), name=cname) + + ! check variable name + if (trim(cname) == trim(varname)) then + ! get array bounds or domain + call mpp_get_compute_domain(domain%mosaic_domain, isc, iec, jsc, jec) + + ! allocate data array and set initial value + allocate(rdata(isc:iec,jsc:jec)) + rdata(:,:) = 0.0_r8 + + ! read data + call mpp_read(funit, vars(n), domain%mosaic_domain, rdata, 1) + + ! set missing values to zero + where (rdata == 1.0e20) + rdata(:,:) = 0.0_r8 + end where + end if + + not_found = .false. + end do + + if (not_found) then + call mpp_error(FATAL, 'File being read is not the expected one. '//trim(varname)//' is not found.') + end if + + !---------------------- + ! Move data from grid to mesh + !---------------------- + + ! set type and rank for ESMF arrayspec + call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create source field + field_src = ESMF_FieldCreate(domain%grid, arraySpec, staggerloc=ESMF_STAGGERLOC_CENTER, & + indexflag=ESMF_INDEX_GLOBAL, name=trim(varname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get pointer and fill it + call ESMF_FieldGet(field_src, localDe=0, farrayPtr=ptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ptr2d(:,:) = rdata(:,:) + nullify(ptr2d) + if (allocated(rdata)) deallocate(rdata) + + ! create destination field + field_dst = ESMF_FieldCreate(domain%mesh, ESMF_TYPEKIND_R8, name=trim(varname), & + meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create routehandle from grid to mesh + if (.not. ESMF_RouteHandleIsCreated(domain%rh, rc=rc)) then + call ESMF_FieldRegridStore(field_src, field_dst, routehandle=domain%rh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! redist field from ESMF Grid to Mesh + call ESMF_FieldRedist(field_src, field_dst, domain%rh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Output result field for debugging purpose + !---------------------- + + if (dbug_flag > 2) then + call ESMF_FieldWrite(field_dst, trim(varname)//'_agrid.nc', variableName=trim(varname), overwrite=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (dbug_flag > 5) then + call ESMF_FieldWriteVTK(field_dst, trim(varname)//'_agrid', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! clean memory + call ESMF_FieldDestroy(field_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine read_tiled_file + + !=============================================================================== + subroutine write_restart(gcomp, restart_freq, rc) + implicit none + + ! input/output variableswrite_restart + type(ESMF_GridComp), intent(in) :: gcomp ! gridded component + integer, intent(in) :: restart_freq ! restart interval in hours + integer, intent(inout) :: rc ! return code + + ! local variables + type(ESMF_VM) :: vm + type(ESMF_Field) :: field + type(ESMF_Clock) :: mclock + type(ESMF_Calendar) :: calendar + type(ESMF_Time) :: currtime, starttime, nexttime + type(ESMF_TimeInterval) :: timediff(2) + type(ESMF_FieldBundle), save :: FBout + type(InternalState) :: is_local + integer :: yr, mon, day, sec + integer :: n, m, ns, start_ymd + character(cl) :: time_units + real(r8) :: time_val + real(r8) :: time_bnds(2) + real(r8), pointer :: ptr(:) + character(len=cl) :: tmpstr + character(len=cl) :: rst_file + character(len=cl) :: nexttime_str + integer, save :: ns_total + logical, save :: first_call = .true. + character(len=cs), allocatable :: flds(:) + character(len=*), parameter :: subname=trim(modName)//': (write_restart) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Determine clock, starttime, currtime and nexttime + !---------------------- + + call NUOPC_MediatorGet(gcomp, mediatorClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, currtime=currtime, starttime=starttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Determine time units + !---------------------- + + call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_ymd2date(yr, mon, day, start_ymd) + time_units = 'days since '//trim(med_io_date2yyyymmdd(start_ymd))//' '//med_io_sec2hms(sec, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Determine restart file name + !---------------------- + + if (trim(case_name) == 'unset') then + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + rst_file = trim(case_name)//'.cpl.ccpp.'//trim(nexttime_str)//'.nc' + + ! return if it is not time to write restart + if (restart_freq < 0) return + if (mod(sec, restart_freq) /= 0) return + + !---------------------- + ! Create restart file + !---------------------- + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------------- + ! Define time dimension + !---------------------- + + timediff(1) = nexttime - starttime + call ESMF_TimeIntervalGet(timediff(1), d=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + time_val = day + sec/real(shr_const_cday,r8) + time_bnds(1) = time_val + time_bnds(2) = time_val + + !---------------------- + ! Create FB and add fields to it + !---------------------- + + if (first_call) then + ! create FB + FBout = ESMF_FieldBundleCreate(rc=rc) + + ! get total element count + call ESMF_MeshGet(is_local%wrap%aoflux_mesh, elementCount=ns, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllFullReduce(vm, (/ns/), ns_total, 1, ESMF_REDUCE_SUM, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! add fields + allocate(flds(3)) + flds = (/ 'zorl ', & + 'uustar', & + 'qss ' /) + do n = 1,size(flds) + ! create new field on aoflux mesh + field = ESMF_FieldCreate(is_local%wrap%aoflux_mesh, ESMF_TYPEKIND_R8, & + name=trim(flds(n)), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! get pointer out of field + call ESMF_FieldGet(field, farrayptr=ptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! fill pointer + if (trim(flds(n)) == 'zorl' ) ptr(:) = physics%sfcprop%zorl(:) + if (trim(flds(n)) == 'uustar') ptr(:) = physics%sfcprop%uustar(:) + if (trim(flds(n)) == 'qss' ) ptr(:) = physics%sfcprop%qss(:) + nullify(ptr) + + ! add field to FB + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + else + do n = 1,size(flds) + ! retrieve field pointer from FB + call fldbun_getdata1d(FBout, trim(flds(n)), ptr, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! fill pointer + if (trim(flds(n)) == 'zorl' ) ptr(:) = physics%sfcprop%zorl(:) + if (trim(flds(n)) == 'uustar') ptr(:) = physics%sfcprop%uustar(:) + if (trim(flds(n)) == 'qss' ) ptr(:) = physics%sfcprop%qss(:) + nullify(ptr) + end do + end if + + ! debug + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//' diagnose at '//trim(nexttime_str), ESMF_LOGMSG_INFO) + call fldbun_diagnose(FBout, string=trim(subname)//' CCPP FBout ', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! debug + if (dbug_flag > 5) then + do n = 1,size(flds) + ! retrieve field from FB + call ESMF_FieldBundleGet(FBout, fieldName=trim(flds(n)), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! write field in VTK format + call ESMF_FieldWriteVTK(field, 'rst_'//trim(flds(n))//'_'//trim(is_local%wrap%aoflux_grid)//'_'//trim(nexttime_str), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end if + + !---------------------- + ! Write data + !---------------------- + + call ESMF_FieldBundleWrite(FBout, trim(rst_file), overwrite=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (mastertask) then + write(logunit,'(a)') 'CCPP restart file is closed: '//trim(rst_file) + end if + + end subroutine write_restart + + end module ufs_io_mod