Commit c15834a7 authored by MEURDESOIF Yann's avatar MEURDESOIF Yann
Browse files

Improve nudging management

YM
parent 4b4bf5b7
Pipeline #144246 failed with stages
in 2 minutes and 20 seconds
......@@ -27,31 +27,31 @@ MODULE nudging_mod
INTEGER :: last_itau=-1
!$OMP THREADPRIVATE(last_itau)
LOGICAL :: guide_T=.TRUE.
!$OMP THREADPRIVATE(guide_Temp)
LOGICAL :: guide_U=.TRUE.
!$OMP THREADPRIVATE(guide_U)
LOGICAL :: guide_PS=.TRUE.
LOGICAL :: guide_T=.FALSE.
!$OMP THREADPRIVATE(guide_T)
LOGICAL :: guide_U=.FALSE.
!$OMP THREADPRIVATE(guide_U)
LOGICAL :: guide_PS=.FALSE.
!$OMP THREADPRIVATE(guide_PS)
LOGICAL :: guide_Q=.TRUE.
LOGICAL :: guide_Q=.FALSE.
!$OMP THREADPRIVATE(guide_Q)
REAL(rstd) :: temp_tau_in
!$OMP THREADPRIVATE(temp_tau_in)
REAL(rstd) :: temp_tau_out
!$OMP THREADPRIVATE(temp_tau_out)
REAL(rstd) :: u_tau_in
!$OMP THREADPRIVATE(u_tau_in)
REAL(rstd) :: u_tau_out
!$OMP THREADPRIVATE(u_tau_out)
REAL(rstd) :: ps_tau_in
!$OMP THREADPRIVATE(ps_tau_in)
REAL(rstd) :: ps_tau_out
!$OMP THREADPRIVATE(ps_tau_out)
REAL(rstd) :: q_tau_in
!$OMP THREADPRIVATE(q_tau_in)
REAL(rstd) :: q_tau_out
!$OMP THREADPRIVATE(q_tau_out)
REAL(rstd) :: T_relax_in
!$OMP THREADPRIVATE(T_relax_in)
REAL(rstd) :: T_relax_out
!$OMP THREADPRIVATE(T_relax_out)
REAL(rstd) :: u_relax_in
!$OMP THREADPRIVATE(u_relax_in)
REAL(rstd) :: u_relax_out
!$OMP THREADPRIVATE(u_relax_out)
REAL(rstd) :: ps_relax_in
!$OMP THREADPRIVATE(ps_relax_in)
REAL(rstd) :: ps_relax_out
!$OMP THREADPRIVATE(ps_relax_out)
REAL(rstd) :: q_relax_in
!$OMP THREADPRIVATE(q_relax_in)
REAL(rstd) :: q_relax_out
!$OMP THREADPRIVATE(q_relax_out)
......@@ -97,53 +97,53 @@ CONTAINS
CALL allocate_time_field(tf_q, field_T, type_real, llm, nqtot, name='q_nudged')
CALL allocate_time_field(tf_theta_rhodz, field_T, type_real, llm, 1, name='theta_rhodz_nudged')
CALL getin("guide_Tt",guide_Temp)
temp_tau_in=-1
temp_tau_out=dt
CALL getin("temp_tau_in",temp_tau_in)
CALL getin("temp_tau_out",temp_tau_out)
IF (temp_tau_in==-1) THEN
temp_tau_in=0
CALL getin("guide_T",guide_T)
T_relax_in=-1
T_relax_out=dt
CALL getin("T_relax_in",T_relax_in)
CALL getin("T_relax_out",T_relax_out)
IF (T_relax_in==-1) THEN
T_relax_in=0
ELSE
temp_tau_in = dt/temp_tau_in
T_relax_in = dt/T_relax_in
ENDIF
temp_tau_out = dt/temp_tau_out
CALL getin("guide_ps",guide_ps)
ps_tau_in=-1
ps_tau_out=dt
CALL getin("ps_tau_in",ps_tau_in)
CALL getin("ps_tau_out",ps_tau_out)
IF (ps_tau_in==-1) THEN
ps_tau_in=0
T_relax_out = dt/T_relax_out
CALL getin("guide_PS",guide_ps)
ps_relax_in=-1
ps_relax_out=dt
CALL getin("PS_relax_in",ps_relax_in)
CALL getin("PS_relax_out",ps_relax_out)
IF (ps_relax_in==-1) THEN
ps_relax_in=0
ELSE
ps_tau_in = dt/ps_tau_in
ps_relax_in = dt/ps_relax_in
ENDIF
ps_tau_out = dt/ps_tau_out
CALL getin("guide_u",guide_u)
u_tau_in=-1
u_tau_out=dt
CALL getin("u_tau_in",u_tau_in)
CALL getin("u_tau_out",u_tau_out)
IF (u_tau_in==-1) THEN
u_tau_in=0
ps_relax_out = dt/ps_relax_out
CALL getin("guide_U",guide_u)
u_relax_in=-1
u_relax_out=dt
CALL getin("U_relax_in",u_relax_in)
CALL getin("U_relax_out",u_relax_out)
IF (u_relax_in==-1) THEN
u_relax_in=0
ELSE
u_tau_in = dt/u_tau_in
u_relax_in = dt/u_relax_in
ENDIF
u_tau_out = dt/u_tau_out
CALL getin("guide_Temp",guide_q)
q_tau_in=-1
q_tau_out=dt
CALL getin("q_tau_in",q_tau_in)
CALL getin("q_tau_out",q_tau_out)
IF (q_tau_in==-1) THEN
q_tau_in=0
u_relax_out = dt/u_relax_out
CALL getin("guide_Q",guide_q)
q_relax_in=-1
q_relax_out=dt
CALL getin("Q_relax_in",q_relax_in)
CALL getin("Q_relax_out",q_relax_out)
IF (q_relax_in==-1) THEN
q_relax_in=0
ELSE
q_tau_in = dt/q_tau_in
q_relax_in = dt/q_relax_in
ENDIF
q_tau_out = dt/q_tau_out
q_relax_out = dt/q_relax_out
SELECT CASE(nudging_zone)
......@@ -517,6 +517,11 @@ CONTAINS
REAL(rstd) :: coeff
INTEGER :: ind, i, j, k, ij,n
guide_T=.TRUE.
guide_U=.TRUE.
guide_PS=.TRUE.
guide_Q=.TRUE.
stiffness = 8
CALL getin("nudging_stiffness", stiffness)
......@@ -686,35 +691,41 @@ CONTAINS
CALL output_field("coeff_nudging",f_coeff_i)
CALL update_time_interpolation(time, interp)
CALL read_time_field(interp, tf_ps)
CALL read_time_field(interp, tf_ulon)
CALL read_time_field(interp, tf_ulat)
CALL read_time_field(interp, tf_q)
CALL read_time_field(interp, tf_temp)
IF (guide_PS) CALL read_time_field(interp, tf_ps)
IF (guide_U) CALL read_time_field(interp, tf_ulon)
IF (guide_U) CALL read_time_field(interp, tf_ulat)
IF (guide_Q) CALL read_time_field(interp, tf_q)
IF (guide_T) CALL read_time_field(interp, tf_temp)
IF(interp%read_t0) THEN
CALL ulonlat2un(tf_ulon%f_t0, tf_ulat%f_t0, tf_u%f_t0)
CALL transfert_request(tf_u%f_t0,req_e1_vect)
CALL temperature2theta_rhodz(tf_ps%f_t0, tf_temp%f_t0, tf_theta_rhodz%f_t0)
IF (guide_U) THEN
CALL ulonlat2un(tf_ulon%f_t0, tf_ulat%f_t0, tf_u%f_t0)
CALL transfert_request(tf_u%f_t0,req_e1_vect)
ENDIF
IF (guide_T) CALL temperature2theta_rhodz(tf_ps%f_t0, tf_temp%f_t0, tf_theta_rhodz%f_t0)
ENDIF
IF(interp%swap) THEN
CALL swap_time_field(tf_u)
CALL swap_time_field(tf_theta_rhodz)
IF (guide_U) CALL swap_time_field(tf_u)
IF (guide_T) CALL swap_time_field(tf_theta_rhodz)
ENDIF
IF(interp%read_t1) THEN
CALL ulonlat2un(tf_ulon%f_t1, tf_ulat%f_t1, tf_u%f_t1)
CALL transfert_request(tf_u%f_t1,req_e1_vect)
CALL temperature2theta_rhodz(tf_ps%f_t1, tf_temp%f_t1, tf_theta_rhodz%f_t1)
IF (guide_U) THEN
CALL ulonlat2un(tf_ulon%f_t1, tf_ulat%f_t1, tf_u%f_t1)
CALL transfert_request(tf_u%f_t1,req_e1_vect)
ENDIF
IF (guide_T) CALL temperature2theta_rhodz(tf_ps%f_t1, tf_temp%f_t1, tf_theta_rhodz%f_t1)
ENDIF
! interpolate in time only those fields that we nudge to
CALL interpolate_time_field(interp, tf_ps)
CALL interpolate_time_field(interp, tf_u)
CALL interpolate_time_field(interp, tf_q)
CALL interpolate_time_field(interp, tf_theta_rhodz)
IF (guide_PS) CALL interpolate_time_field(interp, tf_ps)
IF (guide_U) CALL interpolate_time_field(interp, tf_u)
IF (guide_Q) CALL interpolate_time_field(interp, tf_q)
IF (guide_T) CALL interpolate_time_field(interp, tf_theta_rhodz)
last_itau=itau
ENDIF
......@@ -876,18 +887,18 @@ CONTAINS
ENDDO
!$OMP BARRIER
IF(caldyn_eta==eta_mass) THEN
!ym flush ps
!$OMP BARRIER
DO ind=1,ndomain
IF (.NOT. assigned_domain(ind)) CYCLE
CALL swap_dimensions(ind)
CALL swap_geometry(ind)
mass=f_mass(ind); ps=f_ps(ind);
CALL compute_rhodz(.TRUE., ps, mass, ondevice=.TRUE.)
END DO
ENDIF
IF (guide_PS) THEN
IF(caldyn_eta==eta_mass) THEN
DO ind=1,ndomain
IF (.NOT. assigned_domain(ind)) CYCLE
CALL swap_dimensions(ind)
CALL swap_geometry(ind)
mass=f_mass(ind); ps=f_ps(ind);
CALL compute_rhodz(.TRUE., ps, mass, ondevice=.TRUE.)
END DO
ENDIF
!$OMP BARRIER
ENDIF
END SUBROUTINE guided
......@@ -909,77 +920,86 @@ CONTAINS
INTEGER :: ij, l, nq
REAL(rstd) :: delta, coeffmin,coeff
delta=(ps_tau_out-ps_tau_in)
coeffmin=ps_tau_in
delta=(ps_relax_out-ps_relax_in)
coeffmin=ps_relax_in
IF (is_omp_first_level) THEN
DO ij=ij_begin,ij_end
coeff=coeff_i(ij)*delta+coeffmin
IF (coeff> 1-1e-6) THEN
ps(ij) = ps_in(ij)
ELSE
ps(ij) = ps_in(ij) * coeff + ps(ij) * (1-coeff)
ENDIF
ENDDO
IF (guide_PS) THEN
IF (is_omp_first_level) THEN
DO ij=ij_begin,ij_end
coeff=coeff_i(ij)*delta+coeffmin
IF (coeff> 1-1e-6) THEN
ps(ij) = ps_in(ij)
ELSE
ps(ij) = ps_in(ij) * coeff + ps(ij) * (1-coeff)
ENDIF
ENDDO
ENDIF
ENDIF
delta=(u_tau_out-u_tau_in)
coeffmin=u_tau_in
DO l=ll_begin,ll_end
DO ij=ij_begin,ij_end
coeff=coeff_e(ij+u_right)*delta+coeffmin
IF (coeff>1-1e-6) THEN
u(ij+u_right,l) = u_in(ij+u_right,l)
ELSE
u(ij+u_right,l) = u_in(ij+u_right,l) * coeff + u(ij+u_right,l) * (1-coeff)
ENDIF
IF (guide_U) THEN
delta=(u_relax_out-u_relax_in)
coeffmin=u_relax_in
DO l=ll_begin,ll_end
DO ij=ij_begin,ij_end
coeff=coeff_e(ij+u_right)*delta+coeffmin
IF (coeff>1-1e-6) THEN
u(ij+u_right,l) = u_in(ij+u_right,l)
ELSE
u(ij+u_right,l) = u_in(ij+u_right,l) * coeff + u(ij+u_right,l) * (1-coeff)
ENDIF
coeff=coeff_e(ij+u_lup)*delta+coeffmin
IF (coeff>1-1e-6) THEN
u(ij+u_lup,l) = u_in(ij+u_lup,l)
ELSE
u(ij+u_lup,l) = u_in(ij+u_lup,l) * coeff + u(ij+u_lup,l) * (1-coeff)
ENDIF
coeff=coeff_e(ij+u_lup)*delta+coeffmin
IF (coeff>1-1e-6) THEN
u(ij+u_lup,l) = u_in(ij+u_lup,l)
ELSE
u(ij+u_lup,l) = u_in(ij+u_lup,l) * coeff + u(ij+u_lup,l) * (1-coeff)
ENDIF
coeff=coeff_e(ij+u_ldown)*delta+coeffmin
IF (coeff >1-1e-6) THEN
u(ij+u_ldown,l) = u_in(ij+u_ldown,l)
ELSE
u(ij+u_ldown,l) = u_in(ij+u_ldown,l) * coeff + u(ij+u_ldown,l) * (1-coeff)
ENDIF
coeff=coeff_e(ij+u_ldown)*delta+coeffmin
IF (coeff >1-1e-6) THEN
u(ij+u_ldown,l) = u_in(ij+u_ldown,l)
ELSE
u(ij+u_ldown,l) = u_in(ij+u_ldown,l) * coeff + u(ij+u_ldown,l) * (1-coeff)
ENDIF
ENDDO
ENDDO
ENDDO
ENDIF
delta=(temp_tau_out-temp_tau_in)
coeffmin=temp_tau_in
IF (guide_T) THEN
delta=(T_relax_out-T_relax_in)
coeffmin=T_relax_in
DO l=ll_begin,ll_end
DO ij=ij_begin,ij_end
coeff=coeff_i(ij)*delta+coeffmin
IF (coeff>1-1e-6) THEN
theta_rhodz(ij,l) = theta_rhodz_in(ij,l)
ELSE
theta_rhodz(ij,l) = theta_rhodz_in(ij,l) * coeff + theta_rhodz(ij,l) * (1-coeff)
ENDIF
ENDDO
ENDDO
delta=(q_tau_out-q_tau_in)
coeffmin=q_tau_in
DO l=ll_begin,ll_end
DO ij=ij_begin,ij_end
coeff=coeff_i(ij)*delta+coeffmin
IF (coeff>1-1e-6) THEN
theta_rhodz(ij,l) = theta_rhodz_in(ij,l)
ELSE
theta_rhodz(ij,l) = theta_rhodz_in(ij,l) * coeff + theta_rhodz(ij,l) * (1-coeff)
ENDIF
ENDDO
ENDDO
ENDIF
DO nq=1,nqtot
DO l=ll_begin,ll_end
DO ij=ij_begin,ij_end
coeff=coeff_i(ij)*delta+coeffmin
IF (coeff>1-1e-6) THEN
q(ij,l,nq) = q_in(ij,l,nq)
ELSE
q(ij,l,nq) = q_in(ij,l,nq) * coeff + q(ij,l,nq) * (1-coeff)
ENDIF
ENDDO
ENDDO
ENDDO
IF (guide_Q) THEN
delta=(q_relax_out-q_relax_in)
coeffmin=q_relax_in
DO nq=1,nqtot
DO l=ll_begin,ll_end
DO ij=ij_begin,ij_end
coeff=coeff_i(ij)*delta+coeffmin
IF (coeff>1-1e-6) THEN
q(ij,l,nq) = q_in(ij,l,nq)
ELSE
q(ij,l,nq) = q_in(ij,l,nq) * coeff + q(ij,l,nq) * (1-coeff)
ENDIF
ENDDO
ENDDO
ENDDO
ENDIF
END SUBROUTINE compute_nudging
END MODULE nudging_mod
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment