Skip to content

Commit

Permalink
Merge pull request #246 from NorESMhub/master
Browse files Browse the repository at this point in the history 
Merging latest master changes into the feature-hamocc_beyond-CMIP6 branch
  • Loading branch information
@jmaerz
jmaerz authored Feb 22, 2023
2 parents 74752f3 + 8c04e63 commit 1a27858
Show file tree
Hide file tree
Showing 19 changed files with 2,139 additions and 917 deletions.
6 changes: 3 additions & 3 deletions .github/workflows/ci.yml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ jobs:
if: runner.os == 'Linux'

- name: Install dependencies - macOS
run: brew install netcdf open-mpi ninja
run: brew install netcdf-fortran open-mpi ninja
env:
HOMEBREW_NO_INSTALL_CLEANUP: 1
if: runner.os == 'macOS'
Expand All @@ -44,8 +44,8 @@ jobs:

- name: Build
env:
CC: gcc-10
FC: gfortran-10
CC: gcc-12
FC: gfortran-12
run: |
meson setup builddir -Dmpi=${{ matrix.mpi }} -Dopenmp=${{ matrix.openmp }} --buildtype=debugoptimized
meson compile -C builddir
Expand Down
121 changes: 92 additions & 29 deletions ben02/thermf_ben02.F
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
! ------------------------------------------------------------------------------
! Copyright (C) 2002-2022 Mats Bentsen, Mehmet Ilicak
! Copyright (C) 2002-2023 Mats Bentsen, Mehmet Ilicak
!
! This file is part of BLOM.
!
Expand Down Expand Up @@ -27,6 +27,7 @@ subroutine thermf_ben02(m,n,mm,nn,k1m,k1n)
. nstep_in_day, baclin,
. xmi, l1mi, l2mi, l3mi, l4mi, l5mi
use mod_xc
use mod_vcoord, only: vcoord_type_tag, isopyc_bulkml
use mod_grid, only: scp2, plat, area
use mod_state, only: dp, temp, saln, p
use mod_swtfrz, only: swtfrz
Expand All @@ -36,7 +37,8 @@ subroutine thermf_ben02(m,n,mm,nn,k1m,k1n)
. trxdpt, srxdpt, trxlim, srxlim, srxbal,
. swa, nsf, hmltfz, lip, sop, eva, rnf, rfi,
. fmltfz, sfl, ustarw, surflx, surrlx,
. sswflx, salflx, brnflx, salrlx, ustar
. sswflx, salflx, brnflx, salrlx, ustar,
. t_rs_nonloc, s_rs_nonloc
use mod_swabs, only: swbgal, swbgfc
use mod_ben02, only: tsi_tda, tml_tda, sml_tda, alb_tda, fice_tda,
. tsi, ntda, dfl, albw, alb,
Expand All @@ -53,7 +55,7 @@ subroutine thermf_ben02(m,n,mm,nn,k1m,k1n)
use mod_tracers, only: ntr, itrtke, itrgls, trc, trflx
# ifdef GLS
use mod_diffusion, only: difdia
use mod_tke, only: gls_cmu0, zos, gls_p, gls_m, gls_n, vonKar
use mod_tke, only: gls_cmu0, Zos, gls_p, gls_m, gls_n, vonKar
# endif
# else
use mod_tracers, only: ntr, trc, trflx
Expand All @@ -66,13 +68,13 @@ subroutine thermf_ben02(m,n,mm,nn,k1m,k1n)
c
real, dimension(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: vrtsfl
c
integer i,j,k,l,m1,m2,m3,m4,m5
integer i,j,k,l,m1,m2,m3,m4,m5,ntld,kn,kl
real dt,cpsw,rnf_fac,sag_fac,y,
. dpotl,hotl,totl,sotl,dpmxl,hmxl,tmxl,smxl,tice_f,hice_min,
. fice,hice,hsnw,tsrf,fice0,hice0,hsnw0,qsww,qnsw,tice,albi,
. tsmlt,albi_h,qswi,dh,qsnwf,fcond,qdamp,qsmlt,qo2i,qbot,swfac,
. dtml,q,volice,df,dvi,dvs,fwflx,sstc,rice,trxflx,sssc,srxflx,
. totsfl,totwfl,sflxc,totsrp,totsrn,A_cgs2mks
. dpotl,hotl,totl,sotl,tice_f,hice_min,fice,hice,hsnw,tsrf,
. fice0,hice0,hsnw0,qsww,qnsw,tice,albi,tsmlt,albi_h,qswi,dh,
. qsnwf,fcond,qdamp,qsmlt,qo2i,qbot,swfac,dtml,q,volice,df,dvi,
. dvs,fwflx,sstc,rice,dpmxl,hmxl,tmxl,trxflx,pbot,dprsi,sssc,
. smxl,srxflx,totsfl,totwfl,sflxc,totsrp,totsrn,A_cgs2mks
#ifdef TRC
integer nt
real, dimension(ntr,1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) ::
Expand Down Expand Up @@ -116,15 +118,16 @@ subroutine thermf_ben02(m,n,mm,nn,k1m,k1n)
m5=mod(m3+ 1,48)+1
c
c --- Time level for diagnosing heat and salt relaxation fluxes
k=m3
ntld=m3
c
if (ditflx.or.disflx) nflxdi(k)=nflxdi(k)+1
if (ditflx.or.disflx) nflxdi(ntld)=nflxdi(ntld)+1
c
c$OMP PARALLEL DO PRIVATE(
c$OMP+ l,i,dpotl,hotl,totl,sotl,dpmxl,hmxl,tmxl,smxl,tice_f,hice_min,
c$OMP+ fice,hice,hsnw,tsrf,fice0,hice0,hsnw0,qsww,qnsw,tice,albi,tsmlt,
c$OMP+ albi_h,qswi,dh,qsnwf,fcond,qdamp,qsmlt,qo2i,qbot,swfac,dtml,q,
c$OMP+ volice,df,dvi,dvs,fwflx,sstc,rice,trxflx,sssc,srxflx
c$OMP+ l,i,dpotl,hotl,totl,sotl,tice_f,hice_min,fice,hice,hsnw,tsrf,
c$OMP+ fice0,hice0,hsnw0,qsww,qnsw,tice,albi,tsmlt,albi_h,qswi,dh,qsnwf,
c$OMP+ fcond,qdamp,qsmlt,qo2i,qbot,swfac,dtml,q,volice,df,dvi,dvs,fwflx,
c$OMP+ sstc,rice,dpmxl,hmxl,tmxl,trxflx,pbot,dprsi,kn,kl,sssc,smxl,
c$OMP+ srxflx
#ifdef TRC
c$OMP+ ,nt
#endif
Expand All @@ -139,13 +142,6 @@ subroutine thermf_ben02(m,n,mm,nn,k1m,k1n)
hotl=dpotl/onem
totl=temp(i,j,k1n)+t0deg
sotl=saln(i,j,k1n)
c
dpmxl=dp(i,j,1+nn)+dp(i,j,2+nn)
hmxl=dpmxl/onem
tmxl=(temp(i,j,1+nn)*dp(i,j,1+nn)
. +temp(i,j,2+nn)*dp(i,j,2+nn))/dpmxl+t0deg
smxl=(saln(i,j,1+nn)*dp(i,j,1+nn)
. +saln(i,j,2+nn)*dp(i,j,2+nn))/dpmxl
c
fice=ficem(i,j)
hice=hicem(i,j)
Expand Down Expand Up @@ -441,7 +437,7 @@ subroutine thermf_ben02(m,n,mm,nn,k1m,k1n)
if (nt.eq.itrgls) then
trflx(nt,i,j)=-gls_n*difdia(i,j,1)*(gls_cmu0**gls_p)
. *(trc(i,j,k1n,itrtke)**gls_m)
. *(vonKar**gls_n)*zos**(gls_n-1.)
. *(vonKar**gls_n)*Zos**(gls_n-1.)
ttrsf(nt,i,j)=0.
ttrav(nt,i,j)=0.
cycle
Expand Down Expand Up @@ -476,8 +472,39 @@ subroutine thermf_ben02(m,n,mm,nn,k1m,k1n)
. ricclm(i,j,l3mi),ricclm(i,j,l4mi),
. ricclm(i,j,l5mi),xmi)
sstc=(1.-rice)*max(sstc,tice_f)+rice*tice_f
trxflx=spcifh*L_mks2cgs*min(hmxl,trxdpt)/(trxday*86400.)
. *min(trxlim,max(-trxlim,sstc-tmxl))/alpha0
if (vcoord_type_tag == isopyc_bulkml) then
dpmxl=dp(i,j,1+nn)+dp(i,j,2+nn)
hmxl=dpmxl/onem
tmxl=(temp(i,j,1+nn)*dp(i,j,1+nn)
. +temp(i,j,2+nn)*dp(i,j,2+nn))/dpmxl+t0deg
trxflx=spcifh*L_mks2cgs*min(hmxl,trxdpt)/(trxday*86400.)
. *min(trxlim,max(-trxlim,sstc-tmxl))/alpha0
else
pbot=p(i,j,1)
do k=1,kk
kn=k+nn
pbot=pbot+dp(i,j,kn)
enddo
dprsi=1./min(trxdpt*onem,pbot-p(i,j,1))
t_rs_nonloc(i,j,1)=1.
tmxl=0.
do k=1,kk
kn=k+nn
t_rs_nonloc(i,j,k+1)=t_rs_nonloc(i,j,k)-dp(i,j,kn)*dprsi
if (t_rs_nonloc(i,j,k+1).lt.0.) then
tmxl=tmxl+temp(i,j,kn)*t_rs_nonloc(i,j,k)+t0deg
exit
else
tmxl=tmxl+temp(i,j,kn)*(t_rs_nonloc(i,j,k )
. -t_rs_nonloc(i,j,k+1))
endif
enddo
do kl=k,kk
t_rs_nonloc(i,j,kl+1)=0.
enddo
trxflx=spcifh*L_mks2cgs*trxdpt/(trxday*86400.)
. *min(trxlim,max(-trxlim,sstc-tmxl))/alpha0
endif
surrlx(i,j)=-trxflx
else
trxflx=0.
Expand All @@ -493,7 +520,7 @@ subroutine thermf_ben02(m,n,mm,nn,k1m,k1n)
c --- --- If ditflx=.true., diagnose relaxation flux by accumulating the
c --- --- relaxation flux
if (ditflx) then
tflxdi(i,j,k)=tflxdi(i,j,k)+trxflx
tflxdi(i,j,ntld)=tflxdi(i,j,ntld)+trxflx
endif
c
salrlx(i,j)=0.
Expand All @@ -503,8 +530,39 @@ subroutine thermf_ben02(m,n,mm,nn,k1m,k1n)
sssc=intp1d(sssclm(i,j,l1mi),sssclm(i,j,l2mi),
. sssclm(i,j,l3mi),sssclm(i,j,l4mi),
. sssclm(i,j,l5mi),xmi)
srxflx=L_mks2cgs*min(hmxl,srxdpt)/(srxday*86400.)
. *min(srxlim,max(-srxlim,sssc-smxl))/alpha0
if (vcoord_type_tag == isopyc_bulkml) then
dpmxl=dp(i,j,1+nn)+dp(i,j,2+nn)
hmxl=dpmxl/onem
smxl=(saln(i,j,1+nn)*dp(i,j,1+nn)
. +saln(i,j,2+nn)*dp(i,j,2+nn))/dpmxl
srxflx=L_mks2cgs*min(hmxl,srxdpt)/(srxday*86400.)
. *min(srxlim,max(-srxlim,sssc-smxl))/alpha0
else
pbot=p(i,j,1)
do k=1,kk
kn=k+nn
pbot=pbot+dp(i,j,kn)
enddo
dprsi=1./min(srxdpt*onem,pbot-p(i,j,1))
s_rs_nonloc(i,j,1)=1.
smxl=0.
do k=1,kk
kn=k+nn
s_rs_nonloc(i,j,k+1)=s_rs_nonloc(i,j,k)-dp(i,j,kn)*dprsi
if (s_rs_nonloc(i,j,k+1).lt.0.) then
smxl=smxl+saln(i,j,kn)*s_rs_nonloc(i,j,k)
exit
else
smxl=smxl+saln(i,j,kn)*(s_rs_nonloc(i,j,k )
. -s_rs_nonloc(i,j,k+1))
endif
enddo
do kl=k,kk
s_rs_nonloc(i,j,kl+1)=0.
enddo
srxflx=L_mks2cgs*srxdpt/(srxday*86400.)
. *min(srxlim,max(-srxlim,sssc-smxl))/alpha0
endif
salrlx(i,j)=-srxflx
util3(i,j)=max(0.,salrlx(i,j))*scp2(i,j)
util4(i,j)=min(0.,salrlx(i,j))*scp2(i,j)
Expand All @@ -522,7 +580,7 @@ subroutine thermf_ben02(m,n,mm,nn,k1m,k1n)
c --- --- If disflx=.true., diagnose relaxation flux by accumulating the
c --- --- relaxation flux
if (disflx) then
sflxdi(i,j,k)=sflxdi(i,j,k)+srxflx
sflxdi(i,j,ntld)=sflxdi(i,j,ntld)+srxflx
endif
c
c --- ------------------------------------------------------------------
Expand Down Expand Up @@ -678,10 +736,15 @@ subroutine thermf_ben02(m,n,mm,nn,k1m,k1n)
call chksummsk(surflx,ip,1,'surflx')
call chksummsk(sswflx,ip,1,'sswflx')
call chksummsk(salflx,ip,1,'salflx')
call chksummsk(brnflx,ip,1,'brnflx')
call chksummsk(surrlx,ip,1,'surrlx')
call chksummsk(salrlx,ip,1,'salrlx')
call chksummsk(iagem,ip,1,'iagem')
call chksummsk(ustar,ip,1,'ustar')
if (vcoord_type_tag /= isopyc_bulkml) then
call chksummsk(t_rs_nonloc, ip, kk+1, 't_rs_nonloc')
call chksummsk(s_rs_nonloc, ip, kk+1, 's_rs_nonloc')
endif
endif
c
return
Expand Down
Loading

0 comments on commit 1a27858

Please sign in to comment.