Skip to content

Commit

Permalink
Merge pull request NOAA-EMC#3 from mvertens/mvertens/nuopc
Browse files Browse the repository at this point in the history 
changes to satisfy ufsatm and cesm requirements for pot temp and density from atm
  • Loading branch information
@dabail10
dabail10 authored May 26, 2020
2 parents 80c9e6e + 53715ea commit 7e43703
Showing 1 changed file with 84 additions and 48 deletions.
132 changes: 84 additions & 48 deletions cicecore/drivers/nuopc/cmeps/ice_import_export.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,6 @@ module ice_import_export
use ESMF
use NUOPC
use NUOPC_Model
#ifdef CESMCOUPLED
use shr_frz_mod , only : shr_frz_freezetemp
#endif
use ice_kinds_mod , only : int_kind, dbl_kind, char_len, log_kind
use ice_constants , only : c0, c1, spval_dbl
use ice_constants , only : field_loc_center, field_type_scalar, field_type_vector
Expand All @@ -19,16 +16,14 @@ module ice_import_export
#if (defined NEWCODE)
use ice_flux , only : fswthruvdr, fswthruvdf, fswthruidr, fswthruidf
use ice_flux , only : send_i2x_per_cat, fswthrun_ai
use ice_flux , only : faero_atm, faero_ocn
use ice_flux , only : fiso_atm, fiso_ocn, fiso_rain, fiso_evap
use ice_flux , only : Qa_iso, Qref_iso, HDO_ocn, H2_18O_ocn, H2_16O_ocn
#endif
use ice_flux , only : fresh, fsalt, zlvl, uatm, vatm, potT, Tair, Qa
use ice_flux , only : rhoa, swvdr, swvdf, swidr, swidf, flw, frain
use ice_flux , only : fsnow, uocn, vocn, sst, ss_tltx, ss_tlty, frzmlt
use ice_flux , only : sss, Tf, wind, fsw
#if (defined NEWCODE)
use ice_flux , only : faero_atm, faero_ocn
use ice_flux , only : fiso_atm, fiso_ocn, fiso_rain, fiso_evap
use ice_flux , only : Qa_iso, Qref_iso, HDO_ocn, H2_18O_ocn, H2_16O_ocn
#endif
use ice_state , only : vice, vsno, aice, aicen_init, trcr
use ice_grid , only : tlon, tlat, tarea, tmask, anglet, hm, ocn_gridcell_frac
use ice_grid , only : grid_type, t2ugrid_vector
Expand All @@ -41,6 +36,7 @@ module ice_import_export
use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags
use icepack_intfc , only : icepack_liquidus_temperature
#ifdef CESMCOUPLED
use shr_frz_mod , only : shr_frz_freezetemp
use perf_mod , only : t_startf, t_stopf, t_barrierf
#endif

Expand Down Expand Up @@ -127,7 +123,6 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam
if (ChkErr(rc,__LINE__,u_FILE_u)) return
read(cvalue,*) flds_wiso
call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO)

#if (defined NEWCODE)
call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
Expand All @@ -149,7 +144,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam
call fldlist_add(fldsToIce_num, fldsToIce, 's_surf' )
call fldlist_add(fldsToIce_num, fldsToIce, 'ocn_current_zonal' )
call fldlist_add(fldsToIce_num, fldsToIce, 'ocn_current_merid' )
call fldlist_add(fldsToIce_num, fldsToIce, 'freezing_melting_potential' )
call fldlist_add(fldsToIce_num, fldsToIce, 'freezing_melting_potential')
if (flds_wiso) then
call fldlist_add(fldsToIce_num, fldsToIce, 'So_roce_wiso', ungridded_lbound=1, ungridded_ubound=3)
end if
Expand All @@ -160,15 +155,16 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam
call fldlist_add(fldsToIce_num, fldsToIce, 'inst_merid_wind_height_lowest' )
call fldlist_add(fldsToIce_num, fldsToIce, 'inst_spec_humid_height_lowest' )
call fldlist_add(fldsToIce_num, fldsToIce, 'inst_temp_height_lowest' )
call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_ptem' )
call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' )
call fldlist_add(fldsToIce_num, fldsToIce, 'inst_pres_height_lowest' )
call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_vis_dir_flx' )
call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_ir_dir_flx' )
call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_vis_dif_flx' )
call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_ir_dif_flx' )
call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_lw_flx' )
call fldlist_add(fldsToIce_num, fldsToIce, 'mean_prec_rate' )
call fldlist_add(fldsToIce_num, fldsToIce, 'mean_fprec_rate' )
call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) !cesm
call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' ) !cesm

