Skip to content

Latent and Sensible Heat flux #2

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
abozec wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Latent and Sensible Heat flux #2

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
30 changes: 15 additions & 15 deletions sorc/geopar.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -102,21 +102,21 @@ subroutine geopar
call zaiord(plon, ip,.false., hmina,hmaxa, 9)
elseif (k.eq.2) then
call zaiord(plat, ip,.false., hmina,hmaxa, 9)
call zaiord(qlon, ip,.false., hmina,hmaxa, 9)
call zaiord(qlat, ip,.false., hmina,hmaxa, 9)
! do i= 1,2 !skip qlon,qlat
! call zagetc(cline,ios, uoff+9)
! if (ios.ne.0) then
! if (mnproc.eq.1) then
! write(lp,'(/ a,i4,i9 /)')
! & 'geopar: I/O error from zagetc, iunit,ios = ',
! & uoff+9,ios
! endif !1st tile
! call xcstop('(geopar)')
! stop '(geopar)'
! endif
! call zaiosk(9)
! enddo
! call zaiord(qlon, ip,.false., hmina,hmaxa, 9)
! call zaiord(qlat, ip,.false., hmina,hmaxa, 9)
do i= 1,2 !skip qlon,qlat
call zagetc(cline,ios, uoff+9)
if (ios.ne.0) then
if (mnproc.eq.1) then
write(lp,'(/ a,i4,i9 /)')
& 'geopar: I/O error from zagetc, iunit,ios = ',
& uoff+9,ios
endif !1st tile
call xcstop('(geopar)')
stop '(geopar)'
endif
call zaiosk(9)
enddo
elseif (k.eq.3) then
call zaiord(ulon, ip,.false., hmina,hmaxa, 9)
elseif (k.eq.4) then
Expand Down
12 changes: 8 additions & 4 deletions sorc/hycom_nuopc.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -138,9 +138,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
! "surface_downward_northward_stress ", & ! from ATM
! "wind_speed_height10m ", & ! from ATM
! "friction_speed ", & ! from ATM
! "mean_down_sw_flx ", & ! from ATM
! "mean_net_sw_flx ", & ! from ATM
! "mean_net_lw_flx ", & ! from ATM
! "mean_down_lw_flx ", & ! from ATM
! "mean_up_lw_flx ", & ! from ATM
! "mean_lat_flx ", & ! from ATM
! "mean_sens_flx ", & ! from ATM
! "inst_temp_height2m ", & ! from ATM
! "mean_prec_rate ", & ! from ATM
! "inst_spec_humid_height2m ", & ! from ATM
Expand Down Expand Up @@ -382,9 +384,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
! "surface_downward_northward_stress ", & ! from ATM
! "wind_speed_height10m ", & ! from ATM
! "friction_speed ", & ! from ATM
! "mean_down_sw_flx ", & ! from ATM
! "mean_net_sw_flx ", & ! from ATM
! "mean_net_lw_flx ", & ! from ATM
! "mean_down_lw_flx ", & ! from ATM
! "mean_up_lw_flx ", & ! from ATM
! "mean_lat_flx ", & ! from ATM
! "mean_sens_flx ", & ! from ATM
! "inst_temp_height2m ", & ! from ATM
! "mean_prec_rate ", & ! from ATM
! "inst_spec_humid_height2m ", & ! from ATM
Expand Down
23 changes: 17 additions & 6 deletions sorc/hycom_nuopc_glue.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -438,7 +438,10 @@ subroutine HYCOM_GlueInitialize(glue, rc)
cpl_airtmp =.false.
cpl_vapmix =.false.
cpl_swflx =.false.
cpl_lwflx =.false.
cpl_lwmupflx =.false.
cpl_lwmdnflx =.false.
cpl_latflx =.false.
cpl_sensflx =.false.
cpl_precip =.false.
cpl_surtmp =.false.
cpl_seatmp =.false.
Expand Down Expand Up @@ -755,17 +758,25 @@ subroutine HYCOM_GlueFieldsDataImport(glue, initFlag, rc)
impPtr2 => imp_ustara
twoLevel = .true.
elseif (fieldStdName == "mean_net_sw_flx") then
cpl_swdnflx = .not.initFlag
cpl_swflx = .not.initFlag
impPtr2 => imp_swflx
twoLevel = .true.
elseif (fieldStdName == "mean_down_lw_flx") then
cpl_swflx = .not.initFlag
cpl_lwdnflx = .not.initFlag
impPtr2 => imp_lwdflx
twoLevel = .true.
elseif (fieldStdName == "mean_up_lw_flx") then
cpl_lwflx = .not.initFlag
cpl_lwmupflx = .not.initFlag
impPtr2 => imp_lwuflx
twoLevel = .true.
elseif (fieldStdName == "mean_lat_flx") then
cpl_latflx = .not.initFlag
impPtr2 => imp_latflx
twoLevel = .true.
elseif (fieldStdName == "mean_sens_flx") then
cpl_sensflx = .not.initFlag
impPtr2 => imp_sensflx
twoLevel = .true.
elseif (fieldStdName == "inst_temp_height2m") then
cpl_airtmp = .not.initFlag
impPtr2 => imp_airtmp
Expand Down Expand Up @@ -839,8 +850,8 @@ subroutine HYCOM_GlueFieldsDataImport(glue, initFlag, rc)
enddo
else
! shift #1 -> #2
do j=lbound(impPtr,2), ubound(impPtr,2)
do i=lbound(impPtr,1), ubound(impPtr,1)
do j=lbound(impPtr2,2), ubound(impPtr2,2)
do i=lbound(impPtr2,1), ubound(impPtr2,1)
impPtr2(i,j,2) = impPtr2(i,j,1)
enddo
enddo
Expand Down
4 changes: 2 additions & 2 deletions sorc/hycom_nuopc_glue_common_blocks.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,8 +29,8 @@ module hycom_nuopc_glue_common_blocks
public cpl_airtmp, imp_airtmp ! air temperature [K]
public cpl_vapmix, imp_vapmix ! specific humidity [kg kg-1]
public cpl_swflx, imp_swflx ! shortwave net flux [W m-2]
public cpl_lwflx, imp_lwdflx ! longwave down flux [W m-2]
public cpl_swdnflx, imp_lwuflx ! longwave up flux [W m-2]
public cpl_lwmdnflx,imp_lwdflx ! longwave down flux [W m-2]
public cpl_lwmupflx,imp_lwuflx ! longwave up flux [W m-2]
public cpl_precip, imp_precip ! precipitation [m s-1]
public cpl_surtmp, imp_surtmp ! air surface temperature [C]
public cpl_seatmp, imp_seatmp ! sea surface temperature [C]
Expand Down
4 changes: 3 additions & 1 deletion sorc/mod_xc.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -96,7 +96,8 @@ module mod_xc
c==> import from atm
real nstep1_cpl,nstep2_cpl
logical cpl_taux, cpl_tauy, cpl_wndspd, cpl_ustara,
& cpl_airtmp, cpl_vapmix, cpl_swflx, cpl_lwdflx, cpl_lwuflx,
& cpl_airtmp, cpl_vapmix, cpl_swflx, cpl_lwmdnflx, cpl_lwmupflx,
& cpl_latflx, cpl_sensflx,
& cpl_precip, cpl_surtmp, cpl_seatmp