#ifdef CESMCOUPLED
! from atm - black carbon deposition fluxes (3)
Expand Down Expand Up @@ -348,7 +344,7 @@ subroutine ice_import( importState, rc )
integer , intent(out) :: rc

! local variables
integer,parameter :: nflds=15
integer,parameter :: nflds=16
integer,parameter :: nfldv=6
integer :: i, j, iblk, n
integer :: ilo, ihi, jlo, jhi !beginning and end of physical domain
Expand All @@ -357,6 +353,7 @@ subroutine ice_import( importState, rc )
real (kind=dbl_kind) :: workx, worky
real (kind=dbl_kind) :: MIN_RAIN_TEMP, MAX_SNOW_TEMP
real (kind=dbl_kind) :: tffresh
real (kind=dbl_kind) :: inst_pres_height_lowest
character(len=*), parameter :: subname = 'ice_import'
!-----------------------------------------------------

Expand Down Expand Up @@ -394,50 +391,56 @@ subroutine ice_import( importState, rc )
call state_getimport(importState, 's_surf', output=aflds, index=2, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

! import ocean states
! import atm states

call state_getimport(importState, 'inst_height_lowest', output=aflds, index=3, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

!tcx errr.... this needs to be fixed in the dictionary!!!
call state_getimport(importState, 'Sa_ptem', output=aflds, index=4, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

call state_getimport(importState, 'inst_temp_height_lowest', output=aflds, index=5, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (State_FldChk(importState, 'Sa_ptem') .and. State_fldchk(importState, 'air_density_height_lowest')) then
call state_getimport(importState, 'Sa_ptem', output=aflds, index=4, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call state_getimport(importState, 'air_density_height_lowest', output=aflds, index=5, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
else if (State_FldChk(importState, 'inst_pres_height_lowest')) then
call state_getimport(importState, 'inst_pres_height_lowest', output=aflds, index=6, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
else
call abort_ice(trim(subname)//&
": ERROR either Sa_ptem and air_density_height_lowest OR inst_pres_height_lowest must be in import state")
end if

call state_getimport(importState, 'inst_spec_humid_height_lowest', output=aflds, index=6, rc=rc)
call state_getimport(importState, 'inst_temp_height_lowest', output=aflds, index=7, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

call state_getimport(importState, 'air_density_height_lowest', output=aflds, index=7, rc=rc)
call state_getimport(importState, 'inst_spec_humid_height_lowest', output=aflds, index=8, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

! import ocn/ice fluxes

call state_getimport(importState, 'freezing_melting_potential', output=aflds, index=8, rc=rc)
call state_getimport(importState, 'freezing_melting_potential', output=aflds, index=9, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

! import atm fluxes

call state_getimport(importState, 'mean_down_sw_vis_dir_flx', output=aflds, index=9, rc=rc)
call state_getimport(importState, 'mean_down_sw_vis_dir_flx', output=aflds, index=10, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

call state_getimport(importState, 'mean_down_sw_ir_dir_flx', output=aflds, index=10, rc=rc)
call state_getimport(importState, 'mean_down_sw_ir_dir_flx', output=aflds, index=11, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

call state_getimport(importState, 'mean_down_sw_vis_dif_flx', output=aflds, index=11, rc=rc)
call state_getimport(importState, 'mean_down_sw_vis_dif_flx', output=aflds, index=12, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

call state_getimport(importState, 'mean_down_sw_ir_dif_flx', output=aflds, index=12, rc=rc)
call state_getimport(importState, 'mean_down_sw_ir_dif_flx', output=aflds, index=13, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

call state_getimport(importState, 'mean_down_lw_flx', output=aflds, index=13, rc=rc)
call state_getimport(importState, 'mean_down_lw_flx', output=aflds, index=14, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

call state_getimport(importState, 'mean_prec_rate', output=aflds, index=14, rc=rc)
call state_getimport(importState, 'mean_prec_rate', output=aflds, index=15, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

call state_getimport(importState, 'mean_fprec_rate', output=aflds, index=15, rc=rc)
call state_getimport(importState, 'mean_fprec_rate', output=aflds, index=16, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

! perform a halo update
Expand All @@ -458,26 +461,59 @@ subroutine ice_import( importState, rc )
do iblk = 1, nblocks
do j = 1,ny_block
do i = 1,nx_block
sst (i,j,iblk) = aflds(i,j, 1,iblk)
sss (i,j,iblk) = aflds(i,j, 2,iblk)
zlvl (i,j,iblk) = aflds(i,j, 3,iblk)
potT (i,j,iblk) = aflds(i,j, 4,iblk)
Tair (i,j,iblk) = aflds(i,j, 5,iblk)
Qa (i,j,iblk) = aflds(i,j, 6,iblk)
rhoa (i,j,iblk) = aflds(i,j, 7,iblk)
frzmlt (i,j,iblk) = aflds(i,j, 8,iblk)
swvdr(i,j,iblk) = aflds(i,j, 9,iblk)
swidr(i,j,iblk) = aflds(i,j,10,iblk)
swvdf(i,j,iblk) = aflds(i,j,11,iblk)
swidf(i,j,iblk) = aflds(i,j,12,iblk)
flw (i,j,iblk) = aflds(i,j,13,iblk)
frain(i,j,iblk) = aflds(i,j,14,iblk)
fsnow(i,j,iblk) = aflds(i,j,15,iblk)
enddo !i
enddo !j
enddo !iblk
sst (i,j,iblk) = aflds(i,j, 1,iblk)
sss (i,j,iblk) = aflds(i,j, 2,iblk)
zlvl (i,j,iblk) = aflds(i,j, 3,iblk)
! see below for 4,5,6
Tair (i,j,iblk) = aflds(i,j, 7,iblk)
Qa (i,j,iblk) = aflds(i,j, 8,iblk)
frzmlt (i,j,iblk) = aflds(i,j, 9,iblk)
swvdr(i,j,iblk) = aflds(i,j,10,iblk)
swidr(i,j,iblk) = aflds(i,j,11,iblk)
swvdf(i,j,iblk) = aflds(i,j,12,iblk)
swidf(i,j,iblk) = aflds(i,j,13,iblk)
flw (i,j,iblk) = aflds(i,j,14,iblk)
frain(i,j,iblk) = aflds(i,j,15,iblk)
fsnow(i,j,iblk) = aflds(i,j,16,iblk)
end do
end do
end do
!$OMP END PARALLEL DO

if ( State_fldChk(importState, 'Sa_ptem') .and. State_fldchk(importState,'air_density_height_lowest')) then
!$OMP PARALLEL DO PRIVATE(iblk,i,j)
do iblk = 1, nblocks
do j = 1,ny_block
do i = 1,nx_block
potT (i,j,iblk) = aflds(i,j, 4,iblk)
rhoa (i,j,iblk) = aflds(i,j, 5,iblk)
end do
end do
end do
!$OMP END PARALLEL DO
else if (State_fldChk(importState, 'inst_pres_height_lowest')) then
!$OMP PARALLEL DO PRIVATE(iblk,i,j)
do iblk = 1, nblocks
do j = 1,ny_block
do i = 1,nx_block
inst_pres_height_lowest = aflds(i,j,6,iblk)
if (inst_pres_height_lowest > 0.0_ESMF_KIND_R8) then
potT (i,j,iblk) = Tair(i,j,iblk) * (100000._ESMF_KIND_R8/inst_pres_height_lowest)**0.286_ESMF_KIND_R8
else
potT (i,j,iblk) = 0.0_ESMF_KIND_R8
end if
if (Tair(i,j,iblk) /= 0._ESMF_KIND_R8) then
rhoa(i,j,iblk) = inst_pres_height_lowest / &
(287.058_ESMF_KIND_R8*(1._ESMF_KIND_R8+0.608_ESMF_KIND_R8*Qa(i,j,iblk))*Tair(i,j,iblk))
else
rhoa(i,j,iblk) = 0._ESMF_KIND_R8
endif
end do !i
end do !j
end do !iblk
!$OMP END PARALLEL DO
end if

deallocate(aflds)
allocate(aflds(nx_block,ny_block,nfldv,nblocks))
aflds = c0
Expand Down

0 comments on commit 7e43703

Please sign in to comment.