real cpl_w2, cpl_w3
Expand All @@ -106,6 +107,7 @@ module mod_xc
real, target, dimension (1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy,2) ::
& imp_taux, imp_tauy, imp_wndspd, imp_ustara,
& imp_airtmp, imp_vapmix, imp_swflx, imp_lwdflx, imp_lwuflx,
& imp_latflx, imp_sensflx
& imp_precip, imp_surtmp, imp_seatmp

c==> import from ice
Expand Down
122 changes: 103 additions & 19 deletions sorc/thermf.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ subroutine thermf_oi(m,n)
do l=1,isp(j)
do i=max(1-margin,ifp(j,l)),min(ii+margin,ilp(j,l))
#ifdef NUOPC
surflx(i,j) = surflx(i,j) + flxice(i,j) !cell average
surflx(i,j) = surflx(i,j) + flxice(i,j) !cell average
sstflx(i,j) = (1.0-covice(i,j))*sstflx(i,j) !relax over ocean
salflx(i,j) = (1.0-covice(i,j))*salflx(i,j) +
& sflice(i,j) + !cell average
Expand Down Expand Up @@ -784,14 +784,13 @@ subroutine thermfj(m,n,dtime, j)
c --- radfl= net radiative thermal flux (W/m^2) +ve into ocean/ice
c --- = Qsw+Qlw across the atmosphere to ocean or sea-ice interface
#ifdef NUOPC
if(cpl_lwflx) then
if(cpl_swfl .and. cpl_lwmdnflx .and. cpl_lwmupflx ) then
radfl= imp_swflx (i,j,1)*cpl_w2+imp_swflx (i,j,2)*cpl_w3
& +imp_lwdflx(i,j,1)*cpl_w2+imp_lwdflx(i,j,2)*cpl_w3
& +imp_lwuflx(i,j,1)*cpl_w2+imp_lwuflx(i,j,2)*cpl_w3

else
radfl=radflx(i,j,l0)*w0+radflx(i,j,l1)*w1
& +radflx(i,j,l2)*w2+radflx(i,j,l3)*w3
& +radflx(i,j,l2)*w2+radflx(i,j,l3)*w3
endif
#else
radfl=radflx(i,j,l0)*w0+radflx(i,j,l1)*w1
Expand Down Expand Up @@ -942,10 +941,10 @@ subroutine thermfj(m,n,dtime, j)
#ifdef NUOPC
if(cpl_ustara) then
ustar(i,j)=imp_ustara(i,j,1)*cpl_w2
& +imp_ustara(i,j,2)*cpl_w3
& +imp_ustara(i,j,2)*cpl_w3
else
ustar(i,j)=ustara(i,j,l0)*w0+ustara(i,j,l1)*w1
& +ustara(i,j,l2)*w2+ustara(i,j,l3)*w3
& +ustara(i,j,l2)*w2+ustara(i,j,l3)*w3
endif
#else
ustar(i,j)=ustara(i,j,l0)*w0+ustara(i,j,l1)*w1
Expand Down Expand Up @@ -988,12 +987,40 @@ subroutine thermfj(m,n,dtime, j)
evape = ctl*airdns*evaplh*wind*
& max(0.,0.97*qsatur(esst)-vpmx)
endif
evap =ctl*airdns*evaplh*wind*
#ifdef NUOPC
c --- Latent Heat flux (W/m2) (from the coupler)
if(cpl_latflx) then
evap=imp_latflx(i,j,1)*cpl_w2+imp_latflx(i,j,2)*cpl_w3
else
evap= ctl*airdns*evaplh*wind*
& max(0.,0.97*qsatur(temp(i,j,1,n))-vpmx)
snsibl=csh*airdns*csubp*wind*(temp(i,j,1,n)-airt)
c --- surflx = thermal energy flux (W/m^2) into ocean
surflx(i,j)=radfl - snsibl - evap
elseif (flxflg.eq.2) then
endif
#else
evap= ctl*airdns*evaplh*wind*
& max(0.,0.97*qsatur(temp(i,j,1,n))-vpmx)
#endif
#ifdef NUOPC
c --- Sensible Heat flux (W/m2) (from the coupler)
if(cpl_sensflx) then
snsibl=imp_sensflx(i,j,1)*cpl_w2+imp_sensflx(i,j,2)*cpl_w3
else
snsibl = csh*airdns*csubp*wind*(temp(i,j,1,n)-airt)
endif
#else
snsibl = csh*airdns*csubp*wind*(temp(i,j,1,n)-airt)
#endif

#ifdef NUOPC
if(cpl_swfl .and. cpl_lwmdnflx .and. cpl_lwmupflx .and.
& cpl_latflx .and. cpl_sensflx ) then
surflx(i,j) = radfl + snsibl + evap
else
surflx(i,j) = radfl - snsibl - evap
endif
#else
surflx(i,j) = radfl - snsibl - evap
#endif
elseif (flxflg.eq.2) then
c
c --- Cl (and Cs) depend on wind speed and Ta-Ts.
c --- Kara, A. B., P. A. Rochford, and H. E. Hurlburt, 2002:
Expand All @@ -1018,10 +1045,38 @@ subroutine thermfj(m,n,dtime, j)
if (empflg.lt.0) then
evape = slat*clh*wind*(0.97*qsatur(esst)-vpmx)
endif
evap = slat*clh*wind*(0.97*qsatur(temp(i,j,1,n))-vpmx)
snsibl = ssen*csh*wind* tdif
surflx(i,j) = radfl - snsibl - evap
c
#ifdef NUOPC
c --- Latent Heat flux (W/m2) (from the coupler)
if(cpl_latflx) then
evap=imp_latflx(i,j,1)*cpl_w2+imp_latflx(i,j,2)*cpl_w3
else
evap= slat*clh*wind*(0.97*qsatur(temp(i,j,1,n))-vpmx)
endif
#else
evap= slat*clh*wind*(0.97*qsatur(temp(i,j,1,n))-vpmx)
#endif
#ifdef NUOPC
c --- Sensible Heat flux (W/m2) (from the coupler)
if(cpl_sensflx) then
snsibl=imp_sensflx(i,j,1)*cpl_w2+imp_sensflx(i,j,2)*cpl_w3
else
snsibl = ssen*csh*wind* tdif
endif
#else
snsibl = ssen*csh*wind* tdif
#endif

#ifdef NUOPC
if(cpl_swfl .and. cpl_lwmdnflx .and. cpl_lwmupflx .and.
& cpl_latflx .and. cpl_sensflx ) then
surflx(i,j) = radfl + snsibl + evap
else
surflx(i,j) = radfl - snsibl - evap
endif
#else
surflx(i,j) = radfl - snsibl - evap
#endif
c
cdiag if (i.eq.itest.and.j.eq.jtest) then
cdiag write(lp,'(i9,2i5,a,4f8.5)')
cdiag. nstep,i0+i,j0+j,' cl0,cl,cs,cd = ',cl0,clh,csh,cd0
Expand Down Expand Up @@ -1110,9 +1165,38 @@ subroutine thermfj(m,n,dtime, j)
if (empflg.lt.0) then
evape = slat*clh*wind*(0.97*qsatur(esst)-vpmx)
endif
evap = slat*clh*wind*(0.97*qsatur(temp(i,j,1,n))-vpmx)
snsibl = ssen*csh*wind* tdif
surflx(i,j) = radfl - snsibl - evap
#ifdef NUOPC
c --- Latent Heat flux (W/m2) (from the coupler)
if(cpl_latflx) then
evap=imp_latflx(i,j,1)*cpl_w2+imp_latflx(i,j,2)*cpl_w3
else
evap= slat*clh*wind*(0.97*qsatur(temp(i,j,1,n))-vpmx)
endif
#else
evap= slat*clh*wind*(0.97*qsatur(temp(i,j,1,n))-vpmx)
#endif
#ifdef NUOPC
c --- Sensible Heat flux (W/m2) (from the coupler)
if(cpl_sensflx) then
snsibl=imp_sensflx(i,j,1)*cpl_w2+imp_sensflx(i,j,2)*cpl_w3
else
snsibl = ssen*csh*wind* tdif
endif
#else
snsibl = ssen*csh*wind* tdif
#endif

#ifdef NUOPC
if(cpl_swfl .and. cpl_lwmdnflx .and. cpl_lwmupflx .and.
& cpl_latflx .and. cpl_sensflx ) then
surflx(i,j) = radfl + snsibl + evap
else
surflx(i,j) = radfl - snsibl - evap
endif
#else
surflx(i,j) = radfl - snsibl - evap
#endif

c
cdiag if (i.eq.itest.and.j.eq.jtest) then
cdiag write(lp,'(i9,2i5,a,3f8.5)')
Expand Down Expand Up @@ -1149,7 +1233,7 @@ subroutine thermfj(m,n,dtime, j)
& temp(i,j,1,n)
else !synoptic sst
#ifdef NUOPC
if(cpl_seatmp .and. sstflg.ne.3) then
if(cpl_seatmp .and. sstflg.ne.1) then
sstdif = ( imp_seatmp(i,j,1)*cpl_w2
& +imp_seatmp(i,j,2)*cpl_w3) -
& temp(i,j,1,n)
Expand Down