Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • nemo/nemo
  • sparonuz/nemo
  • hatfield/nemo
  • extdevs/nemo
4 results
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 649 additions and 522 deletions
src/ICE/icestp.F90
View file @ 4dbfc9bb
...@@ -77,6 +77,7 @@ MODULE icestp ...@@ -77,6 +77,7 @@ MODULE icestp
USE lib_fortran ! fortran utilities (glob_sum + no signed zero) USE lib_fortran ! fortran utilities (glob_sum + no signed zero)
USE timing ! Timing USE timing ! Timing
USE prtctl ! Print control USE prtctl ! Print control
USE lbclnk ! lateral boundary conditions (or mpp links)
IMPLICIT NONE IMPLICIT NONE
PRIVATE PRIVATE
...@@ -109,7 +110,7 @@ CONTAINS ...@@ -109,7 +110,7 @@ CONTAINS
!! - save the outputs !! - save the outputs
!! - save the outputs for restart when necessary !! - save the outputs for restart when necessary
!! !!
!! ** Action : - time evolution of the LIM sea-ice model !! ** Action : - time evolution of the SI3 sea-ice model
!! - update all sbc variables below sea-ice: !! - update all sbc variables below sea-ice:
!! utau, vtau, taum, wndm, qns , qsr, emp , sfx !! utau, vtau, taum, wndm, qns , qsr, emp , sfx
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
...@@ -117,7 +118,7 @@ CONTAINS ...@@ -117,7 +118,7 @@ CONTAINS
INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices
INTEGER, INTENT(in) :: ksbc ! flux formulation (user defined, bulk, or Pure Coupled) INTEGER, INTENT(in) :: ksbc ! flux formulation (user defined, bulk, or Pure Coupled)
! !
INTEGER :: jl ! dummy loop index INTEGER :: ji, jj, jl ! dummy loop index
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
IF( ln_timing ) CALL timing_start('icestp') IF( ln_timing ) CALL timing_start('icestp')
...@@ -128,9 +129,12 @@ CONTAINS ...@@ -128,9 +129,12 @@ CONTAINS
! !
kt_ice = kt ! -- Ice model time step kt_ice = kt ! -- Ice model time step
! !
u_oce(:,:) = ssu_m(:,:) ! -- mean surface ocean current DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! -- mean surface ocean current
v_oce(:,:) = ssv_m(:,:) u_oce(ji,jj) = ssu_m(ji,jj)
v_oce(ji,jj) = ssv_m(ji,jj)
END_2D
! !
! clem: I think t_bo needs to be defined everywhere but check
CALL eos_fzp( sss_m(:,:) , t_bo(:,:) ) ! -- freezing temperature [Kelvin] (set to rt0 over land) CALL eos_fzp( sss_m(:,:) , t_bo(:,:) ) ! -- freezing temperature [Kelvin] (set to rt0 over land)
t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) )
! !
...@@ -152,6 +156,7 @@ CONTAINS ...@@ -152,6 +156,7 @@ CONTAINS
! utau_ice, vtau_ice = surface ice stress [N/m2] ! utau_ice, vtau_ice = surface ice stress [N/m2]
!------------------------------------------------! !------------------------------------------------!
CALL ice_sbc_tau( kt, ksbc, utau_ice, vtau_ice ) CALL ice_sbc_tau( kt, ksbc, utau_ice, vtau_ice )
! => clem: here utau_ice and vtau_ice are defined everywhere
!-------------------------------------! !-------------------------------------!
! --- ice dynamics and advection --- ! ! --- ice dynamics and advection --- !
!-------------------------------------! !-------------------------------------!
...@@ -161,6 +166,11 @@ CONTAINS ...@@ -161,6 +166,11 @@ CONTAINS
IF( ln_icedyn .AND. .NOT.ln_c1d ) & IF( ln_icedyn .AND. .NOT.ln_c1d ) &
& CALL ice_dyn( kt, Kmm ) ! -- Ice dynamics & CALL ice_dyn( kt, Kmm ) ! -- Ice dynamics
! !
! ==> clem: here, all the global variables are correctly defined in the halos:
! ato_i, a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, v_il, e_i, e_s
! as well as h_i and t_su for practical reasons
! It may not be necessary. If it is not, then remove lbc_lnk in icedyn_rdgrft and iceitd_reb
CALL diag_trends( 1 ) ! record dyn trends CALL diag_trends( 1 ) ! record dyn trends
! !
! !== lateral boundary conditions ==! ! !== lateral boundary conditions ==!
...@@ -170,7 +180,8 @@ CONTAINS ...@@ -170,7 +180,8 @@ CONTAINS
CALL ice_var_glo2eqv ! h_i and h_s for ice albedo calculation CALL ice_var_glo2eqv ! h_i and h_s for ice albedo calculation
CALL ice_var_agg(1) ! at_i for coupling CALL ice_var_agg(1) ! at_i for coupling
CALL store_fields ! Store now ice values CALL store_fields ! Store now ice values
! ! ==> clem: here, full arrays = vt_i, vt_s, vt_ip, vt_il, at_i, at_ip, ato_i
! reduced arrays = st_i, et_i, et_s, tm_su
!------------------------------------------------------! !------------------------------------------------------!
! --- Thermodynamical coupling with the atmosphere --- ! ! --- Thermodynamical coupling with the atmosphere --- !
!------------------------------------------------------! !------------------------------------------------------!
...@@ -184,11 +195,15 @@ CONTAINS ...@@ -184,11 +195,15 @@ CONTAINS
! qemp_oce, qemp_ice, = sensible heat (associated with evap & precip) [W/m2] ! qemp_oce, qemp_ice, = sensible heat (associated with evap & precip) [W/m2]
! qprec_ice, qevap_ice ! qprec_ice, qevap_ice
!------------------------------------------------------! !------------------------------------------------------!
! ==> clem: From here on, we only need to work on the interior domain
! though it necessitates a large lbc at the end of the time step
CALL ice_sbc_flx( kt, ksbc ) CALL ice_sbc_flx( kt, ksbc )
!----------------------------! !----------------------------!
! --- ice thermodynamics --- ! ! --- ice thermodynamics --- !
!----------------------------! !----------------------------!
IF( ln_icethd ) CALL ice_thd( kt ) ! -- Ice thermodynamics IF( ln_icethd ) CALL ice_thd( kt ) ! -- Ice thermodynamics
!
! ==> clem: here, all the global variables are correctly defined in the halos
! !
CALL diag_trends( 2 ) ! record thermo trends CALL diag_trends( 2 ) ! record thermo trends
CALL ice_var_glo2eqv ! necessary calls (at least for coupling) CALL ice_var_glo2eqv ! necessary calls (at least for coupling)
...@@ -288,7 +303,7 @@ CONTAINS ...@@ -288,7 +303,7 @@ CONTAINS
CALL ice_drift_init ! initialization for diags of conservation CALL ice_drift_init ! initialization for diags of conservation
! !
fr_i (:,:) = at_i(:,:) ! initialisation of sea-ice fraction fr_i (:,:) = at_i(:,:) ! initialisation of sea-ice fraction
tn_ice(:,:,:) = t_su(:,:,:) ! initialisation of surface temp for coupled simu tn_ice(:,:,:) = t_su(A2D(0),:) ! initialisation of surface temp for coupled simu
! !
IF( ln_rstart ) THEN IF( ln_rstart ) THEN
CALL iom_close( numrir ) ! close input ice restart file CALL iom_close( numrir ) ! close input ice restart file
...@@ -369,26 +384,33 @@ CONTAINS ...@@ -369,26 +384,33 @@ CONTAINS
INTEGER :: ji, jj, jl ! dummy loop index INTEGER :: ji, jj, jl ! dummy loop index
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
a_i_b (:,:,:) = a_i (:,:,:) ! ice area DO jl = 1, jpl
v_i_b (:,:,:) = v_i (:,:,:) ! ice volume DO_2D( 0, 0, 0, 0 )
v_s_b (:,:,:) = v_s (:,:,:) ! snow volume a_i_b (ji,jj,jl) = a_i (ji,jj,jl) ! ice area
v_ip_b(:,:,:) = v_ip(:,:,:) ! pond volume v_i_b (ji,jj,jl) = v_i (ji,jj,jl) ! ice volume
v_il_b(:,:,:) = v_il(:,:,:) ! pond lid volume v_s_b (ji,jj,jl) = v_s (ji,jj,jl) ! snow volume
sv_i_b(:,:,:) = sv_i(:,:,:) ! salt content v_ip_b(ji,jj,jl) = v_ip(ji,jj,jl) ! pond volume
e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy v_il_b(ji,jj,jl) = v_il(ji,jj,jl) ! pond lid volume
e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy sv_i_b(ji,jj,jl) = sv_i(ji,jj,jl) ! salt content
WHERE( a_i_b(:,:,:) >= epsi20 ) IF( a_i_b(ji,jj,jl) >= epsi20 ) THEN
h_i_b(:,:,:) = v_i_b(:,:,:) / a_i_b(:,:,:) ! ice thickness h_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / a_i_b(ji,jj,jl) ! ice thickness
h_s_b(:,:,:) = v_s_b(:,:,:) / a_i_b(:,:,:) ! snw thickness h_s_b(ji,jj,jl) = v_s_b(ji,jj,jl) / a_i_b(ji,jj,jl) ! snw thickness
ELSEWHERE ELSE
h_i_b(:,:,:) = 0._wp h_i_b(ji,jj,jl) = 0._wp
h_s_b(:,:,:) = 0._wp h_s_b(ji,jj,jl) = 0._wp
END WHERE ENDIF
! e_s_b (ji,jj,:,jl) = e_s (ji,jj,:,jl) ! snow thermal energy
! ice velocities & total concentration e_i_b (ji,jj,:,jl) = e_i (ji,jj,:,jl) ! ice thermal energy
END_2D
ENDDO
! total concentration
at_i_b(:,:) = SUM( a_i_b(:,:,:), dim=3 ) at_i_b(:,:) = SUM( a_i_b(:,:,:), dim=3 )
u_ice_b(:,:) = u_ice(:,:)
v_ice_b(:,:) = v_ice(:,:) ! ice velocity
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
u_ice_b(ji,jj) = u_ice(ji,jj)
v_ice_b(ji,jj) = v_ice(ji,jj)
END_2D
! !
END SUBROUTINE store_fields END SUBROUTINE store_fields
...@@ -402,20 +424,23 @@ CONTAINS ...@@ -402,20 +424,23 @@ CONTAINS
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER :: ji, jj, jl ! dummy loop index INTEGER :: ji, jj, jl ! dummy loop index
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
sfx_res(ji,jj) = 0._wp ; wfx_res(ji,jj) = 0._wp ; hfx_res(ji,jj) = 0._wp
END_2D
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! needed for (at least) diag_adv_mass -> to be removed DO_2D( 0, 0, 0, 0 )
sfx (ji,jj) = 0._wp ; sfx (ji,jj) = 0._wp ;
sfx_bri(ji,jj) = 0._wp ; sfx_lam(ji,jj) = 0._wp sfx_bri(ji,jj) = 0._wp ; sfx_lam(ji,jj) = 0._wp
sfx_sni(ji,jj) = 0._wp ; sfx_opw(ji,jj) = 0._wp sfx_sni(ji,jj) = 0._wp ; sfx_opw(ji,jj) = 0._wp
sfx_bog(ji,jj) = 0._wp ; sfx_dyn(ji,jj) = 0._wp sfx_bog(ji,jj) = 0._wp ; sfx_dyn(ji,jj) = 0._wp
sfx_bom(ji,jj) = 0._wp ; sfx_sum(ji,jj) = 0._wp sfx_bom(ji,jj) = 0._wp ; sfx_sum(ji,jj) = 0._wp
sfx_res(ji,jj) = 0._wp ; sfx_sub(ji,jj) = 0._wp sfx_sub(ji,jj) = 0._wp
! !
wfx_snw(ji,jj) = 0._wp ; wfx_ice(ji,jj) = 0._wp wfx_snw(ji,jj) = 0._wp ; wfx_ice(ji,jj) = 0._wp
wfx_sni(ji,jj) = 0._wp ; wfx_opw(ji,jj) = 0._wp wfx_sni(ji,jj) = 0._wp ; wfx_opw(ji,jj) = 0._wp
wfx_bog(ji,jj) = 0._wp ; wfx_dyn(ji,jj) = 0._wp wfx_bog(ji,jj) = 0._wp ; wfx_dyn(ji,jj) = 0._wp
wfx_bom(ji,jj) = 0._wp ; wfx_sum(ji,jj) = 0._wp wfx_bom(ji,jj) = 0._wp ; wfx_sum(ji,jj) = 0._wp
wfx_res(ji,jj) = 0._wp ; wfx_sub(ji,jj) = 0._wp wfx_sub(ji,jj) = 0._wp
wfx_spr(ji,jj) = 0._wp ; wfx_lam(ji,jj) = 0._wp wfx_spr(ji,jj) = 0._wp ; wfx_lam(ji,jj) = 0._wp
wfx_snw_dyn(ji,jj) = 0._wp ; wfx_snw_sum(ji,jj) = 0._wp wfx_snw_dyn(ji,jj) = 0._wp ; wfx_snw_sum(ji,jj) = 0._wp
wfx_snw_sub(ji,jj) = 0._wp ; wfx_ice_sub(ji,jj) = 0._wp wfx_snw_sub(ji,jj) = 0._wp ; wfx_ice_sub(ji,jj) = 0._wp
...@@ -426,7 +451,7 @@ CONTAINS ...@@ -426,7 +451,7 @@ CONTAINS
hfx_snw(ji,jj) = 0._wp ; hfx_opw(ji,jj) = 0._wp hfx_snw(ji,jj) = 0._wp ; hfx_opw(ji,jj) = 0._wp
hfx_bog(ji,jj) = 0._wp ; hfx_dyn(ji,jj) = 0._wp hfx_bog(ji,jj) = 0._wp ; hfx_dyn(ji,jj) = 0._wp
hfx_bom(ji,jj) = 0._wp ; hfx_sum(ji,jj) = 0._wp hfx_bom(ji,jj) = 0._wp ; hfx_sum(ji,jj) = 0._wp
hfx_res(ji,jj) = 0._wp ; hfx_sub(ji,jj) = 0._wp hfx_sub(ji,jj) = 0._wp
hfx_spr(ji,jj) = 0._wp ; hfx_dif(ji,jj) = 0._wp hfx_spr(ji,jj) = 0._wp ; hfx_dif(ji,jj) = 0._wp
hfx_err_dif(ji,jj) = 0._wp hfx_err_dif(ji,jj) = 0._wp
wfx_err_sub(ji,jj) = 0._wp wfx_err_sub(ji,jj) = 0._wp
...@@ -451,7 +476,7 @@ CONTAINS ...@@ -451,7 +476,7 @@ CONTAINS
END_2D END_2D
DO jl = 1, jpl DO jl = 1, jpl
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! SIMIP diagnostics ! SIMIP diagnostics
t_si (ji,jj,jl) = rt0 ! temp at the ice-snow interface t_si (ji,jj,jl) = rt0 ! temp at the ice-snow interface
qcn_ice_bot(ji,jj,jl) = 0._wp qcn_ice_bot(ji,jj,jl) = 0._wp
...@@ -477,22 +502,25 @@ CONTAINS ...@@ -477,22 +502,25 @@ CONTAINS
!! and outputs !! and outputs
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kn ! 1 = after dyn ; 2 = after thermo INTEGER, INTENT(in) :: kn ! 1 = after dyn ; 2 = after thermo
!!---------------------------------------------------------------------- INTEGER :: ji, jj, jl ! dummy loop index
!!----------------------------------------------------------------------
! !
! --- trends of heat, salt, mass (used for conservation controls) ! --- trends of heat, salt, mass (used for conservation controls)
IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN
! !
diag_heat(:,:) = diag_heat(:,:) & DO_2D( 0, 0, 0, 0 )
& - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_Dt_ice & diag_heat(ji,jj) = diag_heat(ji,jj) &
& - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_Dt_ice & - SUM(SUM( e_i (ji,jj,1:nlay_i,:) - e_i_b (ji,jj,1:nlay_i,:), dim=2 ) ) * r1_Dt_ice &
diag_sice(:,:) = diag_sice(:,:) & & - SUM(SUM( e_s (ji,jj,1:nlay_s,:) - e_s_b (ji,jj,1:nlay_s,:), dim=2 ) ) * r1_Dt_ice
& + SUM( sv_i(:,:,:) - sv_i_b(:,:,:) , dim=3 ) * r1_Dt_ice * rhoi diag_sice(ji,jj) = diag_sice(ji,jj) &
diag_vice(:,:) = diag_vice(:,:) & & + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * r1_Dt_ice * rhoi
& + SUM( v_i (:,:,:) - v_i_b (:,:,:) , dim=3 ) * r1_Dt_ice * rhoi diag_vice(ji,jj) = diag_vice(ji,jj) &
diag_vsnw(:,:) = diag_vsnw(:,:) & & + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * r1_Dt_ice * rhoi
& + SUM( v_s (:,:,:) - v_s_b (:,:,:) , dim=3 ) * r1_Dt_ice * rhos diag_vsnw(ji,jj) = diag_vsnw(ji,jj) &
diag_vpnd(:,:) = diag_vpnd(:,:) & & + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * r1_Dt_ice * rhos
& + SUM( v_ip + v_il - v_ip_b - v_il_b , dim=3 ) * r1_Dt_ice * rhow diag_vpnd(ji,jj) = diag_vpnd(ji,jj) &
& + SUM( v_ip(ji,jj,:)+v_il(ji,jj,:) - v_ip_b(ji,jj,:)-v_il_b(ji,jj,:) ) * r1_Dt_ice * rhow
END_2D
! !
IF( kn == 2 ) CALL iom_put ( 'hfxdhc' , diag_heat ) ! output of heat trend IF( kn == 2 ) CALL iom_put ( 'hfxdhc' , diag_heat ) ! output of heat trend
! !
...@@ -501,10 +529,12 @@ CONTAINS ...@@ -501,10 +529,12 @@ CONTAINS
! --- trends of concentration (used for simip outputs) ! --- trends of concentration (used for simip outputs)
IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN
! !
diag_aice(:,:) = diag_aice(:,:) + SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice DO_2D( 0, 0, 0, 0 )
diag_aice(ji,jj) = diag_aice(ji,jj) + SUM( a_i(ji,jj,:) - a_i_b(ji,jj,:) ) * r1_Dt_ice
END_2D
! !
IF( kn == 1 ) CALL iom_put( 'afxdyn' , diag_aice ) ! dyn trend IF( kn == 1 ) CALL iom_put( 'afxdyn' , diag_aice ) ! dyn trend
IF( kn == 2 ) CALL iom_put( 'afxthd' , SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice ) ! thermo trend IF( kn == 2 ) CALL iom_put( 'afxthd' , SUM( a_i(A2D(0),:) - a_i_b(A2D(0),:), dim=3 ) * r1_Dt_ice ) ! thermo trend
IF( kn == 2 ) CALL iom_put( 'afxtot' , diag_aice ) ! total trend IF( kn == 2 ) CALL iom_put( 'afxtot' , diag_aice ) ! total trend
! !
ENDIF ENDIF
......
src/ICE/icetab.F90
View file @ 4dbfc9bb
...@@ -38,15 +38,24 @@ CONTAINS ...@@ -38,15 +38,24 @@ CONTAINS
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: ndim1d ! 1d size INTEGER , INTENT(in ) :: ndim1d ! 1d size
INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index
REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(in ) :: tab2d ! input 2D field REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: tab2d ! input 2D field
REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(inout) :: tab1d ! output 1D field REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(inout) :: tab1d ! output 1D field
! !
INTEGER :: jl, jn, jid, jjd INTEGER :: ipi, ipj, ji0, jj0, jl, jn, jid, jjd
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
ipi = SIZE(tab2d,1) ! 1st dimension
ipj = SIZE(tab2d,2) ! 2nd dimension
!
IF( ipi == jpi .AND. ipj == jpj ) THEN ! full arrays then no need to change index jid and jjd
ji0 = 0 ; jj0 = 0
ELSE ! reduced arrays then need to shift index by nn_hls
ji0 = nn_hls ; jj0 = nn_hls ! since tab2d is shifted by nn_hls
ENDIF ! (i.e. from hls+1:jpi-hls to 1:jpi-2*hls)
!
DO jl = 1, jpl DO jl = 1, jpl
DO jn = 1, ndim1d DO jn = 1, ndim1d
jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 - ji0
jjd = ( tab_ind(jn) - 1 ) / jpi + 1 jjd = ( tab_ind(jn) - 1 ) / jpi + 1 - jj0
tab1d(jn,jl) = tab2d(jid,jjd,jl) tab1d(jn,jl) = tab2d(jid,jjd,jl)
END DO END DO
END DO END DO
...@@ -59,14 +68,23 @@ CONTAINS ...@@ -59,14 +68,23 @@ CONTAINS
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: ndim1d ! 1d size INTEGER , INTENT(in ) :: ndim1d ! 1d size
INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index
REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: tab2d ! input 2D field REAL(wp), DIMENSION(:,:) , INTENT(in ) :: tab2d ! input 2D field
REAL(wp), DIMENSION(ndim1d) , INTENT(inout) :: tab1d ! output 1D field REAL(wp), DIMENSION(ndim1d) , INTENT(inout) :: tab1d ! output 1D field
! !
INTEGER :: jn , jid, jjd INTEGER :: ipi, ipj, ji0, jj0, jn, jid, jjd
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
ipi = SIZE(tab2d,1) ! 1st dimension
ipj = SIZE(tab2d,2) ! 2nd dimension
!
IF( ipi == jpi .AND. ipj == jpj ) THEN ! full arrays then no need to change index jid and jjd
ji0 = 0 ; jj0 = 0
ELSE ! reduced arrays then need to shift index by nn_hls
ji0 = nn_hls ; jj0 = nn_hls ! since tab2d is shifted by nn_hls
ENDIF ! (i.e. from hls+1:jpi-hls to 1:jpi-2*hls)
!
DO jn = 1, ndim1d DO jn = 1, ndim1d
jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 - ji0
jjd = ( tab_ind(jn) - 1 ) / jpi + 1 jjd = ( tab_ind(jn) - 1 ) / jpi + 1 - jj0
tab1d( jn) = tab2d( jid, jjd) tab1d( jn) = tab2d( jid, jjd)
END DO END DO
END SUBROUTINE tab_2d_1d END SUBROUTINE tab_2d_1d
...@@ -79,14 +97,23 @@ CONTAINS ...@@ -79,14 +97,23 @@ CONTAINS
INTEGER , INTENT(in ) :: ndim1d ! 1D size INTEGER , INTENT(in ) :: ndim1d ! 1D size
INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index
REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(in ) :: tab1d ! input 1D field REAL(wp), DIMENSION(ndim1d,jpl) , INTENT(in ) :: tab1d ! input 1D field
REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(inout) :: tab2d ! output 2D field REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: tab2d ! output 2D field
! !
INTEGER :: jl, jn, jid, jjd INTEGER :: ipi, ipj, ji0, jj0, jl, jn, jid, jjd
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
ipi = SIZE(tab2d,1) ! 1st dimension
ipj = SIZE(tab2d,2) ! 2nd dimension
!
IF( ipi == jpi .AND. ipj == jpj ) THEN ! full arrays then no need to change index jid and jjd
ji0 = 0 ; jj0 = 0
ELSE ! reduced arrays then need to shift index by nn_hls
ji0 = nn_hls ; jj0 = nn_hls ! since tab2d is shifted by nn_hls
ENDIF ! (i.e. from hls+1:jpi-hls to 1:jpi-2*hls)
!
DO jl = 1, jpl DO jl = 1, jpl
DO jn = 1, ndim1d DO jn = 1, ndim1d
jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 - ji0
jjd = ( tab_ind(jn) - 1 ) / jpi + 1 jjd = ( tab_ind(jn) - 1 ) / jpi + 1 - jj0
tab2d(jid,jjd,jl) = tab1d(jn,jl) tab2d(jid,jjd,jl) = tab1d(jn,jl)
END DO END DO
END DO END DO
...@@ -100,13 +127,22 @@ CONTAINS ...@@ -100,13 +127,22 @@ CONTAINS
INTEGER , INTENT(in ) :: ndim1d ! 1D size INTEGER , INTENT(in ) :: ndim1d ! 1D size
INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index INTEGER , DIMENSION(ndim1d) , INTENT(in ) :: tab_ind ! input index
REAL(wp), DIMENSION(ndim1d) , INTENT(in ) :: tab1d ! input 1D field REAL(wp), DIMENSION(ndim1d) , INTENT(in ) :: tab1d ! input 1D field
REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: tab2d ! output 2D field REAL(wp), DIMENSION(:,:) , INTENT(inout) :: tab2d ! output 2D field
! !
INTEGER :: jn , jid, jjd INTEGER :: ipi, ipj, ji0, jj0, jn, jid, jjd
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
ipi = SIZE(tab2d,1) ! 1st dimension
ipj = SIZE(tab2d,2) ! 2nd dimension
!
IF( ipi == jpi .AND. ipj == jpj ) THEN ! full arrays then no need to change index jid and jjd
ji0 = 0 ; jj0 = 0
ELSE ! reduced arrays then need to shift index by nn_hls
ji0 = nn_hls ; jj0 = nn_hls ! since tab2d is shifted by nn_hls
ENDIF ! (i.e. from hls+1:jpi-hls to 1:jpi-2*hls)
!
DO jn = 1, ndim1d DO jn = 1, ndim1d
jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 jid = MOD( tab_ind(jn) - 1 , jpi ) + 1 - ji0
jjd = ( tab_ind(jn) - 1 ) / jpi + 1 jjd = ( tab_ind(jn) - 1 ) / jpi + 1 - jj0
tab2d(jid, jjd) = tab1d( jn) tab2d(jid, jjd) = tab1d( jn)
END DO END DO
END SUBROUTINE tab_1d_2d END SUBROUTINE tab_1d_2d
......
src/ICE/icethd.F90
View file @ 4dbfc9bb
...@@ -98,7 +98,7 @@ CONTAINS ...@@ -98,7 +98,7 @@ CONTAINS
! convergence tests ! convergence tests
IF( ln_zdf_chkcvg ) THEN IF( ln_zdf_chkcvg ) THEN
ALLOCATE( ztice_cvgerr(jpi,jpj,jpl) , ztice_cvgstp(jpi,jpj,jpl) ) ALLOCATE( ztice_cvgerr(A2D(0),jpl) , ztice_cvgstp(A2D(0),jpl) )
ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp
ENDIF ENDIF
! !
...@@ -111,7 +111,7 @@ CONTAINS ...@@ -111,7 +111,7 @@ CONTAINS
! select ice covered grid points ! select ice covered grid points
npti = 0 ; nptidx(:) = 0 npti = 0 ; nptidx(:) = 0
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
IF ( a_i(ji,jj,jl) > epsi10 ) THEN IF ( a_i(ji,jj,jl) > epsi10 ) THEN
npti = npti + 1 npti = npti + 1
nptidx(npti) = (jj - 1) * jpi + ji nptidx(npti) = (jj - 1) * jpi + ji
...@@ -158,6 +158,13 @@ CONTAINS ...@@ -158,6 +158,13 @@ CONTAINS
IF( jpl > 1 ) CALL ice_itd_rem( kt ) ! --- Transport ice between thickness categories --- ! IF( jpl > 1 ) CALL ice_itd_rem( kt ) ! --- Transport ice between thickness categories --- !
! !
IF( ln_icedO ) CALL ice_thd_do ! --- Frazil ice growth in leads --- ! IF( ln_icedO ) CALL ice_thd_do ! --- Frazil ice growth in leads --- !
!
! ! --- LBC for the halos --- !
! the 2 lbc below could be avoided if calculations above were performed over the full domain
! but we think it is more efficient this way
CALL lbc_lnk( 'icethd', a_i , 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp, oa_i, 'T', 1._wp, &
& a_ip, 'T', 1._wp, v_ip, 'T', 1._wp, v_il, 'T', 1._wp, t_su, 'T', 1._wp )
CALL lbc_lnk( 'icethd', e_i , 'T', 1._wp, e_s , 'T', 1._wp )
! !
CALL ice_cor( kt , 2 ) ! --- Corrections --- ! CALL ice_cor( kt , 2 ) ! --- Corrections --- !
! !
......
src/ICE/icethd_do.F90
View file @ 4dbfc9bb
...@@ -28,7 +28,6 @@ MODULE icethd_do ...@@ -28,7 +28,6 @@ MODULE icethd_do
USE in_out_manager ! I/O manager USE in_out_manager ! I/O manager
USE lib_mpp ! MPP library USE lib_mpp ! MPP library
USE lib_fortran ! fortran utilities (glob_sum + no signed zero) USE lib_fortran ! fortran utilities (glob_sum + no signed zero)
USE lbclnk ! lateral boundary conditions (or mpp links)
IMPLICIT NONE IMPLICIT NONE
PRIVATE PRIVATE
...@@ -105,7 +104,7 @@ CONTAINS ...@@ -105,7 +104,7 @@ CONTAINS
IF( ln_icediachk ) CALL ice_cons_hsm( 0, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft ) IF( ln_icediachk ) CALL ice_cons_hsm( 0, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft )
IF( ln_icediachk ) CALL ice_cons2D ( 0, 'icethd_do', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft ) IF( ln_icediachk ) CALL ice_cons2D ( 0, 'icethd_do', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft )
at_i(:,:) = SUM( a_i, dim=3 ) at_i(A2D(0)) = SUM( a_i(A2D(0),:), dim=3 )
!------------------------------------------------------------------------------! !------------------------------------------------------------------------------!
! 1) Compute thickness, salinity, enthalpy, age, area and volume of new ice ! 1) Compute thickness, salinity, enthalpy, age, area and volume of new ice
!------------------------------------------------------------------------------! !------------------------------------------------------------------------------!
...@@ -113,7 +112,7 @@ CONTAINS ...@@ -113,7 +112,7 @@ CONTAINS
! Identify grid points where new ice forms ! Identify grid points where new ice forms
npti = 0 ; nptidx(:) = 0 npti = 0 ; nptidx(:) = 0
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
IF ( qlead(ji,jj) < 0._wp ) THEN IF ( qlead(ji,jj) < 0._wp ) THEN
npti = npti + 1 npti = npti + 1
nptidx( npti ) = (jj - 1) * jpi + ji nptidx( npti ) = (jj - 1) * jpi + ji
...@@ -325,6 +324,8 @@ CONTAINS ...@@ -325,6 +324,8 @@ CONTAINS
! !
ENDIF ! npti > 0 ENDIF ! npti > 0
! !
! the following fields need to be updated on the halos (done in icethd): a_i, v_i, sv_i, e_i
!
IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
IF( ln_icediachk ) CALL ice_cons2D (1, 'icethd_do', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) IF( ln_icediachk ) CALL ice_cons2D (1, 'icethd_do', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft)
! !
...@@ -372,8 +373,8 @@ CONTAINS ...@@ -372,8 +373,8 @@ CONTAINS
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
IF ( qlead(ji,jj) < 0._wp ) THEN ! cooling IF ( qlead(ji,jj) < 0._wp ) THEN ! cooling
! -- Wind stress -- ! ! -- Wind stress -- !
ztaux = ( utau_ice(ji-1,jj ) * umask(ji-1,jj ,1) + utau_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp ztaux = utau_ice(ji,jj) * smask0(ji,jj)
ztauy = ( vtau_ice(ji ,jj-1) * vmask(ji ,jj-1,1) + vtau_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp ztauy = vtau_ice(ji,jj) * smask0(ji,jj)
! Square root of wind stress ! Square root of wind stress
ztenagm = SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) ztenagm = SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) )
...@@ -415,8 +416,6 @@ CONTAINS ...@@ -415,8 +416,6 @@ CONTAINS
! !
END_2D END_2D
! !
CALL lbc_lnk( 'icethd_frazil', fraz_frac, 'T', 1.0_wp, ht_i_new, 'T', 1.0_wp )
ENDIF ENDIF
END SUBROUTINE ice_thd_frazil END SUBROUTINE ice_thd_frazil
......
src/ICE/icethd_pnd.F90
View file @ 4dbfc9bb
...@@ -84,7 +84,7 @@ CONTAINS ...@@ -84,7 +84,7 @@ CONTAINS
INTEGER :: ji, jj, jl ! loop indices INTEGER :: ji, jj, jl ! loop indices
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
ALLOCATE( diag_dvpn_mlt(jpi,jpj), diag_dvpn_lid(jpi,jpj), diag_dvpn_drn(jpi,jpj), diag_dvpn_rnf(jpi,jpj) ) ALLOCATE( diag_dvpn_mlt(A2D(0)) , diag_dvpn_lid(A2D(0)) , diag_dvpn_drn(A2D(0)) , diag_dvpn_rnf(A2D(0)) )
ALLOCATE( diag_dvpn_mlt_1d(jpij), diag_dvpn_lid_1d(jpij), diag_dvpn_drn_1d(jpij), diag_dvpn_rnf_1d(jpij) ) ALLOCATE( diag_dvpn_mlt_1d(jpij), diag_dvpn_lid_1d(jpij), diag_dvpn_drn_1d(jpij), diag_dvpn_rnf_1d(jpij) )
! !
diag_dvpn_mlt (:,:) = 0._wp ; diag_dvpn_drn (:,:) = 0._wp diag_dvpn_mlt (:,:) = 0._wp ; diag_dvpn_drn (:,:) = 0._wp
...@@ -98,7 +98,7 @@ CONTAINS ...@@ -98,7 +98,7 @@ CONTAINS
at_i(:,:) = SUM( a_i, dim=3 ) at_i(:,:) = SUM( a_i, dim=3 )
! !
DO jl = 1, jpl DO jl = 1, jpl
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
IF( v_i(ji,jj,jl) < epsi10 .OR. at_i(ji,jj) < epsi10 ) THEN IF( v_i(ji,jj,jl) < epsi10 .OR. at_i(ji,jj) < epsi10 ) THEN
wfx_pnd (ji,jj) = wfx_pnd(ji,jj) + ( v_ip(ji,jj,jl) + v_il(ji,jj,jl) ) * rhow * r1_Dt_ice wfx_pnd (ji,jj) = wfx_pnd(ji,jj) + ( v_ip(ji,jj,jl) + v_il(ji,jj,jl) ) * rhow * r1_Dt_ice
a_ip (ji,jj,jl) = 0._wp a_ip (ji,jj,jl) = 0._wp
...@@ -115,7 +115,7 @@ CONTAINS ...@@ -115,7 +115,7 @@ CONTAINS
! Identify grid cells with ice ! Identify grid cells with ice
!------------------------------ !------------------------------
npti = 0 ; nptidx(:) = 0 npti = 0 ; nptidx(:) = 0
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
IF( at_i(ji,jj) >= epsi10 ) THEN IF( at_i(ji,jj) >= epsi10 ) THEN
npti = npti + 1 npti = npti + 1
nptidx( npti ) = (jj - 1) * jpi + ji nptidx( npti ) = (jj - 1) * jpi + ji
...@@ -137,6 +137,8 @@ CONTAINS ...@@ -137,6 +137,8 @@ CONTAINS
END SELECT END SELECT
ENDIF ENDIF
! the following fields need to be updated in the halos (done in icethd): a_ip, v_ip, v_il, h_ip, h_il
!------------------------------------ !------------------------------------
! Diagnostics ! Diagnostics
!------------------------------------ !------------------------------------
...@@ -529,7 +531,7 @@ CONTAINS ...@@ -529,7 +531,7 @@ CONTAINS
zv_pnd , & ! volume of meltwater contributing to ponds zv_pnd , & ! volume of meltwater contributing to ponds
zv_mlt ! total amount of meltwater produced zv_mlt ! total amount of meltwater produced
REAL(wp), DIMENSION(jpi,jpj) :: zvolp_ini , & !! total melt pond water available before redistribution and drainage REAL(wp), DIMENSION(A2D(0)) :: zvolp_ini , & !! total melt pond water available before redistribution and drainage
zvolp , & !! total melt pond water volume zvolp , & !! total melt pond water volume
zvolp_res !! remaining melt pond water available after drainage zvolp_res !! remaining melt pond water available after drainage
...@@ -589,7 +591,7 @@ CONTAINS ...@@ -589,7 +591,7 @@ CONTAINS
zvolp(:,:) = 0._wp zvolp(:,:) = 0._wp
DO jl = 1, jpl DO jl = 1, jpl
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
IF ( a_i(ji,jj,jl) > epsi10 ) THEN IF ( a_i(ji,jj,jl) > epsi10 ) THEN
...@@ -637,7 +639,7 @@ CONTAINS ...@@ -637,7 +639,7 @@ CONTAINS
IF( ln_pnd_lids ) THEN IF( ln_pnd_lids ) THEN
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. zvolp_ini(ji,jj) > zvp_min * at_i(ji,jj) ) THEN IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. zvolp_ini(ji,jj) > zvp_min * at_i(ji,jj) ) THEN
...@@ -764,7 +766,7 @@ CONTAINS ...@@ -764,7 +766,7 @@ CONTAINS
DO jl = 1, jpl DO jl = 1, jpl
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! ! zap lids on small ponds ! ! zap lids on small ponds
! IF ( a_i(ji,jj,jl) > epsi10 .AND. v_ip(ji,jj,jl) < epsi10 & ! IF ( a_i(ji,jj,jl) > epsi10 .AND. v_ip(ji,jj,jl) < epsi10 &
...@@ -826,7 +828,7 @@ CONTAINS ...@@ -826,7 +828,7 @@ CONTAINS
!! !!
!!------------------------------------------------------------------ !!------------------------------------------------------------------
REAL (wp), DIMENSION(jpi,jpj), INTENT(INOUT) :: & REAL (wp), DIMENSION(A2D(0)), INTENT(INOUT) :: &
zvolp, & ! total available pond water zvolp, & ! total available pond water
zdvolp ! remaining meltwater after redistribution zdvolp ! remaining meltwater after redistribution
...@@ -865,10 +867,10 @@ CONTAINS ...@@ -865,10 +867,10 @@ CONTAINS
INTEGER :: ji, jj, jk, jl ! loop indices INTEGER :: ji, jj, jk, jl ! loop indices
a_ip(:,:,:) = 0._wp a_ip(A2D(0),:) = 0._wp
h_ip(:,:,:) = 0._wp h_ip(A2D(0),:) = 0._wp
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. zvolp(ji,jj) > zvp_min * at_i(ji,jj) ) THEN IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. zvolp(ji,jj) > zvp_min * at_i(ji,jj) ) THEN
......
src/ICE/iceupdate.F90
View file @ 4dbfc9bb
...@@ -55,7 +55,7 @@ CONTAINS ...@@ -55,7 +55,7 @@ CONTAINS
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
!! *** ROUTINE ice_update_alloc *** !! *** ROUTINE ice_update_alloc ***
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
ALLOCATE( utau_oce(jpi,jpj), vtau_oce(jpi,jpj), tmod_io(jpi,jpj), STAT=ice_update_alloc ) ALLOCATE( utau_oce(A2D(0)), vtau_oce(A2D(0)), tmod_io(A2D(1)), STAT=ice_update_alloc )
! !
CALL mpp_sum( 'iceupdate', ice_update_alloc ) CALL mpp_sum( 'iceupdate', ice_update_alloc )
IF( ice_update_alloc /= 0 ) CALL ctl_stop( 'STOP', 'ice_update_alloc: failed to allocate arrays' ) IF( ice_update_alloc /= 0 ) CALL ctl_stop( 'STOP', 'ice_update_alloc: failed to allocate arrays' )
...@@ -104,22 +104,29 @@ CONTAINS ...@@ -104,22 +104,29 @@ CONTAINS
! Net heat flux on top of the ice-ocean (W.m-2) ! Net heat flux on top of the ice-ocean (W.m-2)
!---------------------------------------------- !----------------------------------------------
IF( ln_cndflx ) THEN ! ice-atm interface = conduction (and melting) fluxes IF( ln_cndflx ) THEN ! ice-atm interface = conduction (and melting) fluxes
qt_atm_oi(:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) + & DO_2D( 0, 0, 0, 0 )
& SUM( a_i_b * ( qcn_ice + qml_ice + qtr_ice_top ), dim=3 ) + qemp_ice(:,:) qt_atm_oi(ji,jj) = ( 1._wp - at_i_b(ji,jj) ) * ( qns_oce(ji,jj) + qsr_oce(ji,jj) ) + qemp_oce(ji,jj) &
& + SUM( a_i_b(ji,jj,:) * ( qcn_ice(ji,jj,:) + qml_ice(ji,jj,:) + qtr_ice_top(ji,jj,:) ) ) &
& + qemp_ice(ji,jj)
END_2D
ELSE ! ice-atm interface = solar and non-solar fluxes ELSE ! ice-atm interface = solar and non-solar fluxes
qt_atm_oi(:,:) = qns_tot(:,:) + qsr_tot(:,:) DO_2D( 0, 0, 0, 0 )
qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)
END_2D
ENDIF ENDIF
! --- case we bypass ice thermodynamics --- ! ! --- case we bypass ice thermodynamics --- !
IF( .NOT. ln_icethd ) THEN ! we suppose ice is impermeable => ocean is isolated from atmosphere IF( .NOT. ln_icethd ) THEN ! we suppose ice is impermeable => ocean is isolated from atmosphere
qt_atm_oi (:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) DO_2D( 0, 0, 0, 0 )
qt_oce_ai (:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + qemp_oce(:,:) qt_atm_oi (ji,jj) = ( 1._wp - at_i_b(ji,jj) ) * ( qns_oce(ji,jj) + qsr_oce(ji,jj) ) + qemp_oce(ji,jj)
emp_ice (:,:) = 0._wp qt_oce_ai (ji,jj) = ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj)
qemp_ice (:,:) = 0._wp emp_ice (ji,jj) = 0._wp
qevap_ice (:,:,:) = 0._wp qemp_ice (ji,jj) = 0._wp
qevap_ice (ji,jj,:) = 0._wp
END_2D
ENDIF ENDIF
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
! Solar heat flux reaching the ocean (max) = zqsr (W.m-2) ! Solar heat flux reaching the ocean (max) = zqsr (W.m-2)
!--------------------------------------------------- !---------------------------------------------------
...@@ -183,20 +190,22 @@ CONTAINS ...@@ -183,20 +190,22 @@ CONTAINS
snwice_mass_b(ji,jj) = snwice_mass(ji,jj) ! save mass from the previous ice time step snwice_mass_b(ji,jj) = snwice_mass(ji,jj) ! save mass from the previous ice time step
! ! new mass per unit area ! ! new mass per unit area
snwice_mass (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) ) snwice_mass (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) )
! ! time evolution of snow+ice mass
snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_Dt_ice
END_2D END_2D
CALL lbc_lnk( 'iceupdate', snwice_mass, 'T', 1.0_wp, snwice_mass_b, 'T', 1.0_wp ) ! needed for sshwzv and dynspg_ts (lbc on emp is done in sbcmod)
! time evolution of snow+ice mass
snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_Dt_ice
! Storing the transmitted variables ! Storing the transmitted variables
!---------------------------------- !----------------------------------
fr_i (:,:) = at_i(:,:) ! Sea-ice fraction fr_i (:,:) = at_i(:,:) ! Sea-ice fraction
tn_ice(:,:,:) = t_su(:,:,:) ! Ice surface temperature tn_ice(:,:,:) = t_su(A2D(0),:) ! Ice surface temperature
! Snow/ice albedo (only if sent to coupler, useless in forced mode) ! Snow/ice albedo (only if sent to coupler, useless in forced mode)
!------------------------------------------------------------------ !------------------------------------------------------------------
CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, cloud_fra, alb_ice ) ! ice albedo CALL ice_alb( ln_pnd_alb, t_su(A2D(0),:), h_i(A2D(0),:), h_s(A2D(0),:), a_ip_eff(:,:,:), h_ip(A2D(0),:), cloud_fra(:,:), & ! <<== in
& alb_ice(:,:,:) ) ! ==>> out
! !
IF( lrst_ice ) THEN !* write snwice_mass fields in the restart file IF( lrst_ice ) THEN !* write snwice_mass fields in the restart file
CALL update_rst( 'WRITE', kt ) CALL update_rst( 'WRITE', kt )
...@@ -216,8 +225,8 @@ CONTAINS ...@@ -216,8 +225,8 @@ CONTAINS
IF( iom_use('sfxopw' ) ) CALL iom_put( 'sfxopw', sfx_opw * 1.e-03 ) ! salt flux from open water formation IF( iom_use('sfxopw' ) ) CALL iom_put( 'sfxopw', sfx_opw * 1.e-03 ) ! salt flux from open water formation
IF( iom_use('sfxdyn' ) ) CALL iom_put( 'sfxdyn', sfx_dyn * 1.e-03 ) ! salt flux from ridging rafting IF( iom_use('sfxdyn' ) ) CALL iom_put( 'sfxdyn', sfx_dyn * 1.e-03 ) ! salt flux from ridging rafting
IF( iom_use('sfxbri' ) ) CALL iom_put( 'sfxbri', sfx_bri * 1.e-03 ) ! salt flux from brines IF( iom_use('sfxbri' ) ) CALL iom_put( 'sfxbri', sfx_bri * 1.e-03 ) ! salt flux from brines
IF( iom_use('sfxres' ) ) CALL iom_put( 'sfxres', sfx_res * 1.e-03 ) ! salt flux from undiagnosed processes
IF( iom_use('sfxsub' ) ) CALL iom_put( 'sfxsub', sfx_sub * 1.e-03 ) ! salt flux from sublimation IF( iom_use('sfxsub' ) ) CALL iom_put( 'sfxsub', sfx_sub * 1.e-03 ) ! salt flux from sublimation
IF( iom_use('sfxres' ) ) CALL iom_put( 'sfxres', sfx_res(A2D(0)) * 1.e-03 ) ! salt flux from undiagnosed processes
! --- mass fluxes [kg/m2/s] --- ! ! --- mass fluxes [kg/m2/s] --- !
CALL iom_put( 'emp_oce', emp_oce ) ! emp over ocean (taking into account the snow blown away from the ice) CALL iom_put( 'emp_oce', emp_oce ) ! emp over ocean (taking into account the snow blown away from the ice)
...@@ -232,13 +241,13 @@ CONTAINS ...@@ -232,13 +241,13 @@ CONTAINS
CALL iom_put( 'vfxsni' , wfx_sni ) ! mass flux from snow-ice formation CALL iom_put( 'vfxsni' , wfx_sni ) ! mass flux from snow-ice formation
CALL iom_put( 'vfxopw' , wfx_opw ) ! mass flux from growth in open water CALL iom_put( 'vfxopw' , wfx_opw ) ! mass flux from growth in open water
CALL iom_put( 'vfxdyn' , wfx_dyn ) ! mass flux from dynamics (ridging) CALL iom_put( 'vfxdyn' , wfx_dyn ) ! mass flux from dynamics (ridging)
CALL iom_put( 'vfxres' , wfx_res ) ! mass flux from undiagnosed processes
CALL iom_put( 'vfxpnd' , wfx_pnd ) ! mass flux from melt ponds CALL iom_put( 'vfxpnd' , wfx_pnd ) ! mass flux from melt ponds
CALL iom_put( 'vfxsub' , wfx_ice_sub ) ! mass flux from ice sublimation (ice-atm.) CALL iom_put( 'vfxsub' , wfx_ice_sub ) ! mass flux from ice sublimation (ice-atm.)
CALL iom_put( 'vfxsub_err', wfx_err_sub ) ! "excess" of sublimation sent to ocean CALL iom_put( 'vfxsub_err', wfx_err_sub ) ! "excess" of sublimation sent to ocean
CALL iom_put( 'vfxres' , wfx_res(A2D(0)) ) ! mass flux from undiagnosed processes
IF ( iom_use( 'vfxthin' ) ) THEN ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations IF ( iom_use( 'vfxthin' ) ) THEN ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations
ALLOCATE( z2d(jpi,jpj) ) ALLOCATE( z2d(A2D(0)) )
WHERE( hm_i(:,:) < 0.2 .AND. hm_i(:,:) > 0. ) ; z2d = wfx_bog WHERE( hm_i(:,:) < 0.2 .AND. hm_i(:,:) > 0. ) ; z2d = wfx_bog
ELSEWHERE ; z2d = 0._wp ELSEWHERE ; z2d = 0._wp
END WHERE END WHERE
...@@ -264,8 +273,8 @@ CONTAINS ...@@ -264,8 +273,8 @@ CONTAINS
IF( iom_use('qtr_ice_top') ) CALL iom_put( 'qtr_ice_top', SUM( qtr_ice_top * a_i_b, dim=3 ) ) ! solar flux transmitted thru ice surface IF( iom_use('qtr_ice_top') ) CALL iom_put( 'qtr_ice_top', SUM( qtr_ice_top * a_i_b, dim=3 ) ) ! solar flux transmitted thru ice surface
IF( iom_use('qt_oce' ) ) CALL iom_put( 'qt_oce' , ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce ) IF( iom_use('qt_oce' ) ) CALL iom_put( 'qt_oce' , ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce )
IF( iom_use('qt_ice' ) ) CALL iom_put( 'qt_ice' , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 ) + qemp_ice ) IF( iom_use('qt_ice' ) ) CALL iom_put( 'qt_ice' , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 ) + qemp_ice )
IF( iom_use('qt_oce_ai' ) ) CALL iom_put( 'qt_oce_ai' , qt_oce_ai * tmask(:,:,1) ) ! total heat flux at the ocean surface: interface oce-(ice+atm) IF( iom_use('qt_oce_ai' ) ) CALL iom_put( 'qt_oce_ai' , qt_oce_ai * smask0 ) ! total heat flux at the ocean surface: interface oce-(ice+atm)
IF( iom_use('qt_atm_oi' ) ) CALL iom_put( 'qt_atm_oi' , qt_atm_oi * tmask(:,:,1) ) ! total heat flux at the oce-ice surface: interface atm-(ice+oce) IF( iom_use('qt_atm_oi' ) ) CALL iom_put( 'qt_atm_oi' , qt_atm_oi * smask0 ) ! total heat flux at the oce-ice surface: interface atm-(ice+oce)
IF( iom_use('qemp_oce' ) ) CALL iom_put( 'qemp_oce' , qemp_oce ) ! Downward Heat Flux from E-P over ocean IF( iom_use('qemp_oce' ) ) CALL iom_put( 'qemp_oce' , qemp_oce ) ! Downward Heat Flux from E-P over ocean
IF( iom_use('qemp_ice' ) ) CALL iom_put( 'qemp_ice' , qemp_ice ) ! Downward Heat Flux from E-P over ice IF( iom_use('qemp_ice' ) ) CALL iom_put( 'qemp_ice' , qemp_ice ) ! Downward Heat Flux from E-P over ice
...@@ -282,9 +291,9 @@ CONTAINS ...@@ -282,9 +291,9 @@ CONTAINS
! heat fluxes associated with mass exchange (freeze/melt/precip...) ! heat fluxes associated with mass exchange (freeze/melt/precip...)
CALL iom_put ('hfxthd' , hfx_thd ) ! CALL iom_put ('hfxthd' , hfx_thd ) !
CALL iom_put ('hfxdyn' , hfx_dyn ) ! CALL iom_put ('hfxdyn' , hfx_dyn ) !
CALL iom_put ('hfxres' , hfx_res ) !
CALL iom_put ('hfxsub' , hfx_sub ) ! CALL iom_put ('hfxsub' , hfx_sub ) !
CALL iom_put ('hfxspr' , hfx_spr ) ! Heat flux from snow precip heat content CALL iom_put ('hfxspr' , hfx_spr ) ! Heat flux from snow precip heat content
CALL iom_put ('hfxres' , hfx_res(A2D(0)) ) !
! other heat fluxes ! other heat fluxes
IF( iom_use('hfxsensib' ) ) CALL iom_put( 'hfxsensib' , qsb_ice_bot * at_i_b ) ! Sensible oceanic heat flux IF( iom_use('hfxsensib' ) ) CALL iom_put( 'hfxsensib' , qsb_ice_bot * at_i_b ) ! Sensible oceanic heat flux
...@@ -314,7 +323,7 @@ CONTAINS ...@@ -314,7 +323,7 @@ CONTAINS
!! !!
!! ** Action : * at each ice time step (every nn_fsbc time step): !! ** Action : * at each ice time step (every nn_fsbc time step):
!! - compute the modulus of ice-ocean relative velocity !! - compute the modulus of ice-ocean relative velocity
!! (*rho*Cd) at T-point (C-grid) or I-point (B-grid) !! (*rho*Cd) at T-point (C-grid)
!! tmod_io = rhoco * | U_ice-U_oce | !! tmod_io = rhoco * | U_ice-U_oce |
!! - update the modulus of stress at ocean surface !! - update the modulus of stress at ocean surface
!! taum = (1-a) * taum + a * tmod_io * | U_ice-U_oce | !! taum = (1-a) * taum + a * tmod_io * | U_ice-U_oce |
...@@ -325,19 +334,19 @@ CONTAINS ...@@ -325,19 +334,19 @@ CONTAINS
!! !!
!! NB: - ice-ocean rotation angle no more allowed !! NB: - ice-ocean rotation angle no more allowed
!! - here we make an approximation: taum is only computed every ice time step !! - here we make an approximation: taum is only computed every ice time step
!! This avoids mutiple average to pass from T -> U,V grids and next from U,V grids !! This avoids mutiple average to pass from U,V grids to T grids
!! to T grid. taum is used in TKE and GLS, which should not be too sensitive to this approximaton... !! taum is used in TKE and GLS, which should not be too sensitive to this approximaton...
!! !!
!! ** Outputs : - utau, vtau : surface ocean i- and j-stress (u- & v-pts) updated with ice-ocean fluxes !! ** Outputs : - utau, vtau : surface ocean i- and j-stress (T-pts) updated with ice-ocean fluxes
!! - taum : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes !! - taum : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
INTEGER , INTENT(in) :: kt ! ocean time-step index INTEGER , INTENT(in) :: kt ! ocean time-step index
REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents
! !
INTEGER :: ji, jj ! dummy loop indices INTEGER :: ji, jj ! dummy loop indices
REAL(wp) :: zat_u, zutau_ice, zu_t, zmodt ! local scalar REAL(wp) :: zutau_ice, zu_t, zmodt ! local scalar
REAL(wp) :: zat_v, zvtau_ice, zv_t, zrhoco ! - - REAL(wp) :: zvtau_ice, zv_t, zrhoco ! - -
REAL(wp) :: zflagi ! - - REAL(wp) :: zflagi ! - -
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
IF( ln_timing ) CALL timing_start('iceupdate') IF( ln_timing ) CALL timing_start('iceupdate')
...@@ -350,46 +359,51 @@ CONTAINS ...@@ -350,46 +359,51 @@ CONTAINS
zrhoco = rho0 * rn_cio zrhoco = rho0 * rn_cio
! !
IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step)
DO_2D( 0, 0, 0, 0 ) !* update the modulus of stress at ocean surface (T-point) DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* rhoco * |U_ice-U_oce| at T-point
! ! 2*(U_ice-U_oce) at T-point
zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) ! u_oce = ssu_m
zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) ! v_oce = ssv_m
! ! |U_ice-U_oce|^2
zmodt = 0.25_wp * ( zu_t * zu_t + zv_t * zv_t )
!
tmod_io(ji,jj) = zrhoco * SQRT( zmodt )
END_2D
IF( nn_hls == 1 ) CALL lbc_lnk( 'iceupdate', tmod_io, 'T', 1._wp )
!
DO_2D( 0, 0, 0, 0 ) !* save the air-ocean stresses at ice time-step
! ! 2*(U_ice-U_oce) at T-point ! ! 2*(U_ice-U_oce) at T-point
zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) ! u_oce = ssu_m
zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) ! v_oce = ssv_m
! ! |U_ice-U_oce|^2 ! ! |U_ice-U_oce|^2
zmodt = 0.25_wp * ( zu_t * zu_t + zv_t * zv_t ) zmodt = 0.25_wp * ( zu_t * zu_t + zv_t * zv_t )
! ! update the ocean stress modulus ! ! update the ocean stress modulus
taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt
tmod_io(ji,jj) = zrhoco * SQRT( zmodt ) ! rhoco * |U_ice-U_oce| at T-point !
utau_oce(ji,jj) = utau(ji,jj)
vtau_oce(ji,jj) = vtau(ji,jj)
END_2D END_2D
CALL lbc_lnk( 'iceupdate', taum, 'T', 1.0_wp, tmod_io, 'T', 1.0_wp )
!
utau_oce(:,:) = utau(:,:) !* save the air-ocean stresses at ice time-step
vtau_oce(:,:) = vtau(:,:)
! !
ENDIF ENDIF
! !
! !== every ocean time-step ==! ! !== every ocean time-step ==!
IF ( ln_drgice_imp ) THEN IF ( ln_drgice_imp ) THEN
! Save drag with right sign to update top drag in the ocean implicit friction ! Save drag with right sign to update top drag in the ocean implicit friction
rCdU_ice(:,:) = -r1_rho0 * tmod_io(:,:) * at_i(:,:) * tmask(:,:,1) DO_2D( 1, 1, 1, 1 )
rCdU_ice(ji,jj) = -r1_rho0 * tmod_io(ji,jj) * at_i(ji,jj) * tmask(ji,jj,1)
END_2D
zflagi = 0._wp zflagi = 0._wp
ELSE ELSE
zflagi = 1._wp zflagi = 1._wp
ENDIF ENDIF
! !
DO_2D( 0, 0, 0, 0 ) !* update the stress WITHOUT an ice-ocean rotation angle DO_2D( 0, 0, 0, 0 ) !* update the stress WITHOUT an ice-ocean rotation angle
! ice area at u and v-points
zat_u = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj ) * tmask(ji+1,jj ,1) ) &
& / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji+1,jj ,1) )
zat_v = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji ,jj+1 ) * tmask(ji ,jj+1,1) ) &
& / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji ,jj+1,1) )
! ! linearized quadratic drag formulation ! ! linearized quadratic drag formulation
zutau_ice = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - pu_oce(ji,jj) ) zutau_ice = 0.5_wp * tmod_io(ji,jj) * ( u_ice(ji,jj) + u_ice(ji-1,jj) - pu_oce(ji,jj) - pu_oce(ji-1,jj) )
zvtau_ice = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - pv_oce(ji,jj) ) zvtau_ice = 0.5_wp * tmod_io(ji,jj) * ( v_ice(ji,jj) + v_ice(ji,jj-1) - pv_oce(ji,jj) - pv_oce(ji,jj-1) )
! ! stresses at the ocean surface ! ! stresses at the ocean surface
utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice utau(ji,jj) = ( 1._wp - at_i(ji,jj) ) * utau_oce(ji,jj) + at_i(ji,jj) * zutau_ice
vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice vtau(ji,jj) = ( 1._wp - at_i(ji,jj) ) * vtau_oce(ji,jj) + at_i(ji,jj) * zvtau_ice
END_2D END_2D
CALL lbc_lnk( 'iceupdate', utau, 'U', -1.0_wp, vtau, 'V', -1.0_wp ) ! lateral boundary condition
! !
IF( ln_timing ) CALL timing_stop('iceupdate') IF( ln_timing ) CALL timing_stop('iceupdate')
! !
...@@ -446,12 +460,12 @@ CONTAINS ...@@ -446,12 +460,12 @@ CONTAINS
CALL iom_get( numrir, jpdom_auto, 'snwice_mass_b', snwice_mass_b ) CALL iom_get( numrir, jpdom_auto, 'snwice_mass_b', snwice_mass_b )
ELSE ! start from rest ELSE ! start from rest
IF(lwp) WRITE(numout,*) ' ==>> previous run without snow-ice mass output then set it' IF(lwp) WRITE(numout,*) ' ==>> previous run without snow-ice mass output then set it'
snwice_mass (:,:) = tmask(:,:,1) * ( rhos * vt_s(:,:) + rhoi * vt_i(:,:) ) snwice_mass (:,:) = tmask(:,:,1) * ( rhos * vt_s(:,:) + rhoi * vt_i(:,:) + rhow * (vt_ip(:,:) + vt_il(:,:)) )
snwice_mass_b(:,:) = snwice_mass(:,:) snwice_mass_b(:,:) = snwice_mass(:,:)
ENDIF ENDIF
ELSE !* Start from rest ELSE !* Start from rest
IF(lwp) WRITE(numout,*) ' ==>> start from rest: set the snow-ice mass' IF(lwp) WRITE(numout,*) ' ==>> start from rest: set the snow-ice mass'
snwice_mass (:,:) = tmask(:,:,1) * ( rhos * vt_s(:,:) + rhoi * vt_i(:,:) ) snwice_mass (:,:) = tmask(:,:,1) * ( rhos * vt_s(:,:) + rhoi * vt_i(:,:) + rhow * (vt_ip(:,:) + vt_il(:,:)) )
snwice_mass_b(:,:) = snwice_mass(:,:) snwice_mass_b(:,:) = snwice_mass(:,:)
ENDIF ENDIF
! !
......
src/ICE/icevar.F90
View file @ 4dbfc9bb
...@@ -117,70 +117,88 @@ CONTAINS ...@@ -117,70 +117,88 @@ CONTAINS
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z1_at_i, z1_vt_i, z1_vt_s REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z1_at_i, z1_vt_i, z1_vt_s
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
! !
! ! integrated values ! full arrays: vt_i, vt_s, at_i, vt_ip, vt_il, at_ip
vt_i(:,:) = SUM( v_i (:,:,:) , dim=3 ) ! reduced arrays: the rest
vt_s(:,:) = SUM( v_s (:,:,:) , dim=3 )
st_i(:,:) = SUM( sv_i(:,:,:) , dim=3 )
at_i(:,:) = SUM( a_i (:,:,:) , dim=3 )
et_s(:,:) = SUM( SUM( e_s (:,:,:,:), dim=4 ), dim=3 )
et_i(:,:) = SUM( SUM( e_i (:,:,:,:), dim=4 ), dim=3 )
! !
at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 ) ! melt ponds ! ! integrated values
vt_ip(:,:) = SUM( v_ip(:,:,:), dim=3 ) DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
vt_il(:,:) = SUM( v_il(:,:,:), dim=3 ) vt_i(ji,jj) = SUM( v_i (ji,jj,:) )
vt_s(ji,jj) = SUM( v_s (ji,jj,:) )
at_i(ji,jj) = SUM( a_i (ji,jj,:) )
!
at_ip(ji,jj) = SUM( a_ip(ji,jj,:) ) ! melt ponds
vt_ip(ji,jj) = SUM( v_ip(ji,jj,:) )
vt_il(ji,jj) = SUM( v_il(ji,jj,:) )
END_2D
DO_2D( 0, 0, 0, 0 )
st_i(ji,jj) = SUM( sv_i(ji,jj,:) )
et_s(ji,jj) = SUM( SUM( e_s (ji,jj,:,:), dim=2 ) )
et_i(ji,jj) = SUM( SUM( e_i (ji,jj,:,:), dim=2 ) )
END_2D
! !
ato_i(:,:) = 1._wp - at_i(:,:) ! open water fraction ato_i(:,:) = 1._wp - at_i(:,:) ! open water fraction
! !
!!GS: tm_su always needed by ABL over sea-ice !!GS: tm_su always needed by ABL over sea-ice
ALLOCATE( z1_at_i(jpi,jpj) ) ALLOCATE( z1_at_i(A2D(0)) )
WHERE( at_i(:,:) > epsi20 ) ; z1_at_i(:,:) = 1._wp / at_i(:,:) WHERE( at_i(A2D(0)) > epsi20 ) ; z1_at_i(:,:) = 1._wp / at_i(A2D(0))
ELSEWHERE ; z1_at_i(:,:) = 0._wp ELSEWHERE ; z1_at_i(:,:) = 0._wp
END WHERE END WHERE
tm_su(:,:) = SUM( t_su(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) DO_2D( 0, 0, 0, 0 )
WHERE( at_i(:,:)<=epsi20 ) tm_su(:,:) = rt0 IF( at_i(ji,jj)<=epsi20 ) THEN
tm_su(ji,jj) = rt0
ELSE
tm_su(ji,jj) = SUM( t_su(ji,jj,:) * a_i(ji,jj,:) ) * z1_at_i(ji,jj)
ENDIF
END_2D
! !
! The following fields are calculated for diagnostics and outputs only ! The following fields are calculated for diagnostics and outputs only
! ==> Do not use them for other purposes ! ==> Do not use them for other purposes
IF( kn > 1 ) THEN IF( kn > 1 ) THEN
! !
ALLOCATE( z1_vt_i(jpi,jpj) , z1_vt_s(jpi,jpj) ) ALLOCATE( z1_vt_i(A2D(0)) , z1_vt_s(A2D(0)) )
WHERE( vt_i(:,:) > epsi20 ) ; z1_vt_i(:,:) = 1._wp / vt_i(:,:) WHERE( vt_i(A2D(0)) > epsi20 ) ; z1_vt_i(:,:) = 1._wp / vt_i(A2D(0))
ELSEWHERE ; z1_vt_i(:,:) = 0._wp ELSEWHERE ; z1_vt_i(:,:) = 0._wp
END WHERE END WHERE
WHERE( vt_s(:,:) > epsi20 ) ; z1_vt_s(:,:) = 1._wp / vt_s(:,:) WHERE( vt_s(A2D(0)) > epsi20 ) ; z1_vt_s(:,:) = 1._wp / vt_s(A2D(0))
ELSEWHERE ; z1_vt_s(:,:) = 0._wp ELSEWHERE ; z1_vt_s(:,:) = 0._wp
END WHERE END WHERE
! !
! ! mean ice/snow thickness ! ! mean ice/snow thickness
hm_i(:,:) = vt_i(:,:) * z1_at_i(:,:) DO_2D( 0, 0, 0, 0 )
hm_s(:,:) = vt_s(:,:) * z1_at_i(:,:) hm_i(ji,jj) = vt_i(ji,jj) * z1_at_i(ji,jj)
! hm_s(ji,jj) = vt_s(ji,jj) * z1_at_i(ji,jj)
! ! mean temperature (K), salinity and age !
tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) ! ! mean temperature (K), salinity and age
om_i (:,:) = SUM( oa_i(:,:,:) , dim=3 ) * z1_at_i(:,:) tm_si(ji,jj) = SUM( t_si(ji,jj,:) * a_i(ji,jj,:) ) * z1_at_i(ji,jj)
sm_i (:,:) = st_i(:,:) * z1_vt_i(:,:) om_i (ji,jj) = SUM( oa_i(ji,jj,:) ) * z1_at_i(ji,jj)
! sm_i (ji,jj) = st_i(ji,jj) * z1_vt_i(ji,jj)
tm_i(:,:) = 0._wp !
tm_s(:,:) = 0._wp tm_i(ji,jj) = 0._wp
DO jl = 1, jpl tm_s(ji,jj) = 0._wp
DO jk = 1, nlay_i DO jl = 1, jpl
tm_i(:,:) = tm_i(:,:) + r1_nlay_i * t_i (:,:,jk,jl) * v_i(:,:,jl) * z1_vt_i(:,:) DO jk = 1, nlay_i
END DO tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * t_i (ji,jj,jk,jl) * v_i(ji,jj,jl) * z1_vt_i(ji,jj)
DO jk = 1, nlay_s END DO
tm_s(:,:) = tm_s(:,:) + r1_nlay_s * t_s (:,:,jk,jl) * v_s(:,:,jl) * z1_vt_s(:,:) DO jk = 1, nlay_s
tm_s(ji,jj) = tm_s(ji,jj) + r1_nlay_s * t_s (ji,jj,jk,jl) * v_s(ji,jj,jl) * z1_vt_s(ji,jj)
END DO
END DO END DO
END DO !
! END_2D
! ! put rt0 where there is no ice ! ! put rt0 where there is no ice
WHERE( at_i(:,:)<=epsi20 ) WHERE( at_i(A2D(0)) <= epsi20 )
tm_si(:,:) = rt0 tm_si(:,:) = rt0
tm_i (:,:) = rt0 tm_i (:,:) = rt0
tm_s (:,:) = rt0 tm_s (:,:) = rt0
END WHERE END WHERE
! !
! ! mean melt pond depth ! ! mean melt pond depth
WHERE( at_ip(:,:) > epsi20 ) ; hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) ; hm_il(:,:) = vt_il(:,:) / at_ip(:,:) WHERE( at_ip(A2D(0)) > epsi20 )
ELSEWHERE ; hm_ip(:,:) = 0._wp ; hm_il(:,:) = 0._wp hm_ip(:,:) = vt_ip(A2D(0)) / at_ip(A2D(0))
hm_il(:,:) = vt_il(A2D(0)) / at_ip(A2D(0))
ELSEWHERE
hm_ip(:,:) = 0._wp
hm_il(:,:) = 0._wp
END WHERE END WHERE
! !
DEALLOCATE( z1_vt_i , z1_vt_s ) DEALLOCATE( z1_vt_i , z1_vt_s )
...@@ -206,7 +224,8 @@ CONTAINS ...@@ -206,7 +224,8 @@ CONTAINS
REAL(wp) :: zlay_i, zlay_s ! - - REAL(wp) :: zlay_i, zlay_s ! - -
REAL(wp), PARAMETER :: zhl_max = 0.015_wp ! pond lid thickness above which the ponds disappear from the albedo calculation REAL(wp), PARAMETER :: zhl_max = 0.015_wp ! pond lid thickness above which the ponds disappear from the albedo calculation
REAL(wp), PARAMETER :: zhl_min = 0.005_wp ! pond lid thickness below which the full pond area is used in the albedo calculation REAL(wp), PARAMETER :: zhl_min = 0.005_wp ! pond lid thickness below which the full pond area is used in the albedo calculation
REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_a_i, z1_v_i, z1_a_ip, za_s_fra REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_a_i, z1_v_i, z1_a_ip
REAL(wp), DIMENSION(A2D(0),jpl) :: za_s_fra
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
!!gm Question 2: It is possible to define existence of sea-ice in a common way between !!gm Question 2: It is possible to define existence of sea-ice in a common way between
...@@ -247,15 +266,15 @@ CONTAINS ...@@ -247,15 +266,15 @@ CONTAINS
h_ip(:,:,:) = v_ip(:,:,:) * z1_a_ip(:,:,:) h_ip(:,:,:) = v_ip(:,:,:) * z1_a_ip(:,:,:)
h_il(:,:,:) = v_il(:,:,:) * z1_a_ip(:,:,:) h_il(:,:,:) = v_il(:,:,:) * z1_a_ip(:,:,:)
! !--- melt pond effective area (used for albedo) ! !--- melt pond effective area (used for albedo)
a_ip_frac(:,:,:) = a_ip(:,:,:) * z1_a_i(:,:,:) a_ip_frac(:,:,:) = a_ip(A2D(0),:) * z1_a_i(A2D(0),:)
WHERE ( h_il(:,:,:) <= zhl_min ) ; a_ip_eff(:,:,:) = a_ip_frac(:,:,:) ! lid is very thin. Expose all the pond WHERE ( h_il(A2D(0),:) <= zhl_min ) ; a_ip_eff(:,:,:) = a_ip_frac(:,:,:) ! lid is very thin. Expose all the pond
ELSEWHERE( h_il(:,:,:) >= zhl_max ) ; a_ip_eff(:,:,:) = 0._wp ! lid is very thick. Cover all the pond up with ice and snow ELSEWHERE( h_il(A2D(0),:) >= zhl_max ) ; a_ip_eff(:,:,:) = 0._wp ! lid is very thick. Cover all the pond up with ice and snow
ELSEWHERE ; a_ip_eff(:,:,:) = a_ip_frac(:,:,:) * & ! lid is in between. Expose part of the pond ELSEWHERE ; a_ip_eff(:,:,:) = a_ip_frac(:,:,:) * & ! lid is in between. Expose part of the pond
& ( zhl_max - h_il(:,:,:) ) / ( zhl_max - zhl_min ) & ( zhl_max - h_il(A2D(0),:) ) / ( zhl_max - zhl_min )
END WHERE END WHERE
! !
CALL ice_var_snwfra( h_s, za_s_fra ) ! calculate ice fraction covered by snow CALL ice_var_snwfra( h_s(A2D(0),:), za_s_fra(:,:,:) ) ! calculate ice fraction covered by snow
a_ip_eff = MIN( a_ip_eff, 1._wp - za_s_fra ) ! make sure (a_ip_eff + a_s_fra) <= 1 a_ip_eff(:,:,:) = MIN( a_ip_eff(:,:,:), 1._wp - za_s_fra(:,:,:) ) ! make sure (a_ip_eff + a_s_fra) <= 1
! !
! !--- salinity (with a minimum value imposed everywhere) ! !--- salinity (with a minimum value imposed everywhere)
IF( nn_icesal == 2 ) THEN IF( nn_icesal == 2 ) THEN
...@@ -300,9 +319,9 @@ CONTAINS ...@@ -300,9 +319,9 @@ CONTAINS
END DO END DO
! !
! integrated values ! integrated values
vt_i (:,:) = SUM( v_i , dim=3 ) vt_i (:,:) = SUM( v_i, dim=3 )
vt_s (:,:) = SUM( v_s , dim=3 ) vt_s (:,:) = SUM( v_s, dim=3 )
at_i (:,:) = SUM( a_i , dim=3 ) at_i (:,:) = SUM( a_i, dim=3 )
! !
END SUBROUTINE ice_var_glo2eqv END SUBROUTINE ice_var_glo2eqv
...@@ -538,7 +557,7 @@ CONTAINS ...@@ -538,7 +557,7 @@ CONTAINS
sfx_res(ji,jj) = sfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl) * rhoi * r1_Dt_ice sfx_res(ji,jj) = sfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl) * rhoi * r1_Dt_ice
wfx_res(ji,jj) = wfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl) * rhoi * r1_Dt_ice wfx_res(ji,jj) = wfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl) * rhoi * r1_Dt_ice
wfx_res(ji,jj) = wfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl) * rhos * r1_Dt_ice wfx_res(ji,jj) = wfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl) * rhos * r1_Dt_ice
wfx_pnd(ji,jj) = wfx_pnd(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * ( v_ip(ji,jj,jl)+v_il(ji,jj,jl) ) * rhow * r1_Dt_ice wfx_res(ji,jj) = wfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * ( v_ip(ji,jj,jl)+v_il(ji,jj,jl) ) * rhow * r1_Dt_ice
! !
a_i (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj) a_i (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj)
v_i (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj) v_i (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj)
...@@ -640,11 +659,11 @@ CONTAINS ...@@ -640,11 +659,11 @@ CONTAINS
psv_i (ji,jj,jl) = 0._wp psv_i (ji,jj,jl) = 0._wp
ENDIF ENDIF
IF( pv_ip(ji,jj,jl) < 0._wp .OR. pv_il(ji,jj,jl) < 0._wp .OR. pa_ip(ji,jj,jl) <= 0._wp ) THEN IF( pv_ip(ji,jj,jl) < 0._wp .OR. pv_il(ji,jj,jl) < 0._wp .OR. pa_ip(ji,jj,jl) <= 0._wp ) THEN
wfx_pnd(ji,jj) = wfx_pnd(ji,jj) + pv_il(ji,jj,jl) * rhow * z1_dt wfx_res(ji,jj) = wfx_res(ji,jj) + pv_il(ji,jj,jl) * rhow * z1_dt
pv_il (ji,jj,jl) = 0._wp pv_il (ji,jj,jl) = 0._wp
ENDIF ENDIF
IF( pv_ip(ji,jj,jl) < 0._wp .OR. pa_ip(ji,jj,jl) <= 0._wp ) THEN IF( pv_ip(ji,jj,jl) < 0._wp .OR. pa_ip(ji,jj,jl) <= 0._wp ) THEN
wfx_pnd(ji,jj) = wfx_pnd(ji,jj) + pv_ip(ji,jj,jl) * rhow * z1_dt wfx_res(ji,jj) = wfx_res(ji,jj) + pv_ip(ji,jj,jl) * rhow * z1_dt
pv_ip (ji,jj,jl) = 0._wp pv_ip (ji,jj,jl) = 0._wp
ENDIF ENDIF
END_2D END_2D
...@@ -713,15 +732,19 @@ CONTAINS ...@@ -713,15 +732,19 @@ CONTAINS
!! instead of setting everything to zero as just below !! instead of setting everything to zero as just below
bv_i (:,:,:) = 0._wp bv_i (:,:,:) = 0._wp
DO jl = 1, jpl DO jl = 1, jpl
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) DO_3D( 0, 0, 0, 0, 1, nlay_i )
IF( t_i(ji,jj,jk,jl) < rt0 - epsi10 ) THEN IF( t_i(ji,jj,jk,jl) < rt0 - epsi10 ) THEN
bv_i(ji,jj,jl) = bv_i(ji,jj,jl) - rTmlt * sz_i(ji,jj,jk,jl) * r1_nlay_i / ( t_i(ji,jj,jk,jl) - rt0 ) bv_i(ji,jj,jl) = bv_i(ji,jj,jl) - rTmlt * sz_i(ji,jj,jk,jl) * r1_nlay_i / ( t_i(ji,jj,jk,jl) - rt0 )
ENDIF ENDIF
END_3D END_3D
END DO END DO
WHERE( vt_i(:,:) > epsi20 ) ; bvm_i(:,:) = SUM( bv_i(:,:,:) * v_i(:,:,:) , dim=3 ) / vt_i(:,:) DO_2D( 0, 0, 0, 0 )
ELSEWHERE ; bvm_i(:,:) = 0._wp IF( vt_i(ji,jj) > epsi20 ) THEN
END WHERE bvm_i(ji,jj) = SUM( bv_i(ji,jj,:) * v_i(ji,jj,:) ) / vt_i(ji,jj)
ELSE
bvm_i(ji,jj) = 0._wp
ENDIF
END_2D
! !
END SUBROUTINE ice_var_bv END SUBROUTINE ice_var_bv
...@@ -1286,8 +1309,8 @@ CONTAINS ...@@ -1286,8 +1309,8 @@ CONTAINS
!! !!
!!------------------------------------------------------------------- !!-------------------------------------------------------------------
SUBROUTINE ice_var_snwfra_3d( ph_s, pa_s_fra ) SUBROUTINE ice_var_snwfra_3d( ph_s, pa_s_fra )
REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ph_s ! snow thickness REAL(wp), DIMENSION(A2D(0),jpl), INTENT(in ) :: ph_s ! snow thickness
REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pa_s_fra ! ice fraction covered by snow REAL(wp), DIMENSION(A2D(0),jpl), INTENT( out) :: pa_s_fra ! ice fraction covered by snow
IF ( nn_snwfra == 0 ) THEN ! basic 0 or 1 snow cover IF ( nn_snwfra == 0 ) THEN ! basic 0 or 1 snow cover
WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp
ELSEWHERE ; pa_s_fra = 0._wp ELSEWHERE ; pa_s_fra = 0._wp
...@@ -1344,8 +1367,8 @@ CONTAINS ...@@ -1344,8 +1367,8 @@ CONTAINS
!!-------------------------------------------------------------------------- !!--------------------------------------------------------------------------
!!gm I think it can be usefull to set this as a FUNCTION, not a SUBROUTINE.... !!gm I think it can be usefull to set this as a FUNCTION, not a SUBROUTINE....
SUBROUTINE ice_var_snwblow_2d( pin, pout ) SUBROUTINE ice_var_snwblow_2d( pin, pout )
REAL(wp), DIMENSION(:,:), INTENT(in ) :: pin ! previous fraction lead ( 1. - a_i_b ) REAL(wp), DIMENSION(A2D(0)), INTENT(in ) :: pin ! previous fraction lead ( 1. - a_i_b )
REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout REAL(wp), DIMENSION(A2D(0)), INTENT(inout) :: pout
pout = ( 1._wp - ( pin )**rn_snwblow ) pout = ( 1._wp - ( pin )**rn_snwblow )
END SUBROUTINE ice_var_snwblow_2d END SUBROUTINE ice_var_snwblow_2d
......
src/ICE/icewri.F90
View file @ 4dbfc9bb
...@@ -26,7 +26,6 @@ MODULE icewri ...@@ -26,7 +26,6 @@ MODULE icewri
USE iom ! I/O manager library USE iom ! I/O manager library
USE lib_mpp ! MPP library USE lib_mpp ! MPP library
USE lib_fortran ! fortran utilities (glob_sum + no signed zero) USE lib_fortran ! fortran utilities (glob_sum + no signed zero)
USE lbclnk ! lateral boundary conditions (or mpp links)
USE timing ! Timing USE timing ! Timing
IMPLICIT NONE IMPLICIT NONE
...@@ -53,10 +52,10 @@ CONTAINS ...@@ -53,10 +52,10 @@ CONTAINS
INTEGER :: ji, jj, jk, jl ! dummy loop indices INTEGER :: ji, jj, jk, jl ! dummy loop indices
REAL(wp) :: z2da, z2db, zrho1, zrho2 REAL(wp) :: z2da, z2db, zrho1, zrho2
REAL(wp) :: zmiss_val ! missing value retrieved from xios REAL(wp) :: zmiss_val ! missing value retrieved from xios
REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace REAL(wp), DIMENSION(A2D(0)) :: z2d ! 2D workspace
REAL(wp), DIMENSION(jpi,jpj) :: zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask REAL(wp), DIMENSION(A2D(0)) :: zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask
REAL(wp), DIMENSION(jpi,jpj,jpl) :: zmsk00l, zmsksnl ! cat masks REAL(wp), DIMENSION(A2D(0),jpl) :: zmsk00l, zmsksnl ! cat masks
REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zfast, zalb, zmskalb ! 2D workspace REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zfast, zalb, zmskalb ! 2D workspace
! !
! Global ice diagnostics (SIMIP) ! Global ice diagnostics (SIMIP)
REAL(wp) :: zdiag_area_nh, zdiag_extt_nh, zdiag_volu_nh ! area, extent, volume REAL(wp) :: zdiag_area_nh, zdiag_extt_nh, zdiag_volu_nh ! area, extent, volume
...@@ -72,14 +71,14 @@ CONTAINS ...@@ -72,14 +71,14 @@ CONTAINS
CALL ice_var_bv CALL ice_var_bv
! tresholds for outputs ! tresholds for outputs
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice
zmsk05(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05_wp ) ) ! 1 if 5% ice , 0 if less zmsk05(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05_wp ) ) ! 1 if 5% ice , 0 if less
zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less
zmsksn(ji,jj) = MAX( 0._wp , SIGN( 1._wp , vt_s(ji,jj) - epsi06 ) ) ! 1 if snow , 0 if no snow zmsksn(ji,jj) = MAX( 0._wp , SIGN( 1._wp , vt_s(ji,jj) - epsi06 ) ) ! 1 if snow , 0 if no snow
END_2D END_2D
DO jl = 1, jpl DO jl = 1, jpl
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
zmsk00l(ji,jj,jl) = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) zmsk00l(ji,jj,jl) = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
zmsksnl(ji,jj,jl) = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi06 ) ) zmsksnl(ji,jj,jl) = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi06 ) )
END_2D END_2D
...@@ -96,102 +95,111 @@ CONTAINS ...@@ -96,102 +95,111 @@ CONTAINS
CALL iom_put( 'icepres' , zmsk00 ) ! Ice presence (1 or 0) CALL iom_put( 'icepres' , zmsk00 ) ! Ice presence (1 or 0)
! !
! general fields ! general fields
IF( iom_use('icemass' ) ) CALL iom_put( 'icemass', vt_i * rhoi * zmsk00 ) ! Ice mass per cell area IF( iom_use('icemass' ) ) CALL iom_put( 'icemass', vt_i(A2D(0)) * rhoi * zmsk00 ) ! Ice mass per cell area
IF( iom_use('snwmass' ) ) CALL iom_put( 'snwmass', vt_s * rhos * zmsksn ) ! Snow mass per cell area IF( iom_use('snwmass' ) ) CALL iom_put( 'snwmass', vt_s(A2D(0)) * rhos * zmsksn ) ! Snow mass per cell area
IF( iom_use('iceconc' ) ) CALL iom_put( 'iceconc', at_i * zmsk00 ) ! ice concentration IF( iom_use('iceconc' ) ) CALL iom_put( 'iceconc', at_i(A2D(0)) * zmsk00 ) ! ice concentration
IF( iom_use('icevolu' ) ) CALL iom_put( 'icevolu', vt_i * zmsk00 ) ! ice volume = mean ice thickness over the cell IF( iom_use('icevolu' ) ) CALL iom_put( 'icevolu', vt_i(A2D(0)) * zmsk00 ) ! ice volume = mean ice thickness over the cell
IF( iom_use('icethic' ) ) CALL iom_put( 'icethic', hm_i * zmsk00 ) ! ice thickness IF( iom_use('icethic' ) ) CALL iom_put( 'icethic', hm_i(:,:) * zmsk00 ) ! ice thickness
IF( iom_use('snwthic' ) ) CALL iom_put( 'snwthic', hm_s * zmsk00 ) ! snw thickness IF( iom_use('snwthic' ) ) CALL iom_put( 'snwthic', hm_s(:,:) * zmsk00 ) ! snw thickness
IF( iom_use('icebrv' ) ) CALL iom_put( 'icebrv' , bvm_i* 100. * zmsk00 ) ! brine volume IF( iom_use('icebrv' ) ) CALL iom_put( 'icebrv' , bvm_i(:,:)* 100. * zmsk00 ) ! brine volume
IF( iom_use('iceage' ) ) CALL iom_put( 'iceage' , om_i / rday * zmsk15 + zmiss_val * ( 1._wp - zmsk15 ) ) ! ice age IF( iom_use('iceage' ) ) CALL iom_put( 'iceage' , om_i(:,:) / rday * zmsk15 + zmiss_val * ( 1._wp - zmsk15 ) ) ! ice age
IF( iom_use('icehnew' ) ) CALL iom_put( 'icehnew', ht_i_new ) ! new ice thickness formed in the leads IF( iom_use('icehnew' ) ) CALL iom_put( 'icehnew', ht_i_new(:,:) ) ! new ice thickness formed in the leads
IF( iom_use('snwvolu' ) ) CALL iom_put( 'snwvolu', vt_s * zmsksn ) ! snow volume IF( iom_use('snwvolu' ) ) CALL iom_put( 'snwvolu', vt_s(A2D(0)) * zmsksn ) ! snow volume
IF( iom_use('icefrb' ) ) THEN ! Ice freeboard IF( iom_use('icefrb' ) ) THEN ! Ice freeboard
z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) ) z2d(:,:) = zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:)
WHERE( z2d < 0._wp ) z2d = 0._wp WHERE( z2d < 0._wp ) z2d = 0._wp
CALL iom_put( 'icefrb' , z2d * zmsk00 ) CALL iom_put( 'icefrb' , z2d * zmsk00 )
ENDIF ENDIF
! melt ponds ! melt ponds
IF( iom_use('iceapnd' ) ) CALL iom_put( 'iceapnd', at_ip * zmsk00 ) ! melt pond total fraction IF( iom_use('iceapnd' ) ) CALL iom_put( 'iceapnd', at_ip(A2D(0)) * zmsk00 ) ! melt pond total fraction
IF( iom_use('icehpnd' ) ) CALL iom_put( 'icehpnd', hm_ip * zmsk00 ) ! melt pond depth IF( iom_use('icehpnd' ) ) CALL iom_put( 'icehpnd', hm_ip(:,:) * zmsk00 ) ! melt pond depth
IF( iom_use('icevpnd' ) ) CALL iom_put( 'icevpnd', vt_ip * zmsk00 ) ! melt pond total volume per unit area IF( iom_use('icevpnd' ) ) CALL iom_put( 'icevpnd', vt_ip(A2D(0)) * zmsk00 ) ! melt pond total volume per unit area
IF( iom_use('icehlid' ) ) CALL iom_put( 'icehlid', hm_il * zmsk00 ) ! melt pond lid depth IF( iom_use('icehlid' ) ) CALL iom_put( 'icehlid', hm_il(:,:) * zmsk00 ) ! melt pond lid depth
IF( iom_use('icevlid' ) ) CALL iom_put( 'icevlid', vt_il * zmsk00 ) ! melt pond lid total volume per unit area IF( iom_use('icevlid' ) ) CALL iom_put( 'icevlid', vt_il(A2D(0)) * zmsk00 ) ! melt pond lid total volume per unit area
! salt ! salt
IF( iom_use('icesalt' ) ) CALL iom_put( 'icesalt', sm_i * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! mean ice salinity IF( iom_use('icesalt' ) ) CALL iom_put( 'icesalt', sm_i(:,:) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! mean ice salinity
IF( iom_use('icesalm' ) ) CALL iom_put( 'icesalm', st_i * rhoi * 1.0e-3 * zmsk00 ) ! Mass of salt in sea ice per cell area IF( iom_use('icesalm' ) ) CALL iom_put( 'icesalm', st_i(:,:) * rhoi * 1.0e-3 * zmsk00 ) ! Mass of salt in sea ice per cell area
! heat ! heat
IF( iom_use('icetemp' ) ) CALL iom_put( 'icetemp', ( tm_i - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! ice mean temperature IF( iom_use('icetemp' ) ) CALL iom_put( 'icetemp', ( tm_i(:,:) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! ice mean temperature
IF( iom_use('snwtemp' ) ) CALL iom_put( 'snwtemp', ( tm_s - rt0 ) * zmsksn + zmiss_val * ( 1._wp - zmsksn ) ) ! snw mean temperature IF( iom_use('snwtemp' ) ) CALL iom_put( 'snwtemp', ( tm_s(:,:) - rt0 ) * zmsksn + zmiss_val * ( 1._wp - zmsksn ) ) ! snw mean temperature
IF( iom_use('icettop' ) ) CALL iom_put( 'icettop', ( tm_su - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice surface IF( iom_use('icettop' ) ) CALL iom_put( 'icettop', ( tm_su(:,:) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice surface
IF( iom_use('icetbot' ) ) CALL iom_put( 'icetbot', ( t_bo - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice bottom IF( iom_use('icetbot' ) ) CALL iom_put( 'icetbot', ( t_bo(A2D(0)) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the ice bottom
IF( iom_use('icetsni' ) ) CALL iom_put( 'icetsni', ( tm_si - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the snow-ice interface IF( iom_use('icetsni' ) ) CALL iom_put( 'icetsni', ( tm_si(:,:) - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! temperature at the snow-ice interface
IF( iom_use('icehc' ) ) CALL iom_put( 'icehc' , -et_i * zmsk00 ) ! ice heat content IF( iom_use('icehc' ) ) CALL iom_put( 'icehc' , -et_i(:,:) * zmsk00 ) ! ice heat content
IF( iom_use('snwhc' ) ) CALL iom_put( 'snwhc' , -et_s * zmsksn ) ! snow heat content IF( iom_use('snwhc' ) ) CALL iom_put( 'snwhc' , -et_s(:,:) * zmsksn ) ! snow heat content
! momentum ! momentum
IF( iom_use('uice' ) ) CALL iom_put( 'uice' , u_ice ) ! ice velocity u IF( iom_use('uice' ) ) CALL iom_put( 'uice' , u_ice(A2D(0)) ) ! ice velocity u
IF( iom_use('vice' ) ) CALL iom_put( 'vice' , v_ice ) ! ice velocity v IF( iom_use('vice' ) ) CALL iom_put( 'vice' , v_ice(A2D(0)) ) ! ice velocity v
! !
IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN ! module of ice velocity & fast ice IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN ! module of ice velocity & fast ice
ALLOCATE( zfast(jpi,jpj) ) ALLOCATE( zfast(A2D(0)) )
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
z2da = u_ice(ji,jj) + u_ice(ji-1,jj) z2da = u_ice(ji,jj) + u_ice(ji-1,jj)
z2db = v_ice(ji,jj) + v_ice(ji,jj-1) z2db = v_ice(ji,jj) + v_ice(ji,jj-1)
z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db ) z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db )
END_2D END_2D
CALL lbc_lnk( 'icewri', z2d, 'T', 1.0_wp )
CALL iom_put( 'icevel', z2d ) CALL iom_put( 'icevel', z2d )
WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp ! record presence of fast ice WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp ! record presence of fast ice
ELSEWHERE ; zfast(:,:) = 0._wp ELSEWHERE ; zfast(:,:) = 0._wp
END WHERE END WHERE
CALL iom_put( 'fasticepres', zfast ) CALL iom_put( 'fasticepres', zfast )
DEALLOCATE( zfast ) DEALLOCATE( zfast )
ENDIF ENDIF
! !
IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN ! ice albedo and surface albedo IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN ! ice albedo and surface albedo
ALLOCATE( zalb(jpi,jpj), zmskalb(jpi,jpj) ) ALLOCATE( zalb(A2D(0)), zmskalb(A2D(0)) )
! ice albedo ! ice albedo
WHERE( at_i_b < 1.e-03 ) WHERE( at_i_b(:,:) < 1.e-03 )
zmskalb(:,:) = 0._wp zmskalb(:,:) = 0._wp
zalb (:,:) = rn_alb_oce zalb (:,:) = rn_alb_oce
ELSEWHERE ELSEWHERE
zmskalb(:,:) = 1._wp zmskalb(:,:) = 1._wp
zalb (:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b zalb (:,:) = SUM( alb_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) / at_i_b(:,:)
END WHERE END WHERE
CALL iom_put( 'icealb' , zalb * zmskalb + zmiss_val * ( 1._wp - zmskalb ) ) CALL iom_put( 'icealb' , zalb * zmskalb + zmiss_val * ( 1._wp - zmskalb ) )
! ice+ocean albedo ! ice+ocean albedo
zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b ) zalb(:,:) = SUM( alb_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b(:,:) )
CALL iom_put( 'albedo' , zalb ) CALL iom_put( 'albedo' , zalb )
DEALLOCATE( zalb, zmskalb ) DEALLOCATE( zalb, zmskalb )
ENDIF ENDIF
! !
! --- category-dependent fields --- ! ! --- category-dependent fields --- !
IF( iom_use('icemask_cat' ) ) CALL iom_put( 'icemask_cat' , zmsk00l ) ! ice mask 0% IF( iom_use('icemask_cat' ) ) CALL iom_put( 'icemask_cat' , zmsk00l ) ! ice mask 0%
IF( iom_use('iceconc_cat' ) ) CALL iom_put( 'iceconc_cat' , a_i * zmsk00l ) ! area for categories IF( iom_use('iceconc_cat' ) ) CALL iom_put( 'iceconc_cat' , a_i(A2D(0),:) * zmsk00l ) ! area for categories
IF( iom_use('icethic_cat' ) ) CALL iom_put( 'icethic_cat' , h_i * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! thickness for categories IF( iom_use('icethic_cat' ) ) CALL iom_put( 'icethic_cat' , h_i(A2D(0),:) * zmsk00l + zmiss_val &
IF( iom_use('snwthic_cat' ) ) CALL iom_put( 'snwthic_cat' , h_s * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow depth for categories & * ( 1._wp - zmsk00l ) ) ! thickness for categories
IF( iom_use('icesalt_cat' ) ) CALL iom_put( 'icesalt_cat' , s_i * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! salinity for categories IF( iom_use('snwthic_cat' ) ) CALL iom_put( 'snwthic_cat' , h_s(A2D(0),:) * zmsksnl + zmiss_val &
IF( iom_use('iceage_cat' ) ) CALL iom_put( 'iceage_cat' , o_i / rday * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice age & * ( 1._wp - zmsksnl ) ) ! snow depth for categories
IF( iom_use('icetemp_cat' ) ) CALL iom_put( 'icetemp_cat' , ( SUM( t_i, dim=3 ) * r1_nlay_i - rt0 ) & IF( iom_use('icesalt_cat' ) ) CALL iom_put( 'icesalt_cat' , s_i(A2D(0),:) * zmsk00l + zmiss_val &
& * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice temperature & * ( 1._wp - zmsk00l ) ) ! salinity for categories
IF( iom_use('snwtemp_cat' ) ) CALL iom_put( 'snwtemp_cat' , ( SUM( t_s, dim=3 ) * r1_nlay_s - rt0 ) & IF( iom_use('iceage_cat' ) ) CALL iom_put( 'iceage_cat' , o_i(A2D(0),:) / rday * zmsk00l + zmiss_val &
& * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow temperature & * ( 1._wp - zmsk00l ) ) ! ice age
IF( iom_use('icettop_cat' ) ) CALL iom_put( 'icettop_cat' , ( t_su - rt0 ) * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! surface temperature IF( iom_use('icetemp_cat' ) ) CALL iom_put( 'icetemp_cat' , ( SUM( t_i(A2D(0),:,:), dim=3 ) * r1_nlay_i - rt0 ) &
IF( iom_use('icebrv_cat' ) ) CALL iom_put( 'icebrv_cat' , bv_i * 100. * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! brine volume & * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice temperature
IF( iom_use('iceapnd_cat' ) ) CALL iom_put( 'iceapnd_cat' , a_ip * zmsk00l ) ! melt pond frac for categories IF( iom_use('snwtemp_cat' ) ) CALL iom_put( 'snwtemp_cat' , ( SUM( t_s(A2D(0),:,:), dim=3 ) * r1_nlay_s - rt0 ) &
IF( iom_use('icevpnd_cat' ) ) CALL iom_put( 'icevpnd_cat' , v_ip * zmsk00l ) ! melt pond volume for categories & * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow temperature
IF( iom_use('icehpnd_cat' ) ) CALL iom_put( 'icehpnd_cat' , h_ip * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond thickness for categories IF( iom_use('icettop_cat' ) ) CALL iom_put( 'icettop_cat' , ( t_su(A2D(0),:) - rt0 ) * zmsk00l + zmiss_val &
IF( iom_use('icehlid_cat' ) ) CALL iom_put( 'icehlid_cat' , h_il * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond lid thickness for categories & * ( 1._wp - zmsk00l ) ) ! surface temperature
IF( iom_use('iceafpnd_cat') ) CALL iom_put( 'iceafpnd_cat', a_ip_frac * zmsk00l ) ! melt pond frac per ice area for categories IF( iom_use('icebrv_cat' ) ) CALL iom_put( 'icebrv_cat' , bv_i(:,:,:) * 100. * zmsk00l + zmiss_val &
IF( iom_use('iceaepnd_cat') ) CALL iom_put( 'iceaepnd_cat', a_ip_eff * zmsk00l ) ! melt pond effective frac for categories & * ( 1._wp - zmsk00l ) ) ! brine volume
IF( iom_use('icealb_cat' ) ) CALL iom_put( 'icealb_cat' , alb_ice * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice albedo for categories IF( iom_use('iceapnd_cat' ) ) CALL iom_put( 'iceapnd_cat' , a_ip(A2D(0),:) * zmsk00l ) ! melt pond frac for categories
IF( iom_use('icevpnd_cat' ) ) CALL iom_put( 'icevpnd_cat' , v_ip(A2D(0),:) * zmsk00l ) ! melt pond volume for categories
IF( iom_use('icehpnd_cat' ) ) CALL iom_put( 'icehpnd_cat' , h_ip(A2D(0),:) * zmsk00l + zmiss_val &
& * ( 1._wp - zmsk00l ) ) ! melt pond thickness for categories
IF( iom_use('icehlid_cat' ) ) CALL iom_put( 'icehlid_cat' , h_il(A2D(0),:) * zmsk00l + zmiss_val &
& * ( 1._wp - zmsk00l ) ) ! melt pond lid thickness for categories
IF( iom_use('iceafpnd_cat') ) CALL iom_put( 'iceafpnd_cat', a_ip_frac(:,:,:) * zmsk00l ) ! melt pond frac per ice area for categories
IF( iom_use('iceaepnd_cat') ) CALL iom_put( 'iceaepnd_cat', a_ip_eff(:,:,:) * zmsk00l ) ! melt pond effective frac for categories
IF( iom_use('icealb_cat' ) ) CALL iom_put( 'icealb_cat' , alb_ice(:,:,:) * zmsk00l + zmiss_val &
& * ( 1._wp - zmsk00l ) ) ! ice albedo for categories
!------------------ !------------------
! Add-ons for SIMIP ! Add-ons for SIMIP
!------------------ !------------------
! trends ! trends
IF( iom_use('dmithd') ) CALL iom_put( 'dmithd', - wfx_bog - wfx_bom - wfx_sum - wfx_sni - wfx_opw - wfx_lam - wfx_res ) ! Sea-ice mass change from thermodynamics IF( iom_use('dmithd') ) CALL iom_put( 'dmithd', - wfx_bog(:,:) - wfx_bom(:,:) - wfx_sum(:,:) - wfx_sni(:,:) &
& - wfx_opw(:,:) - wfx_lam(:,:) - wfx_res(A2D(0)) ) ! Sea-ice mass change from thermodynamics
IF( iom_use('dmidyn') ) CALL iom_put( 'dmidyn', - wfx_dyn + rhoi * diag_trp_vi ) ! Sea-ice mass change from dynamics(kg/m2/s) IF( iom_use('dmidyn') ) CALL iom_put( 'dmidyn', - wfx_dyn + rhoi * diag_trp_vi ) ! Sea-ice mass change from dynamics(kg/m2/s)
IF( iom_use('dmiopw') ) CALL iom_put( 'dmiopw', - wfx_opw ) ! Sea-ice mass change through growth in open water IF( iom_use('dmiopw') ) CALL iom_put( 'dmiopw', - wfx_opw ) ! Sea-ice mass change through growth in open water
IF( iom_use('dmibog') ) CALL iom_put( 'dmibog', - wfx_bog ) ! Sea-ice mass change through basal growth IF( iom_use('dmibog') ) CALL iom_put( 'dmibog', - wfx_bog ) ! Sea-ice mass change through basal growth
...@@ -211,17 +219,23 @@ CONTAINS ...@@ -211,17 +219,23 @@ CONTAINS
IF( iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') .OR. & IF( iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') .OR. &
& iom_use('SH_icearea') .OR. iom_use('SH_icevolu') .OR. iom_use('SH_iceextt') ) THEN & iom_use('SH_icearea') .OR. iom_use('SH_icevolu') .OR. iom_use('SH_iceextt') ) THEN
! !
WHERE( ff_t(:,:) > 0._wp ) ; z2d(:,:) = 1._wp WHERE( ff_t(A2D(0)) > 0._wp ) ; z2d(:,:) = 1._wp
ELSEWHERE ; z2d(:,:) = 0. ELSEWHERE ; z2d(:,:) = 0.
END WHERE END WHERE
! !
IF( iom_use('NH_icearea') ) zdiag_area_nh = glob_sum( 'icewri', at_i * z2d * e1e2t * 1.e-12 ) IF( iom_use('NH_icearea') ) zdiag_area_nh = glob_sum( 'icewri', at_i(A2D(0)) * z2d * e1e2t(A2D(0)) &
IF( iom_use('NH_icevolu') ) zdiag_volu_nh = glob_sum( 'icewri', vt_i * z2d * e1e2t * 1.e-12 ) & * 1.e-12 )
IF( iom_use('NH_iceextt') ) zdiag_extt_nh = glob_sum( 'icewri', z2d * e1e2t * 1.e-12 * zmsk15 ) IF( iom_use('NH_icevolu') ) zdiag_volu_nh = glob_sum( 'icewri', vt_i(A2D(0)) * z2d * e1e2t(A2D(0)) &
& * 1.e-12 )
IF( iom_use('NH_iceextt') ) zdiag_extt_nh = glob_sum( 'icewri', z2d * e1e2t(A2D(0)) &
& * 1.e-12 * zmsk15 )
! !
IF( iom_use('SH_icearea') ) zdiag_area_sh = glob_sum( 'icewri', at_i * ( 1._wp - z2d ) * e1e2t * 1.e-12 ) IF( iom_use('SH_icearea') ) zdiag_area_sh = glob_sum( 'icewri', at_i(A2D(0)) * ( 1._wp - z2d ) * e1e2t(A2D(0)) &
IF( iom_use('SH_icevolu') ) zdiag_volu_sh = glob_sum( 'icewri', vt_i * ( 1._wp - z2d ) * e1e2t * 1.e-12 ) & * 1.e-12 )
IF( iom_use('SH_iceextt') ) zdiag_extt_sh = glob_sum( 'icewri', ( 1._wp - z2d ) * e1e2t * 1.e-12 * zmsk15 ) IF( iom_use('SH_icevolu') ) zdiag_volu_sh = glob_sum( 'icewri', vt_i(A2D(0)) * ( 1._wp - z2d ) * e1e2t(A2D(0)) &
& * 1.e-12 )
IF( iom_use('SH_iceextt') ) zdiag_extt_sh = glob_sum( 'icewri', ( 1._wp - z2d ) * e1e2t(A2D(0)) &
& * 1.e-12 * zmsk15 )
! !
CALL iom_put( 'NH_icearea' , zdiag_area_nh ) CALL iom_put( 'NH_icearea' , zdiag_area_nh )
CALL iom_put( 'NH_icevolu' , zdiag_volu_nh ) CALL iom_put( 'NH_icevolu' , zdiag_volu_nh )
...@@ -258,25 +272,25 @@ CONTAINS ...@@ -258,25 +272,25 @@ CONTAINS
! !
!! The file is open in dia_wri_state (ocean routine) !! The file is open in dia_wri_state (ocean routine)
CALL iom_rstput( 0, 0, kid, 'sithic', hm_i ) ! Ice thickness CALL iom_rstput( 0, 0, kid, 'sithic', hm_i(A2D(0)) ) ! Ice thickness
CALL iom_rstput( 0, 0, kid, 'siconc', at_i ) ! Ice concentration CALL iom_rstput( 0, 0, kid, 'siconc', at_i(A2D(0)) ) ! Ice concentration
CALL iom_rstput( 0, 0, kid, 'sitemp', tm_i - rt0 ) ! Ice temperature CALL iom_rstput( 0, 0, kid, 'sitemp', tm_i(A2D(0)) - rt0 ) ! Ice temperature
CALL iom_rstput( 0, 0, kid, 'sivelu', u_ice ) ! i-Ice speed CALL iom_rstput( 0, 0, kid, 'sivelu', u_ice(A2D(0)) ) ! i-Ice speed
CALL iom_rstput( 0, 0, kid, 'sivelv', v_ice ) ! j-Ice speed CALL iom_rstput( 0, 0, kid, 'sivelv', v_ice(A2D(0)) ) ! j-Ice speed
CALL iom_rstput( 0, 0, kid, 'sistru', utau_ice ) ! i-Wind stress over ice CALL iom_rstput( 0, 0, kid, 'sistru', utau_ice(A2D(0)) ) ! i-Wind stress over ice
CALL iom_rstput( 0, 0, kid, 'sistrv', vtau_ice ) ! i-Wind stress over ice CALL iom_rstput( 0, 0, kid, 'sistrv', vtau_ice(A2D(0)) ) ! i-Wind stress over ice
CALL iom_rstput( 0, 0, kid, 'sisflx', qsr ) ! Solar flx over ocean CALL iom_rstput( 0, 0, kid, 'sisflx', qsr(A2D(0)) ) ! Solar flx over ocean
CALL iom_rstput( 0, 0, kid, 'sinflx', qns ) ! NonSolar flx over ocean CALL iom_rstput( 0, 0, kid, 'sinflx', qns(A2D(0)) ) ! NonSolar flx over ocean
CALL iom_rstput( 0, 0, kid, 'snwpre', sprecip ) ! Snow precipitation CALL iom_rstput( 0, 0, kid, 'snwpre', sprecip(A2D(0)) ) ! Snow precipitation
CALL iom_rstput( 0, 0, kid, 'sisali', sm_i ) ! Ice salinity CALL iom_rstput( 0, 0, kid, 'sisali', sm_i(A2D(0)) ) ! Ice salinity
CALL iom_rstput( 0, 0, kid, 'sivolu', vt_i ) ! Ice volume CALL iom_rstput( 0, 0, kid, 'sivolu', vt_i(A2D(0)) ) ! Ice volume
CALL iom_rstput( 0, 0, kid, 'sidive', divu_i*1.0e8 ) ! Ice divergence CALL iom_rstput( 0, 0, kid, 'sidive', divu_i(A2D(0))*1.0e8 ) ! Ice divergence
CALL iom_rstput( 0, 0, kid, 'si_amp', at_ip ) ! Melt pond fraction CALL iom_rstput( 0, 0, kid, 'si_amp', at_ip(A2D(0)) ) ! Melt pond fraction
CALL iom_rstput( 0, 0, kid, 'si_vmp', vt_ip ) ! Melt pond volume CALL iom_rstput( 0, 0, kid, 'si_vmp', vt_ip(A2D(0)) ) ! Melt pond volume
CALL iom_rstput( 0, 0, kid, 'sithicat', h_i ) ! Ice thickness CALL iom_rstput( 0, 0, kid, 'sithicat', h_i(A2D(0),:) ) ! Ice thickness
CALL iom_rstput( 0, 0, kid, 'siconcat', a_i ) ! Ice concentration CALL iom_rstput( 0, 0, kid, 'siconcat', a_i(A2D(0),:) ) ! Ice concentration
CALL iom_rstput( 0, 0, kid, 'sisalcat', s_i ) ! Ice salinity CALL iom_rstput( 0, 0, kid, 'sisalcat', s_i(A2D(0),:) ) ! Ice salinity
CALL iom_rstput( 0, 0, kid, 'snthicat', h_s ) ! Snw thickness CALL iom_rstput( 0, 0, kid, 'snthicat', h_s(A2D(0),:) ) ! Snw thickness
END SUBROUTINE ice_wri_state END SUBROUTINE ice_wri_state
......
src/NST/agrif_all_update.F90
View file @ 4dbfc9bb
...@@ -112,12 +112,10 @@ CONTAINS ...@@ -112,12 +112,10 @@ CONTAINS
CALL dom_qco_zgr( Kbb_a, Kmm_a ) CALL dom_qco_zgr( Kbb_a, Kmm_a )
#endif #endif
#if defined key_si3 #if defined key_si3
CALL lbc_lnk( 'finalize_lbc_for_agrif', a_i, 'T',1._wp, v_i,'T',1._wp, & CALL lbc_lnk( 'finalize_lbc_for_agrif', a_i, 'T',1._wp, v_i,'T',1._wp, &
& v_s, 'T',1._wp, sv_i,'T',1._wp, oa_i,'T',1._wp, & & v_s, 'T',1._wp, sv_i,'T',1._wp, oa_i,'T',1._wp, &
& a_ip,'T',1._wp, v_ip,'T',1._wp, v_il,'T',1._wp ) & a_ip,'T',1._wp, v_ip,'T',1._wp, v_il,'T',1._wp, t_su,'T',1._wp )
CALL lbc_lnk( 'finalize_lbc_for_agrif', t_su,'T',1._wp ) CALL lbc_lnk( 'finalize_lbc_for_agrif', e_i,'T',1._wp, e_s,'T',1._wp )
CALL lbc_lnk( 'finalize_lbc_for_agrif', e_s,'T',1._wp )
CALL lbc_lnk( 'finalize_lbc_for_agrif', e_i,'T',1._wp )
CALL lbc_lnk( 'finalize_lbc_for_agrif', u_ice, 'U', -1._wp, v_ice, 'V', -1._wp ) CALL lbc_lnk( 'finalize_lbc_for_agrif', u_ice, 'U', -1._wp, v_ice, 'V', -1._wp )
#endif #endif
#if defined key_top #if defined key_top
......
src/NST/agrif_ice_interp.F90
View file @ 4dbfc9bb
...@@ -64,12 +64,10 @@ CONTAINS ...@@ -64,12 +64,10 @@ CONTAINS
CALL Agrif_Set_MaskMaxSearch(10) CALL Agrif_Set_MaskMaxSearch(10)
CALL Agrif_init_variable(tra_iceini_id,procname=interp_tra_ice) CALL Agrif_init_variable(tra_iceini_id,procname=interp_tra_ice)
! !
CALL lbc_lnk( 'agrif_istate_ice', a_i,'T',1._wp, v_i,'T',1._wp, & CALL lbc_lnk( 'agrif_istate_ice', a_i,'T',1._wp, v_i,'T',1._wp, &
& v_s,'T',1._wp, sv_i,'T',1._wp, oa_i,'T',1._wp, & & v_s,'T',1._wp, sv_i,'T',1._wp, oa_i,'T',1._wp, &
& a_ip,'T',1._wp, v_ip,'T',1._wp, v_il,'T',1._wp ) & a_ip,'T',1._wp, v_ip,'T',1._wp, v_il,'T',1._wp, t_su,'T',1._wp )
CALL lbc_lnk( 'agrif_istate_ice', t_su,'T',1._wp ) CALL lbc_lnk( 'agrif_istate_ice', e_i,'T',1._wp, e_s,'T',1._wp )
CALL lbc_lnk( 'agrif_istate_ice', e_s,'T',1._wp )
CALL lbc_lnk( 'agrif_istate_ice', e_i,'T',1._wp )
! !
! Set u_ice, v_ice: ! Set u_ice, v_ice:
use_sign_north = .TRUE. use_sign_north = .TRUE.
......
src/NST/agrif_oce_interp.F90
View file @ 4dbfc9bb
...@@ -272,7 +272,7 @@ CONTAINS ...@@ -272,7 +272,7 @@ CONTAINS
ibdy2 = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells ibdy2 = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
! !
IF( .NOT.ln_dynspg_ts ) THEN ! Store transport IF( .NOT.ln_dynspg_ts ) THEN ! Store transport
DO ji = mi0(ibdy1), mi1(ibdy2) DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a) uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a) vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
...@@ -280,7 +280,7 @@ CONTAINS ...@@ -280,7 +280,7 @@ CONTAINS
END DO END DO
ENDIF ENDIF
! !
DO ji = mi0(ibdy1), mi1(ibdy2) DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
zub(ji,:) = 0._wp zub(ji,:) = 0._wp
zhub(ji,:) = 0._wp zhub(ji,:) = 0._wp
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -302,7 +302,7 @@ CONTAINS ...@@ -302,7 +302,7 @@ CONTAINS
END DO END DO
END DO END DO
! !
DO ji = mi0(ibdy1), mi1(ibdy2) DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
zvb(ji,:) = 0._wp zvb(ji,:) = 0._wp
zhvb(ji,:) = 0._wp zhvb(ji,:) = 0._wp
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -332,14 +332,14 @@ CONTAINS ...@@ -332,14 +332,14 @@ CONTAINS
ibdy2 = jpiglo - ( nn_hls + 2 ) ibdy2 = jpiglo - ( nn_hls + 2 )
! !
IF( .NOT.ln_dynspg_ts ) THEN IF( .NOT.ln_dynspg_ts ) THEN
DO ji = mi0(ibdy1), mi1(ibdy2) DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a) uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
END DO END DO
END DO END DO
ENDIF ENDIF
! !
DO ji = mi0(ibdy1), mi1(ibdy2) DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
zub(ji,:) = 0._wp zub(ji,:) = 0._wp
zhub(ji,:) = 0._wp zhub(ji,:) = 0._wp
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -365,14 +365,14 @@ CONTAINS ...@@ -365,14 +365,14 @@ CONTAINS
ibdy2 = jpiglo - ( nn_hls + 1 ) ibdy2 = jpiglo - ( nn_hls + 1 )
! !
IF( .NOT.ln_dynspg_ts ) THEN IF( .NOT.ln_dynspg_ts ) THEN
DO ji = mi0(ibdy1), mi1(ibdy2) DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a) vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
END DO END DO
END DO END DO
ENDIF ENDIF
! !
DO ji = mi0(ibdy1), mi1(ibdy2) DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
zvb(ji,:) = 0._wp zvb(ji,:) = 0._wp
zhvb(ji,:) = 0._wp zhvb(ji,:) = 0._wp
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -402,7 +402,7 @@ CONTAINS ...@@ -402,7 +402,7 @@ CONTAINS
jbdy2 = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy() jbdy2 = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()
! !
IF( .NOT.ln_dynspg_ts ) THEN IF( .NOT.ln_dynspg_ts ) THEN
DO jj = mj0(jbdy1), mj1(jbdy2) DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a) uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a) vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
...@@ -410,7 +410,7 @@ CONTAINS ...@@ -410,7 +410,7 @@ CONTAINS
END DO END DO
ENDIF ENDIF
! !
DO jj = mj0(jbdy1), mj1(jbdy2) DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
zvb(:,jj) = 0._wp zvb(:,jj) = 0._wp
zhvb(:,jj) = 0._wp zhvb(:,jj) = 0._wp
DO jk=1,jpkm1 DO jk=1,jpkm1
...@@ -432,7 +432,7 @@ CONTAINS ...@@ -432,7 +432,7 @@ CONTAINS
END DO END DO
END DO END DO
! !
DO jj = mj0(jbdy1), mj1(jbdy2) DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
zub(:,jj) = 0._wp zub(:,jj) = 0._wp
zhub(:,jj) = 0._wp zhub(:,jj) = 0._wp
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -462,14 +462,14 @@ CONTAINS ...@@ -462,14 +462,14 @@ CONTAINS
jbdy2 = jpjglo - ( nn_hls + 2 ) jbdy2 = jpjglo - ( nn_hls + 2 )
! !
IF( .NOT.ln_dynspg_ts ) THEN IF( .NOT.ln_dynspg_ts ) THEN
DO jj = mj0(jbdy1), mj1(jbdy2) DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a) vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
END DO END DO
END DO END DO
ENDIF ENDIF
! !
DO jj = mj0(jbdy1), mj1(jbdy2) DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
zvb(:,jj) = 0._wp zvb(:,jj) = 0._wp
zhvb(:,jj) = 0._wp zhvb(:,jj) = 0._wp
DO jk=1,jpkm1 DO jk=1,jpkm1
...@@ -495,14 +495,14 @@ CONTAINS ...@@ -495,14 +495,14 @@ CONTAINS
jbdy2 = jpjglo - ( nn_hls + 1 ) jbdy2 = jpjglo - ( nn_hls + 1 )
! !
IF( .NOT.ln_dynspg_ts ) THEN IF( .NOT.ln_dynspg_ts ) THEN
DO jj = mj0(jbdy1), mj1(jbdy2) DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a) uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
END DO END DO
END DO END DO
ENDIF ENDIF
! !
DO jj = mj0(jbdy1), mj1(jbdy2) DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
zub(:,jj) = 0._wp zub(:,jj) = 0._wp
zhub(:,jj) = 0._wp zhub(:,jj) = 0._wp
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -555,7 +555,7 @@ CONTAINS ...@@ -555,7 +555,7 @@ CONTAINS
IF( lk_west ) THEN IF( lk_west ) THEN
istart = nn_hls + 2 ! halo + land + 1 istart = nn_hls + 2 ! halo + land + 1
iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj DO jj=1,jpj
va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
...@@ -567,7 +567,7 @@ CONTAINS ...@@ -567,7 +567,7 @@ CONTAINS
IF( lk_east ) THEN IF( lk_east ) THEN
istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox() istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox()
iend = jpiglo - ( nn_hls + 1 ) iend = jpiglo - ( nn_hls + 1 )
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj DO jj=1,jpj
va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
...@@ -575,7 +575,7 @@ CONTAINS ...@@ -575,7 +575,7 @@ CONTAINS
END DO END DO
istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox() istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()
iend = jpiglo - ( nn_hls + 2 ) iend = jpiglo - ( nn_hls + 2 )
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj DO jj=1,jpj
ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
END DO END DO
...@@ -586,7 +586,7 @@ CONTAINS ...@@ -586,7 +586,7 @@ CONTAINS
IF( lk_south ) THEN IF( lk_south ) THEN
jstart = nn_hls + 2 jstart = nn_hls + 2
jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy() jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi DO ji=1,jpi
ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
...@@ -599,14 +599,14 @@ CONTAINS ...@@ -599,14 +599,14 @@ CONTAINS
IF( lk_north ) THEN IF( lk_north ) THEN
jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy() jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()
jend = jpjglo - ( nn_hls + 1 ) jend = jpjglo - ( nn_hls + 1 )
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi DO ji=1,jpi
ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
END DO END DO
END DO END DO
jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy() jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()
jend = jpjglo - ( nn_hls + 2 ) jend = jpjglo - ( nn_hls + 2 )
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi DO ji=1,jpi
va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
END DO END DO
...@@ -644,7 +644,7 @@ CONTAINS ...@@ -644,7 +644,7 @@ CONTAINS
IF( lk_west ) THEN IF( lk_west ) THEN
istart = nn_hls + 2 istart = nn_hls + 2
iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox()
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj DO jj=1,jpj
zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
...@@ -656,14 +656,14 @@ CONTAINS ...@@ -656,14 +656,14 @@ CONTAINS
IF( lk_east ) THEN IF( lk_east ) THEN
istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox() istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox()
iend = jpiglo - ( nn_hls + 1 ) iend = jpiglo - ( nn_hls + 1 )
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj DO jj=1,jpj
zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
END DO END DO
END DO END DO
istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox() istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()
iend = jpiglo - ( nn_hls + 2 ) iend = jpiglo - ( nn_hls + 2 )
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj DO jj=1,jpj
zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
END DO END DO
...@@ -674,7 +674,7 @@ CONTAINS ...@@ -674,7 +674,7 @@ CONTAINS
IF( lk_south ) THEN IF( lk_south ) THEN
jstart = nn_hls + 2 jstart = nn_hls + 2
jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy() jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi DO ji=1,jpi
zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
...@@ -686,14 +686,14 @@ CONTAINS ...@@ -686,14 +686,14 @@ CONTAINS
IF( lk_north ) THEN IF( lk_north ) THEN
jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy() jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()
jend = jpjglo - ( nn_hls + 1 ) jend = jpjglo - ( nn_hls + 1 )
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi DO ji=1,jpi
zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
END DO END DO
END DO END DO
jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy() jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()
jend = jpjglo - ( nn_hls + 2 ) jend = jpjglo - ( nn_hls + 2 )
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi DO ji=1,jpi
zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
END DO END DO
...@@ -803,7 +803,7 @@ CONTAINS ...@@ -803,7 +803,7 @@ CONTAINS
istart = nn_hls + 2 ! halo + land + 1 istart = nn_hls + 2 ! halo + land + 1
iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
IF (lk_div_cons) iend = istart IF (lk_div_cons) iend = istart
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ssh(ji,jj,Krhs_a) = hbdy(ji,jj) ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
END DO END DO
...@@ -815,7 +815,7 @@ CONTAINS ...@@ -815,7 +815,7 @@ CONTAINS
istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells - 1 istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells - 1
iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
IF (lk_div_cons) istart = iend IF (lk_div_cons) istart = iend
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ssh(ji,jj,Krhs_a) = hbdy(ji,jj) ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
END DO END DO
...@@ -827,7 +827,7 @@ CONTAINS ...@@ -827,7 +827,7 @@ CONTAINS
jstart = nn_hls + 2 ! halo + land + 1 jstart = nn_hls + 2 ! halo + land + 1
jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells
IF (lk_div_cons) jend = jstart IF (lk_div_cons) jend = jstart
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ssh(ji,jj,Krhs_a) = hbdy(ji,jj) ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
END DO END DO
...@@ -839,7 +839,7 @@ CONTAINS ...@@ -839,7 +839,7 @@ CONTAINS
jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells - 1 jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells - 1
jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
IF (lk_div_cons) jstart = jend IF (lk_div_cons) jstart = jend
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ssh(ji,jj,Krhs_a) = hbdy(ji,jj) ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
END DO END DO
...@@ -872,7 +872,7 @@ CONTAINS ...@@ -872,7 +872,7 @@ CONTAINS
istart = nn_hls + 2 ! halo + land + 1 istart = nn_hls + 2 ! halo + land + 1
iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
IF (lk_div_cons) iend = istart IF (lk_div_cons) iend = istart
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ssha_e(ji,jj) = hbdy(ji,jj) ssha_e(ji,jj) = hbdy(ji,jj)
END DO END DO
...@@ -884,7 +884,7 @@ CONTAINS ...@@ -884,7 +884,7 @@ CONTAINS
istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells - 1 istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells - 1
iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
IF (lk_div_cons) istart = iend IF (lk_div_cons) istart = iend
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ssha_e(ji,jj) = hbdy(ji,jj) ssha_e(ji,jj) = hbdy(ji,jj)
END DO END DO
...@@ -896,7 +896,7 @@ CONTAINS ...@@ -896,7 +896,7 @@ CONTAINS
jstart = nn_hls + 2 ! halo + land + 1 jstart = nn_hls + 2 ! halo + land + 1
jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells
IF (lk_div_cons) jend = jstart IF (lk_div_cons) jend = jstart
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ssha_e(ji,jj) = hbdy(ji,jj) ssha_e(ji,jj) = hbdy(ji,jj)
END DO END DO
...@@ -908,7 +908,7 @@ CONTAINS ...@@ -908,7 +908,7 @@ CONTAINS
jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells - 1 jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells - 1
jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
IF (lk_div_cons) jstart = jend IF (lk_div_cons) jstart = jend
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ssha_e(ji,jj) = hbdy(ji,jj) ssha_e(ji,jj) = hbdy(ji,jj)
END DO END DO
...@@ -1553,7 +1553,7 @@ CONTAINS ...@@ -1553,7 +1553,7 @@ CONTAINS
DO ji=i1,i2 DO ji=i1,i2
DO jj=j1,j2 DO jj=j1,j2
IF (utint_stage(ji,jj)==0) THEN IF (utint_stage(ji,jj)==0) THEN
zx = 2._wp*MOD(ABS(mig0(ji)-nbghostcells_x_w), INT(Agrif_Rhox()))/zrhox - 1._wp zx = 2._wp*MOD(ABS(mig(ji,0)-nbghostcells_x_w), INT(Agrif_Rhox()))/zrhox - 1._wp
ubdy(ji,jj) = ubdy(ji,jj) + 0.25_wp*(1._wp-zx*zx) * ptab(ji,jj) & ubdy(ji,jj) = ubdy(ji,jj) + 0.25_wp*(1._wp-zx*zx) * ptab(ji,jj) &
& / zrhoy *r1_e2u(ji,jj) * umask(ji,jj,1) & / zrhoy *r1_e2u(ji,jj) * umask(ji,jj,1)
utint_stage(ji,jj) = 1 utint_stage(ji,jj) = 1
...@@ -1673,7 +1673,7 @@ CONTAINS ...@@ -1673,7 +1673,7 @@ CONTAINS
DO ji=i1,i2 DO ji=i1,i2
DO jj=j1,j2 DO jj=j1,j2
IF (vtint_stage(ji,jj)==0) THEN IF (vtint_stage(ji,jj)==0) THEN
zy = 2._wp*MOD(ABS(mjg0(jj)-nbghostcells_y_s), INT(Agrif_Rhoy()))/zrhoy - 1._wp zy = 2._wp*MOD(ABS(mjg(jj,0)-nbghostcells_y_s), INT(Agrif_Rhoy()))/zrhoy - 1._wp
vbdy(ji,jj) = vbdy(ji,jj) + 0.25_wp*(1._wp-zy*zy) * ptab(ji,jj) & vbdy(ji,jj) = vbdy(ji,jj) + 0.25_wp*(1._wp-zy*zy) * ptab(ji,jj) &
& / zrhox * r1_e1v(ji,jj) * vmask(ji,jj,1) & / zrhox * r1_e1v(ji,jj) * vmask(ji,jj,1)
vtint_stage(ji,jj) = 1 vtint_stage(ji,jj) = 1
...@@ -1757,7 +1757,7 @@ CONTAINS ...@@ -1757,7 +1757,7 @@ CONTAINS
DO jj = j1, j2 DO jj = j1, j2
DO ji = i1, i2 DO ji = i1, i2
IF( ABS( ptab(ji,jj) - glamt(ji,jj) ) > ztst ) THEN IF( ABS( ptab(ji,jj) - glamt(ji,jj) ) > ztst ) THEN
WRITE(numout,*) ' Agrif error for glamt: parent, child, i, j ', ptab(ji,jj), glamt(ji,jj), mig0(ji), mig0(jj) WRITE(numout,*) ' Agrif error for glamt: parent, child, i, j ', ptab(ji,jj), glamt(ji,jj), mig(ji,0), mjg(jj,0)
! kindic_agr = kindic_agr + 1 ! kindic_agr = kindic_agr + 1
ENDIF ENDIF
END DO END DO
...@@ -1786,7 +1786,7 @@ CONTAINS ...@@ -1786,7 +1786,7 @@ CONTAINS
DO jj = j1, j2 DO jj = j1, j2
DO ji = i1, i2 DO ji = i1, i2
IF( ABS( ptab(ji,jj) - gphit(ji,jj) ) > ztst ) THEN IF( ABS( ptab(ji,jj) - gphit(ji,jj) ) > ztst ) THEN
WRITE(numout,*) ' Agrif error for gphit: parent, child, i, j ', ptab(ji,jj), gphit(ji,jj), mig0(ji), mig0(jj) WRITE(numout,*) ' Agrif error for gphit: parent, child, i, j ', ptab(ji,jj), gphit(ji,jj), mig(ji,0), mjg(jj,0)
! kindic_agr = kindic_agr + 1 ! kindic_agr = kindic_agr + 1
ENDIF ENDIF
END DO END DO
...@@ -2001,8 +2001,8 @@ CONTAINS ...@@ -2001,8 +2001,8 @@ CONTAINS
iend = nn_hls + nbghostcells + ispon ! halo + land + nbghostcells + sponge iend = nn_hls + nbghostcells + ispon ! halo + land + nbghostcells + sponge
jstart = nn_hls + 2 jstart = nn_hls + 2
jend = jpjglo - nn_hls - 1 jend = jpjglo - nn_hls - 1
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -2010,7 +2010,7 @@ CONTAINS ...@@ -2010,7 +2010,7 @@ CONTAINS
END DO END DO
ENDIF ENDIF
END DO END DO
DO jj = mj0(jstart), mj1(jend-1) DO jj = mj0(jstart,nn_hls), mj1(jend-1,nn_hls)
IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -2019,8 +2019,8 @@ CONTAINS ...@@ -2019,8 +2019,8 @@ CONTAINS
ENDIF ENDIF
END DO END DO
END DO END DO
DO ji = mi0(istart), mi1(iend-1) DO ji = mi0(istart,nn_hls), mi1(iend-1,nn_hls)
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -2038,8 +2038,8 @@ CONTAINS ...@@ -2038,8 +2038,8 @@ CONTAINS
iend = jpiglo - nn_hls - 1 ! halo + land + 1 - 1 iend = jpiglo - nn_hls - 1 ! halo + land + 1 - 1
jstart = nn_hls + 2 jstart = nn_hls + 2
jend = jpjglo - nn_hls - 1 jend = jpjglo - nn_hls - 1
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -2047,7 +2047,7 @@ CONTAINS ...@@ -2047,7 +2047,7 @@ CONTAINS
END DO END DO
ENDIF ENDIF
END DO END DO
DO jj = mj0(jstart), mj1(jend-1) DO jj = mj0(jstart,nn_hls), mj1(jend-1,nn_hls)
IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -2056,8 +2056,8 @@ CONTAINS ...@@ -2056,8 +2056,8 @@ CONTAINS
ENDIF ENDIF
END DO END DO
END DO END DO
DO ji = mi0(istart), mi1(iend-1) DO ji = mi0(istart,nn_hls), mi1(iend-1,nn_hls)
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -2075,8 +2075,8 @@ CONTAINS ...@@ -2075,8 +2075,8 @@ CONTAINS
jend = nn_hls + nbghostcells + ispon ! halo + land + nbghostcells + sponge jend = nn_hls + nbghostcells + ispon ! halo + land + nbghostcells + sponge
istart = nn_hls + 2 istart = nn_hls + 2
iend = jpiglo - nn_hls - 1 iend = jpiglo - nn_hls - 1
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -2084,7 +2084,7 @@ CONTAINS ...@@ -2084,7 +2084,7 @@ CONTAINS
END DO END DO
ENDIF ENDIF
END DO END DO
DO ji = mi0(istart), mi1(iend-1) DO ji = mi0(istart,nn_hls), mi1(iend-1,nn_hls)
IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -2093,8 +2093,8 @@ CONTAINS ...@@ -2093,8 +2093,8 @@ CONTAINS
ENDIF ENDIF
END DO END DO
END DO END DO
DO jj = mj0(jstart), mj1(jend-1) DO jj = mj0(jstart,nn_hls), mj1(jend-1,nn_hls)
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -2112,8 +2112,8 @@ CONTAINS ...@@ -2112,8 +2112,8 @@ CONTAINS
jend = jpjglo - nn_hls - 1 ! halo + land + 1 - 1 jend = jpjglo - nn_hls - 1 ! halo + land + 1 - 1
istart = nn_hls + 2 istart = nn_hls + 2
iend = jpiglo - nn_hls - 1 iend = jpiglo - nn_hls - 1
DO jj = mj0(jstart), mj1(jend) DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -2121,7 +2121,7 @@ CONTAINS ...@@ -2121,7 +2121,7 @@ CONTAINS
END DO END DO
ENDIF ENDIF
END DO END DO
DO ji = mi0(istart), mi1(iend-1) DO ji = mi0(istart,nn_hls), mi1(iend-1,nn_hls)
IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1 DO jk = 1, jpkm1
...@@ -2130,8 +2130,8 @@ CONTAINS ...@@ -2130,8 +2130,8 @@ CONTAINS
ENDIF ENDIF
END DO END DO
END DO END DO
DO jj = mj0(jstart), mj1(jend-1) DO jj = mj0(jstart,nn_hls), mj1(jend-1,nn_hls)
DO ji = mi0(istart), mi1(iend) DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1 IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1 DO jk = 1, jpkm1
......
src/NST/agrif_oce_sponge.F90
View file @ 4dbfc9bb
...@@ -161,15 +161,15 @@ CONTAINS ...@@ -161,15 +161,15 @@ CONTAINS
IF( lk_west ) THEN ! --- West --- ! IF( lk_west ) THEN ! --- West --- !
ind1 = nn_hls + nbghostcells ! halo + nbghostcells ind1 = nn_hls + nbghostcells ! halo + nbghostcells
ind2 = nn_hls + nbghostcells + ispongearea ind2 = nn_hls + nbghostcells + ispongearea
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_ispongearea ztabramp(ji,jj) = REAL(ind2 - mig(ji,nn_hls), wp) * z1_ispongearea
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = 1 ind1 = 1
ind2 = nn_hls + nbghostcells ! halo + nbghostcells ind2 = nn_hls + nbghostcells ! halo + nbghostcells
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -178,15 +178,15 @@ CONTAINS ...@@ -178,15 +178,15 @@ CONTAINS
IF( lk_east ) THEN ! --- East --- ! IF( lk_east ) THEN ! --- East --- !
ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - ispongearea - 1 ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - ispongearea - 1
ind2 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + land + nbghostcells - 1 ind2 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + land + nbghostcells - 1
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji,nn_hls) - ind1, wp) * z1_ispongearea )
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + land + nbghostcells - 1 ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + land + nbghostcells - 1
ind2 = jpiglo - 1 ind2 = jpiglo - 1
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -195,15 +195,15 @@ CONTAINS ...@@ -195,15 +195,15 @@ CONTAINS
IF( lk_south ) THEN ! --- South --- ! IF( lk_south ) THEN ! --- South --- !
ind1 = nn_hls + nbghostcells ! halo + nbghostcells ind1 = nn_hls + nbghostcells ! halo + nbghostcells
ind2 = nn_hls + nbghostcells + jspongearea ind2 = nn_hls + nbghostcells + jspongearea
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj,nn_hls), wp) * z1_jspongearea )
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = 1 ind1 = 1
ind2 = nn_hls + nbghostcells ! halo + nbghostcells ind2 = nn_hls + nbghostcells ! halo + nbghostcells
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -212,15 +212,15 @@ CONTAINS ...@@ -212,15 +212,15 @@ CONTAINS
IF( lk_north ) THEN ! --- North --- ! IF( lk_north ) THEN ! --- North --- !
ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) - jspongearea - 1 ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) - jspongearea - 1
ind2 = jpjglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + nbghostcells - 1 ind2 = jpjglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + nbghostcells - 1
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj,nn_hls) - ind1, wp) * z1_jspongearea )
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) ! halo + land + nbghostcells - 1 ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) ! halo + land + nbghostcells - 1
ind2 = jpjglo ind2 = jpjglo
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -294,15 +294,15 @@ CONTAINS ...@@ -294,15 +294,15 @@ CONTAINS
IF( lk_west ) THEN ! --- West --- ! IF( lk_west ) THEN ! --- West --- !
ind1 = nn_hls + nbghostcells + ishift ind1 = nn_hls + nbghostcells + ishift
ind2 = nn_hls + nbghostcells + ishift + ispongearea ind2 = nn_hls + nbghostcells + ishift + ispongearea
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_ispongearea ztabramp(ji,jj) = REAL(ind2 - mig(ji,nn_hls), wp) * z1_ispongearea
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = 1 ind1 = 1
ind2 = nn_hls + nbghostcells + ishift ! halo + nbghostcells ind2 = nn_hls + nbghostcells + ishift ! halo + nbghostcells
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -311,15 +311,15 @@ CONTAINS ...@@ -311,15 +311,15 @@ CONTAINS
IF( lk_east ) THEN ! --- East --- ! IF( lk_east ) THEN ! --- East --- !
ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - ispongearea - 1 ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - ispongearea - 1
ind2 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1 ! halo + nbghostcells - 1 ind2 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1 ! halo + nbghostcells - 1
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji,nn_hls) - ind1, wp) * z1_ispongearea )
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1 ! halo + nbghostcells - 1 ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1 ! halo + nbghostcells - 1
ind2 = jpiglo - 1 ind2 = jpiglo - 1
DO ji = mi0(ind1), mi1(ind2) DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -328,15 +328,15 @@ CONTAINS ...@@ -328,15 +328,15 @@ CONTAINS
IF( lk_south ) THEN ! --- South --- ! IF( lk_south ) THEN ! --- South --- !
ind1 = nn_hls + nbghostcells + jshift ! halo + nbghostcells ind1 = nn_hls + nbghostcells + jshift ! halo + nbghostcells
ind2 = nn_hls + nbghostcells + jshift + jspongearea ind2 = nn_hls + nbghostcells + jshift + jspongearea
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj,nn_hls), wp) * z1_jspongearea )
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = 1 ind1 = 1
ind2 = nn_hls + nbghostcells + jshift ! halo + land + nbghostcells ind2 = nn_hls + nbghostcells + jshift ! halo + land + nbghostcells
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -345,15 +345,15 @@ CONTAINS ...@@ -345,15 +345,15 @@ CONTAINS
IF( lk_north ) THEN ! --- North --- ! IF( lk_north ) THEN ! --- North --- !
ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - jspongearea - 1 ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - jspongearea - 1
ind2 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - 1 ! halo + land + nbghostcells - 1 ind2 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - 1 ! halo + land + nbghostcells - 1
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj,nn_hls) - ind1, wp) * z1_jspongearea )
END DO END DO
END DO END DO
! ghost cells: ! ghost cells:
ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) ! halo + land + nbghostcells - 1 ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) ! halo + land + nbghostcells - 1
ind2 = jpjglo ind2 = jpjglo
DO jj = mj0(ind1), mj1(ind2) DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp ztabramp(ji,jj) = 1._wp
END DO END DO
...@@ -730,7 +730,7 @@ CONTAINS ...@@ -730,7 +730,7 @@ CONTAINS
jmax = j2-1 jmax = j2-1
ind1 = jpjglo - ( nn_hls + nbghostcells + 1 ) ! North ind1 = jpjglo - ( nn_hls + nbghostcells + 1 ) ! North
DO jj = mj0(ind1), mj1(ind1) DO jj = mj0(ind1,nn_hls), mj1(ind1,nn_hls)
jmax = MIN(jmax,jj) jmax = MIN(jmax,jj)
END DO END DO
...@@ -858,7 +858,7 @@ CONTAINS ...@@ -858,7 +858,7 @@ CONTAINS
imax = i2 - 1 imax = i2 - 1
ind1 = jpiglo - ( nn_hls + nbghostcells + 1 ) ! East ind1 = jpiglo - ( nn_hls + nbghostcells + 1 ) ! East
DO ji = mi0(ind1), mi1(ind1) DO ji = mi0(ind1,nn_hls), mi1(ind1,nn_hls)
imax = MIN(imax,ji) imax = MIN(imax,ji)
END DO END DO
...@@ -958,7 +958,7 @@ CONTAINS ...@@ -958,7 +958,7 @@ CONTAINS
jmax = j2-1 jmax = j2-1
ind1 = jpjglo - ( nn_hls + nbghostcells + 1 ) ! North ind1 = jpjglo - ( nn_hls + nbghostcells + 1 ) ! North
DO jj = mj0(ind1), mj1(ind1) DO jj = mj0(ind1,nn_hls), mj1(ind1,nn_hls)
jmax = MIN(jmax,jj) jmax = MIN(jmax,jj)
END DO END DO
...@@ -1025,7 +1025,7 @@ CONTAINS ...@@ -1025,7 +1025,7 @@ CONTAINS
imax = i2 - 1 imax = i2 - 1
ind1 = jpiglo - ( nn_hls + nbghostcells + 1 ) ! East ind1 = jpiglo - ( nn_hls + nbghostcells + 1 ) ! East
DO ji = mi0(ind1), mi1(ind1) DO ji = mi0(ind1,nn_hls), mi1(ind1,nn_hls)
imax = MIN(imax,ji) imax = MIN(imax,ji)
END DO END DO
......
src/NST/agrif_oce_update.F90
View file @ 4dbfc9bb
...@@ -1893,7 +1893,7 @@ CONTAINS ...@@ -1893,7 +1893,7 @@ CONTAINS
DO jk=k1,k2-1 DO jk=k1,k2-1
IF (ABS((ptab(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk)).GE.1.e-6) THEN IF (ABS((ptab(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk)).GE.1.e-6) THEN
kindic_agr = kindic_agr + 1 kindic_agr = kindic_agr + 1
print *, 'erro u-pt', mig0(ji), mjg0(jj), jk, mbku(ji,jj), ikbot, ptab(ji,jj,jk), e3u_0(ji,jj,jk) PRINT *, 'erro u-pt', mig(ji,0), mjg(jj,0), jk, mbku(ji,jj), ikbot, ptab(ji,jj,jk), e3u_0(ji,jj,jk)
ENDIF ENDIF
END DO END DO
ENDIF ENDIF
...@@ -1933,7 +1933,7 @@ CONTAINS ...@@ -1933,7 +1933,7 @@ CONTAINS
DO jk=k1,k2-1 DO jk=k1,k2-1
IF (ABS((ptab(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk)).GE.1.e-6) THEN IF (ABS((ptab(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk)).GE.1.e-6) THEN
kindic_agr = kindic_agr + 1 kindic_agr = kindic_agr + 1
print *, 'erro v-pt', mig0(ji), mjg0(jj), mbkv(ji,jj), ptab(ji,jj,jk), e3v_0(ji,jj,jk) PRINT *, 'erro v-pt', mig(ji,0), mjg(jj,0), mbkv(ji,jj), ptab(ji,jj,jk), e3v_0(ji,jj,jk)
ENDIF ENDIF
END DO END DO
ENDIF ENDIF
......
src/NST/agrif_user.F90
View file @ 4dbfc9bb
...@@ -1095,8 +1095,8 @@ ...@@ -1095,8 +1095,8 @@
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
SELECT CASE( i ) SELECT CASE( i )
CASE(1) ; indglob = mig(indloc) CASE(1) ; indglob = mig(indloc,nn_hls)
CASE(2) ; indglob = mjg(indloc) CASE(2) ; indglob = mjg(indloc,nn_hls)
CASE DEFAULT ; indglob = indloc CASE DEFAULT ; indglob = indloc
END SELECT END SELECT
! !
...@@ -1115,10 +1115,10 @@ ...@@ -1115,10 +1115,10 @@
INTEGER, INTENT(out) :: jmin, jmax INTEGER, INTENT(out) :: jmin, jmax
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
imin = mig( 1 ) imin = mig( 1 ,nn_hls)
jmin = mjg( 1 ) jmin = mjg( 1 ,nn_hls)
imax = mig(jpi) imax = mig(jpi,nn_hls)
jmax = mjg(jpj) jmax = mjg(jpj,nn_hls)
! !
END SUBROUTINE Agrif_get_proc_info END SUBROUTINE Agrif_get_proc_info
......
src/OCE/BDY/bdyini.F90
View file @ 4dbfc9bb
...@@ -491,10 +491,10 @@ CONTAINS ...@@ -491,10 +491,10 @@ CONTAINS
! Find lenght of boundaries and rim on local mpi domain ! Find lenght of boundaries and rim on local mpi domain
!------------------------------------------------------ !------------------------------------------------------
! !
iwe = mig(1) iwe = mig( 1,nn_hls)
ies = mig(jpi) ies = mig(jpi,nn_hls)
iso = mjg(1) iso = mjg( 1,nn_hls)
ino = mjg(jpj) ino = mjg(jpj,nn_hls)
! !
DO ib_bdy = 1, nb_bdy DO ib_bdy = 1, nb_bdy
DO igrd = 1, jpbgrd DO igrd = 1, jpbgrd
...@@ -554,8 +554,8 @@ CONTAINS ...@@ -554,8 +554,8 @@ CONTAINS
& nbrdta(ib,igrd,ib_bdy) == ir ) THEN & nbrdta(ib,igrd,ib_bdy) == ir ) THEN
! !
icount = icount + 1 icount = icount + 1
idx_bdy(ib_bdy)%nbi(icount,igrd) = nbidta(ib,igrd,ib_bdy) - mig(1) + 1 ! global to local indexes idx_bdy(ib_bdy)%nbi(icount,igrd) = nbidta(ib,igrd,ib_bdy) - mig(1,nn_hls) + 1 ! global to local indexes
idx_bdy(ib_bdy)%nbj(icount,igrd) = nbjdta(ib,igrd,ib_bdy) - mjg(1) + 1 ! global to local indexes idx_bdy(ib_bdy)%nbj(icount,igrd) = nbjdta(ib,igrd,ib_bdy) - mjg(1,nn_hls) + 1 ! global to local indexes
idx_bdy(ib_bdy)%nbr(icount,igrd) = nbrdta(ib,igrd,ib_bdy) idx_bdy(ib_bdy)%nbr(icount,igrd) = nbrdta(ib,igrd,ib_bdy)
idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib
ENDIF ENDIF
...@@ -1014,7 +1014,7 @@ CONTAINS ...@@ -1014,7 +1014,7 @@ CONTAINS
DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
ii = idx_bdy(ib_bdy)%nbi(ib,igrd) ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
ij = idx_bdy(ib_bdy)%nbj(ib,igrd) ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
IF( mig0(ii) > 2 .AND. mig0(ii) < Ni0glo-2 .AND. mjg0(ij) > 2 .AND. mjg0(ij) < Nj0glo-2 ) THEN IF( mig(ii,0) > 2 .AND. mig(ii,0) < Ni0glo-2 .AND. mjg(ij,0) > 2 .AND. mjg(ij,0) < Nj0glo-2 ) THEN
WRITE(ctmp1,*) ' Orlanski is not safe when the open boundaries are on the interior of the computational domain' WRITE(ctmp1,*) ' Orlanski is not safe when the open boundaries are on the interior of the computational domain'
CALL ctl_stop( ctmp1 ) CALL ctl_stop( ctmp1 )
END IF END IF
...@@ -1090,7 +1090,7 @@ CONTAINS ...@@ -1090,7 +1090,7 @@ CONTAINS
! This error check only works if you are using the bdyXmask arrays (which are set to 0 on rims) ! This error check only works if you are using the bdyXmask arrays (which are set to 0 on rims)
IF( i_offset == 1 .and. zefl + zwfl == 2._wp ) THEN IF( i_offset == 1 .and. zefl + zwfl == 2._wp ) THEN
icount = icount + 1 icount = icount + 1
IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii),mjg(ij) IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii,nn_hls),mjg(ij,nn_hls)
ELSE ELSE
ztmp(ii,ij) = -zwfl + zefl ztmp(ii,ij) = -zwfl + zefl
ENDIF ENDIF
...@@ -1130,7 +1130,7 @@ CONTAINS ...@@ -1130,7 +1130,7 @@ CONTAINS
znfl = zmask(ii,ij+j_offset ) znfl = zmask(ii,ij+j_offset )
! This error check only works if you are using the bdyXmask arrays (which are set to 0 on rims) ! This error check only works if you are using the bdyXmask arrays (which are set to 0 on rims)
IF( j_offset == 1 .and. znfl + zsfl == 2._wp ) THEN IF( j_offset == 1 .and. znfl + zsfl == 2._wp ) THEN
IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii),mjg(ij) IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii,nn_hls),mjg(ij,nn_hls)
icount = icount + 1 icount = icount + 1
ELSE ELSE
ztmp(ii,ij) = -zsfl + znfl ztmp(ii,ij) = -zsfl + znfl
...@@ -1594,8 +1594,8 @@ CONTAINS ...@@ -1594,8 +1594,8 @@ CONTAINS
ztestmask(1:2)=0. ztestmask(1:2)=0.
DO ji = 1, jpi DO ji = 1, jpi
DO jj = 1, jpj DO jj = 1, jpj
IF( mig0(ji) == jpiwob(ib) .AND. mjg0(jj) == jpjwdt(ib) ) ztestmask(1) = tmask(ji,jj,1) IF( mig(ji,0) == jpiwob(ib) .AND. mjg(jj,0) == jpjwdt(ib) ) ztestmask(1) = tmask(ji,jj,1)
IF( mig0(ji) == jpiwob(ib) .AND. mjg0(jj) == jpjwft(ib) ) ztestmask(2) = tmask(ji,jj,1) IF( mig(ji,0) == jpiwob(ib) .AND. mjg(jj,0) == jpjwft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO END DO
END DO END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
...@@ -1630,8 +1630,8 @@ CONTAINS ...@@ -1630,8 +1630,8 @@ CONTAINS
ztestmask(1:2)=0. ztestmask(1:2)=0.
DO ji = 1, jpi DO ji = 1, jpi
DO jj = 1, jpj DO jj = 1, jpj
IF( mig0(ji) == jpieob(ib)+1 .AND. mjg0(jj) == jpjedt(ib) ) ztestmask(1) = tmask(ji,jj,1) IF( mig(ji,0) == jpieob(ib)+1 .AND. mjg(jj,0) == jpjedt(ib) ) ztestmask(1) = tmask(ji,jj,1)
IF( mig0(ji) == jpieob(ib)+1 .AND. mjg0(jj) == jpjeft(ib) ) ztestmask(2) = tmask(ji,jj,1) IF( mig(ji,0) == jpieob(ib)+1 .AND. mjg(jj,0) == jpjeft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO END DO
END DO END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
...@@ -1666,8 +1666,8 @@ CONTAINS ...@@ -1666,8 +1666,8 @@ CONTAINS
ztestmask(1:2)=0. ztestmask(1:2)=0.
DO ji = 1, jpi DO ji = 1, jpi
DO jj = 1, jpj DO jj = 1, jpj
IF( mjg0(jj) == jpjsob(ib) .AND. mig0(ji) == jpisdt(ib) ) ztestmask(1) = tmask(ji,jj,1) IF( mjg(jj,0) == jpjsob(ib) .AND. mig(ji,0) == jpisdt(ib) ) ztestmask(1) = tmask(ji,jj,1)
IF( mjg0(jj) == jpjsob(ib) .AND. mig0(ji) == jpisft(ib) ) ztestmask(2) = tmask(ji,jj,1) IF( mjg(jj,0) == jpjsob(ib) .AND. mig(ji,0) == jpisft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO END DO
END DO END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
...@@ -1688,8 +1688,8 @@ CONTAINS ...@@ -1688,8 +1688,8 @@ CONTAINS
ztestmask(1:2)=0. ztestmask(1:2)=0.
DO ji = 1, jpi DO ji = 1, jpi
DO jj = 1, jpj DO jj = 1, jpj
IF( mjg0(jj) == jpjnob(ib)+1 .AND. mig0(ji) == jpindt(ib) ) ztestmask(1) = tmask(ji,jj,1) IF( mjg(jj,0) == jpjnob(ib)+1 .AND. mig(ji,0) == jpindt(ib) ) ztestmask(1) = tmask(ji,jj,1)
IF( mjg0(jj) == jpjnob(ib)+1 .AND. mig0(ji) == jpinft(ib) ) ztestmask(2) = tmask(ji,jj,1) IF( mjg(jj,0) == jpjnob(ib)+1 .AND. mig(ji,0) == jpinft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO END DO
END DO END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
......
src/OCE/CRS/crsfld.F90
View file @ 4dbfc9bb
...@@ -211,8 +211,8 @@ CONTAINS ...@@ -211,8 +211,8 @@ CONTAINS
! sbc fields ! sbc fields
CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0_wp ) CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0_wp )
CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0_wp ) CALL crs_dom_ope( utau , 'SUM', 'T', tmask, utau_crs , p_e12=e2t , p_surf_crs=e2t_crs , psgn=1.0_wp ) !clem tau: check psgn ??
CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0_wp ) CALL crs_dom_ope( vtau , 'SUM', 'T', tmask, vtau_crs , p_e12=e1t , p_surf_crs=e1t_crs , psgn=1.0_wp ) !
CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp )
CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs , psgn=1.0_wp ) CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs , psgn=1.0_wp )
CALL crs_dom_ope( qsr , 'SUM', 'T', tmask, qsr_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp ) CALL crs_dom_ope( qsr , 'SUM', 'T', tmask, qsr_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp )
......
src/OCE/DIA/diaar5.F90
View file @ 4dbfc9bb
...@@ -53,7 +53,7 @@ CONTAINS ...@@ -53,7 +53,7 @@ CONTAINS
INTEGER :: dia_ar5_alloc INTEGER :: dia_ar5_alloc
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk), STAT=dia_ar5_alloc ) ALLOCATE( thick0(A2D(0)) , sn0(A2D(0),jpk), STAT=dia_ar5_alloc )
! !
CALL mpp_sum ( 'diaar5', dia_ar5_alloc ) CALL mpp_sum ( 'diaar5', dia_ar5_alloc )
IF( dia_ar5_alloc /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_alloc: failed to allocate arrays' ) IF( dia_ar5_alloc /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_alloc: failed to allocate arrays' )
...@@ -75,20 +75,23 @@ CONTAINS ...@@ -75,20 +75,23 @@ CONTAINS
REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass, zsst REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass, zsst
REAL(wp) :: zaw, zbw, zrw REAL(wp) :: zaw, zbw, zrw
! !
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh ! 2D workspace
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d, zpe ! 2D workspace REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d ! 2D workspace
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d, zrhd, ztpot, zgdept ! 3D workspace (zgdept: needed to use the substitute) REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrhd, zgdept ! 3D workspace (zgdept: needed to use the substitute)
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace
!!-------------------------------------------------------------------- !!--------------------------------------------------------------------
IF( ln_timing ) CALL timing_start('dia_ar5') IF( ln_timing ) CALL timing_start('dia_ar5')
IF( kt == nit000 ) CALL dia_ar5_init IF( kt == nit000 ) CALL dia_ar5_init
IF( l_ar5 ) THEN IF( l_ar5 ) THEN
ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) ) ALLOCATE( zarea_ssh(A2D(0)), z2d(A2D(0)), z3d(A2D(0),jpk) )
ALLOCATE( zrhd(jpi,jpj,jpk) ) ALLOCATE( zrhd(jpi,jpj,jpk) )
ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) ALLOCATE( ztsn(jpi,jpj,jpk,jpts) )
zarea_ssh(:,:) = e1e2t(:,:) * ssh(:,:,Kmm) zarea_ssh(:,:) = e1e2t(A2D(0)) * ssh(A2D(0),Kmm)
ztsn(:,:,:,:) = 0._wp
zrhd(:,:,:) = 0._wp
ENDIF ENDIF
! !
CALL iom_put( 'e2u' , e2u (:,:) ) CALL iom_put( 'e2u' , e2u (:,:) )
...@@ -96,19 +99,19 @@ CONTAINS ...@@ -96,19 +99,19 @@ CONTAINS
CALL iom_put( 'areacello', e1e2t(:,:) ) CALL iom_put( 'areacello', e1e2t(:,:) )
! !
IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' ) ) THEN IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' ) ) THEN
zrhd(:,:,jpk) = 0._wp ! ocean volume ; rhd is used as workspace z3d(:,:,jpk) = 0._wp ! ocean volume ; rhd is used as workspace
DO jk = 1, jpkm1 DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zrhd(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) z3d(ji,jj,jk) = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
END DO END_3D
DO jk = 1, jpk CALL iom_put( 'volcello' , z3d(:,:,:) ) ! WARNING not consistent with CMIP DR where volcello is at ca. 2000
z3d(:,:,jk) = rho0 * e3t(:,:,jk,Kmm) * tmask(:,:,jk) DO_3D( 0, 0, 0, 0, 1, jpk )
END DO z3d(ji,jj,jk) = rho0 * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk)
CALL iom_put( 'volcello' , zrhd(:,:,:) ) ! WARNING not consistent with CMIP DR where volcello is at ca. 2000 END_3D
CALL iom_put( 'masscello' , z3d (:,:,:) ) ! ocean mass CALL iom_put( 'masscello' , z3d (:,:,:) ) ! ocean mass
ENDIF ENDIF
! !
IF( iom_use( 'e3tb' ) ) THEN ! bottom layer thickness IF( iom_use( 'e3tb' ) ) THEN ! bottom layer thickness
DO_2D( 1, 1, 1, 1 ) DO_2D( 0, 0, 0, 0 )
ikb = mbkt(ji,jj) ikb = mbkt(ji,jj)
z2d(ji,jj) = e3t(ji,jj,ikb,Kmm) z2d(ji,jj) = e3t(ji,jj,ikb,Kmm)
END_2D END_2D
...@@ -128,61 +131,63 @@ CONTAINS ...@@ -128,61 +131,63 @@ CONTAINS
IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) THEN IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) THEN
! !
ztsn(:,:,:,jp_tem) = ts(:,:,:,jp_tem,Kmm) ! thermosteric ssh ztsn(A2D(0),:,jp_tem) = ts(A2D(0),:,jp_tem,Kmm) ! thermosteric ssh
ztsn(:,:,:,jp_sal) = sn0(:,:,:) ztsn(A2D(0),:,jp_sal) = sn0(:,:,:)
ALLOCATE( zgdept(jpi,jpj,jpk) ) ALLOCATE( zgdept(jpi,jpj,jpk) )
DO jk = 1, jpk DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
zgdept(:,:,jk) = gdept(:,:,jk,Kmm) zgdept(ji,jj,jk) = gdept(ji,jj,jk,Kmm)
END DO END_3D
CALL eos( ztsn, zrhd, zgdept) ! now in situ density using initial salinity CALL eos( ztsn, zrhd, zgdept ) ! now in situ density using initial salinity
! !
zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice z2d(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice
DO jk = 1, jpkm1 DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk) z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * zrhd(ji,jj,jk)
END DO END_3D
IF( ln_linssh ) THEN IF( ln_linssh ) THEN
IF( ln_isfcav ) THEN IF( ln_isfcav ) THEN
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
iks = mikt(ji,jj) iks = mikt(ji,jj)
zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj) z2d(ji,jj) = z2d(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj)
END_2D END_2D
ELSE ELSE
zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1) DO_2D( 0, 0, 0, 0 )
z2d(ji,jj) = z2d(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,1)
END_2D
END IF END IF
!!gm !!gm
!!gm riceload should be added in both ln_linssh=T or F, no? !!gm riceload should be added in both ln_linssh=T or F, no?
!!gm !!gm
END IF END IF
! !
zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) ) zarho = glob_sum( 'diaar5', e1e2t(A2D(0)) * z2d(:,:) )
zssh_steric = - zarho / area_tot zssh_steric = - zarho / area_tot
CALL iom_put( 'sshthster', zssh_steric ) CALL iom_put( 'sshthster', zssh_steric )
! ! steric sea surface height ! ! steric sea surface height
zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice z2d(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice
DO jk = 1, jpkm1 DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * rhd(:,:,jk) z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * rhd(ji,jj,jk)
END DO END_3D
IF( ln_linssh ) THEN IF( ln_linssh ) THEN
IF ( ln_isfcav ) THEN IF ( ln_isfcav ) THEN
DO ji = 1,jpi DO_2D( 0, 0, 0, 0 )
DO jj = 1,jpj iks = mikt(ji,jj)
iks = mikt(ji,jj) z2d(ji,jj) = z2d(ji,jj) + ssh(ji,jj,Kmm) * rhd(ji,jj,iks) + riceload(ji,jj)
zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * rhd(ji,jj,iks) + riceload(ji,jj) END_2D
END DO
END DO
ELSE ELSE
zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * rhd(:,:,1) DO_2D( 0, 0, 0, 0 )
z2d(ji,jj) = z2d(ji,jj) + ssh(ji,jj,Kmm) * rhd(ji,jj,1)
END_2D
END IF END IF
END IF END IF
! !
zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) ) zarho = glob_sum( 'diaar5', e1e2t(A2D(0)) * z2d(:,:) )
zssh_steric = - zarho / area_tot zssh_steric = - zarho / area_tot
CALL iom_put( 'sshsteric', zssh_steric ) CALL iom_put( 'sshsteric', zssh_steric )
! ! ocean bottom pressure ! ! ocean bottom pressure
zztmp = rho0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa zztmp = rho0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa
zbotpres(:,:) = zztmp * ( zbotpres(:,:) + ssh(:,:,Kmm) + thick0(:,:) ) z2d(:,:) = zztmp * ( z2d(:,:) + ssh(A2D(0),Kmm) + thick0(:,:) )
CALL iom_put( 'botpres', zbotpres ) CALL iom_put( 'botpres', z2d )
! !
DEALLOCATE( zgdept ) DEALLOCATE( zgdept )
! !
...@@ -191,7 +196,7 @@ CONTAINS ...@@ -191,7 +196,7 @@ CONTAINS
IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) ) THEN IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) ) THEN
! ! Mean density anomalie, temperature and salinity ! ! Mean density anomalie, temperature and salinity
ztsn(:,:,:,:) = 0._wp ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity ztsn(:,:,:,:) = 0._wp ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity
DO_3D( 1, 1, 1, 1, 1, jpkm1 ) DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zztmp = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) zztmp = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm)
ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm) ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm)
ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * ts(ji,jj,jk,jp_sal,Kmm) ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * ts(ji,jj,jk,jp_sal,Kmm)
...@@ -199,16 +204,16 @@ CONTAINS ...@@ -199,16 +204,16 @@ CONTAINS
IF( ln_linssh ) THEN IF( ln_linssh ) THEN
IF( ln_isfcav ) THEN IF( ln_isfcav ) THEN
DO ji = 1, jpi DO_2D( 0, 0, 0, 0 )
DO jj = 1, jpj iks = mikt(ji,jj)
iks = mikt(ji,jj) ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_tem,Kmm)
ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_tem,Kmm) ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_sal,Kmm)
ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_sal,Kmm) END_2D
END DO
END DO
ELSE ELSE
ztsn(:,:,1,jp_tem) = ztsn(:,:,1,jp_tem) + zarea_ssh(:,:) * ts(:,:,1,jp_tem,Kmm) DO_2D( 0, 0, 0, 0 )
ztsn(:,:,1,jp_sal) = ztsn(:,:,1,jp_sal) + zarea_ssh(:,:) * ts(:,:,1,jp_sal,Kmm) ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * ts(ji,jj,1,jp_tem,Kmm)
ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * ts(ji,jj,1,jp_sal,Kmm)
END_2D
END IF END IF
ENDIF ENDIF
! !
...@@ -226,37 +231,35 @@ CONTAINS ...@@ -226,37 +231,35 @@ CONTAINS
IF( iom_use( 'toce_pot') .OR. iom_use( 'temptot_pot' ) .OR. iom_use( 'sst_pot' ) & IF( iom_use( 'toce_pot') .OR. iom_use( 'temptot_pot' ) .OR. iom_use( 'sst_pot' ) &
.OR. iom_use( 'ssttot' ) .OR. iom_use( 'tosmint_pot' ) ) THEN .OR. iom_use( 'ssttot' ) .OR. iom_use( 'tosmint_pot' ) ) THEN
! !
ALLOCATE( ztpot(jpi,jpj,jpk) ) z3d(:,:,jpk) = 0._wp
ztpot(:,:,jpk) = 0._wp
DO jk = 1, jpkm1 DO jk = 1, jpkm1
ztpot(:,:,jk) = eos_pt_from_ct( ts(:,:,jk,jp_tem,Kmm), ts(:,:,jk,jp_sal,Kmm) ) z3d(:,:,jk) = eos_pt_from_ct( ts(A2D(0),jk,jp_tem,Kmm), ts(A2D(0),jk,jp_sal,Kmm) )
END DO END DO
! !
CALL iom_put( 'toce_pot', ztpot(:,:,:) ) ! potential temperature (TEOS-10 case) CALL iom_put( 'toce_pot', z3d(:,:,:) ) ! potential temperature (TEOS-10 case)
CALL iom_put( 'sst_pot' , ztpot(:,:,1) ) ! surface temperature CALL iom_put( 'sst_pot' , z3d(:,:,1) ) ! surface temperature
! !
IF( iom_use( 'temptot_pot' ) ) THEN ! Output potential temperature in case we use TEOS-10 IF( iom_use( 'temptot_pot' ) ) THEN ! Output potential temperature in case we use TEOS-10
z2d(:,:) = 0._wp z2d(:,:) = 0._wp
DO jk = 1, jpkm1 DO_3D( 0, 0, 0, 0, 1, jpkm1 )
z2d(:,:) = z2d(:,:) + e1e2t(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk) z2d(ji,jj) = z2d(ji,jj) + e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * z3d(ji,jj,jk)
END DO END_3D
ztemp = glob_sum( 'diaar5', z2d(:,:) ) ztemp = glob_sum( 'diaar5', z2d(:,:) )
CALL iom_put( 'temptot_pot', ztemp / zvol ) CALL iom_put( 'temptot_pot', ztemp / zvol )
ENDIF ENDIF
! !
IF( iom_use( 'ssttot' ) ) THEN ! Output potential temperature in case we use TEOS-10 IF( iom_use( 'ssttot' ) ) THEN ! Output potential temperature in case we use TEOS-10
zsst = glob_sum( 'diaar5', e1e2t(:,:) * ztpot(:,:,1) ) zsst = glob_sum( 'diaar5', e1e2t(A2D(0)) * z3d(:,:,1) )
CALL iom_put( 'ssttot', zsst / area_tot ) CALL iom_put( 'ssttot', zsst / area_tot )
ENDIF ENDIF
! Vertical integral of temperature ! Vertical integral of temperature
IF( iom_use( 'tosmint_pot') ) THEN IF( iom_use( 'tosmint_pot') ) THEN
z2d(:,:) = 0._wp z2d(:,:) = 0._wp
DO_3D( 1, 1, 1, 1, 1, jpkm1 ) DO_3D( 0, 0, 0, 0, 1, jpkm1 )
z2d(ji,jj) = z2d(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) * ztpot(ji,jj,jk) z2d(ji,jj) = z2d(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) * z3d(ji,jj,jk)
END_3D END_3D
CALL iom_put( 'tosmint_pot', z2d ) CALL iom_put( 'tosmint_pot', z2d )
ENDIF ENDIF
DEALLOCATE( ztpot )
ENDIF ENDIF
ELSE ELSE
IF( iom_use('ssttot') ) THEN ! Output sst in case we use EOS-80 IF( iom_use('ssttot') ) THEN ! Output sst in case we use EOS-80
...@@ -269,33 +272,31 @@ CONTAINS ...@@ -269,33 +272,31 @@ CONTAINS
! Work done against stratification by vertical mixing ! Work done against stratification by vertical mixing
! Exclude points where rn2 is negative as convection kicks in here and ! Exclude points where rn2 is negative as convection kicks in here and
! work is not being done against stratification ! work is not being done against stratification
ALLOCATE( zpe(jpi,jpj) ) z2d(:,:) = 0._wp
zpe(:,:) = 0._wp
IF( ln_zdfddm ) THEN IF( ln_zdfddm ) THEN
DO_3D( 1, 1, 1, 1, 2, jpk ) DO_3D( 0, 0, 0, 0, 2, jpk )
IF( rn2(ji,jj,jk) > 0._wp ) THEN IF( rn2(ji,jj,jk) > 0._wp ) THEN
zrw = ( gdept(ji,jj,jk,Kmm) - gdepw(ji,jj,jk,Kmm) ) / e3w(ji,jj,jk,Kmm) zrw = ( gdept(ji,jj,jk,Kmm) - gdepw(ji,jj,jk,Kmm) ) / e3w(ji,jj,jk,Kmm)
! !
zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw
zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw
! !
zpe(ji, jj) = zpe(ji,jj) & z2d(ji, jj) = z2d(ji,jj) &
& - grav * ( avt(ji,jj,jk) * zaw * (ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) & & - grav * ( avt(ji,jj,jk) * zaw * (ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) &
& - avs(ji,jj,jk) * zbw * (ts(ji,jj,jk-1,jp_sal,Kmm) - ts(ji,jj,jk,jp_sal,Kmm) ) ) & - avs(ji,jj,jk) * zbw * (ts(ji,jj,jk-1,jp_sal,Kmm) - ts(ji,jj,jk,jp_sal,Kmm) ) )
ENDIF ENDIF
END_3D END_3D
ELSE ELSE
DO_3D( 1, 1, 1, 1, 1, jpk ) DO_3D( 0, 0, 0, 0, 1, jpk )
zpe(ji,jj) = zpe(ji,jj) + avt(ji,jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rho0 * e3w(ji,jj,jk,Kmm) z2d(ji,jj) = z2d(ji,jj) + avt(ji,jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rho0 * e3w(ji,jj,jk,Kmm)
END_3D END_3D
ENDIF ENDIF
CALL iom_put( 'tnpeo', zpe ) CALL iom_put( 'tnpeo', z2d )
DEALLOCATE( zpe )
ENDIF ENDIF
IF( l_ar5 ) THEN IF( l_ar5 ) THEN
DEALLOCATE( zarea_ssh , zbotpres, z2d ) DEALLOCATE( zarea_ssh , z2d, z3d )
DEALLOCATE( ztsn ) DEALLOCATE( ztsn )
ENDIF ENDIF
! !
IF( ln_timing ) CALL timing_stop('dia_ar5') IF( ln_timing ) CALL timing_stop('dia_ar5')
...@@ -316,33 +317,33 @@ CONTAINS ...@@ -316,33 +317,33 @@ CONTAINS
REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in) :: pvflx ! v-flux of advection/diffusion REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in) :: pvflx ! v-flux of advection/diffusion
! !
INTEGER :: ji, jj, jk INTEGER :: ji, jj, jk
REAL(wp), DIMENSION(A2D(nn_hls)) :: z2d REAL(wp), DIMENSION(A2D(0)) :: z2d
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
z2d(:,:) = puflx(:,:,1) z2d(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 ) DO_3D( 0, 0, 0, 0, 1, jpkm1 )
z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk) z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk)
END_3D END_3D
IF( cptr == 'adv' ) THEN IF( cptr == 'adv' ) THEN
IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * z2d(:,:) ) ! advective heat transport in i-direction IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * z2d(:,:) ) ! advective heat transport in i-direction
IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0 * z2d(:,:) ) ! advective salt transport in i-direction IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0 * z2d(:,:) ) ! advective salt transport in i-direction
ELSE IF( cptr == 'ldf' ) THEN ELSE IF( cptr == 'ldf' ) THEN
IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * z2d(:,:) ) ! diffusive heat transport in i-direction IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * z2d(:,:) ) ! diffusive heat transport in i-direction
IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0 * z2d(:,:) ) ! diffusive salt transport in i-direction IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0 * z2d(:,:) ) ! diffusive salt transport in i-direction
ENDIF ENDIF
! !
z2d(:,:) = pvflx(:,:,1) z2d(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 ) DO_3D( 0, 0, 0, 0, 1, jpkm1 )
z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk) z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk)
END_3D END_3D
IF( cptr == 'adv' ) THEN IF( cptr == 'adv' ) THEN
IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * z2d(:,:) ) ! advective heat transport in j-direction IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * z2d(:,:) ) ! advective heat transport in j-direction
IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0 * z2d(:,:) ) ! advective salt transport in j-direction IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0 * z2d(:,:) ) ! advective salt transport in j-direction
ELSE IF( cptr == 'ldf' ) THEN ELSE IF( cptr == 'ldf' ) THEN
IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * z2d(:,:) ) ! diffusive heat transport in j-direction IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * z2d(:,:) ) ! diffusive heat transport in j-direction
IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0 * z2d(:,:) ) ! diffusive salt transport in j-direction IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0 * z2d(:,:) ) ! diffusive salt transport in j-direction
ENDIF ENDIF
END SUBROUTINE dia_ar5_hst END SUBROUTINE dia_ar5_hst
...@@ -380,10 +381,10 @@ CONTAINS ...@@ -380,10 +381,10 @@ CONTAINS
area_tot = glob_sum( 'diaar5', e1e2t(:,:) ) area_tot = glob_sum( 'diaar5', e1e2t(:,:) )
ALLOCATE( zvol0(jpi,jpj) ) ALLOCATE( zvol0(A2D(0)) )
zvol0 (:,:) = 0._wp zvol0 (:,:) = 0._wp
thick0(:,:) = 0._wp thick0(:,:) = 0._wp
DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! interpolation of salinity at the last ocean level (i.e. the partial step) DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! interpolation of salinity at the last ocean level (i.e. the partial step)
zztmp = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) zztmp = tmask(ji,jj,jk) * e3t_0(ji,jj,jk)
zvol0 (ji,jj) = zvol0 (ji,jj) + zztmp * e1e2t(ji,jj) zvol0 (ji,jj) = zvol0 (ji,jj) + zztmp * e1e2t(ji,jj)
thick0(ji,jj) = thick0(ji,jj) + zztmp thick0(ji,jj) = thick0(ji,jj) + zztmp
...@@ -392,16 +393,16 @@ CONTAINS ...@@ -392,16 +393,16 @@ CONTAINS
DEALLOCATE( zvol0 ) DEALLOCATE( zvol0 )
IF( iom_use( 'sshthster' ) ) THEN IF( iom_use( 'sshthster' ) ) THEN
ALLOCATE( zsaldta(jpi,jpj,jpk,jpts) ) ALLOCATE( zsaldta(A2D(0),jpk,jpts) )
CALL iom_open ( 'sali_ref_clim_monthly', inum ) CALL iom_open ( 'sali_ref_clim_monthly', inum )
CALL iom_get ( inum, jpdom_global, 'vosaline' , zsaldta(:,:,:,1), 1 ) CALL iom_get ( inum, jpdom_global, 'vosaline' , zsaldta(:,:,:,1), 1 )
CALL iom_get ( inum, jpdom_global, 'vosaline' , zsaldta(:,:,:,2), 12 ) CALL iom_get ( inum, jpdom_global, 'vosaline' , zsaldta(:,:,:,2), 12 )
CALL iom_close( inum ) CALL iom_close( inum )
sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )
sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) sn0(:,:,:) = sn0(:,:,:) * tmask(A2D(0),:)
IF( ln_zps ) THEN ! z-coord. partial steps IF( ln_zps ) THEN ! z-coord. partial steps
DO_2D( 1, 1, 1, 1 ) ! interpolation of salinity at the last ocean level (i.e. the partial step) DO_2D( 0, 0, 0, 0 ) ! interpolation of salinity at the last ocean level (i.e. the partial step)
ik = mbkt(ji,jj) ik = mbkt(ji,jj)
IF( ik > 1 ) THEN IF( ik > 1 ) THEN
zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
......
src/OCE/DIA/diacfl.F90
View file @ 4dbfc9bb
...@@ -51,19 +51,19 @@ CONTAINS ...@@ -51,19 +51,19 @@ CONTAINS
INTEGER, INTENT(in) :: kt ! ocean time-step index INTEGER, INTENT(in) :: kt ! ocean time-step index
INTEGER, INTENT(in) :: Kmm ! ocean time level index INTEGER, INTENT(in) :: Kmm ! ocean time level index
! !
INTEGER :: ji, jj, jk ! dummy loop indices INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zCu_max, zCv_max, zCw_max ! local scalars REAL(wp) :: zCu_max, zCv_max, zCw_max ! local scalars
INTEGER , DIMENSION(3) :: iloc_u , iloc_v , iloc_w , iloc ! workspace INTEGER , DIMENSION(3) :: iloc_u , iloc_v , iloc_w , iloc ! workspace
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zCu_cfl, zCv_cfl, zCw_cfl ! workspace REAL(wp), DIMENSION(A2D(0),jpk) :: zCu_cfl, zCv_cfl, zCw_cfl ! workspace
LOGICAL , DIMENSION(jpi,jpj,jpk) :: llmsk LOGICAL , DIMENSION(A2D(0),jpk) :: llmsk
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
IF( ln_timing ) CALL timing_start('dia_cfl') IF( ln_timing ) CALL timing_start('dia_cfl')
! !
llmsk( 1:nn_hls,:,:) = .FALSE. ! exclude halos from the checked region !llmsk( 1:nn_hls,:,:) = .FALSE. ! exclude halos from the checked region
llmsk(Nie0+1: jpi,:,:) = .FALSE. !llmsk(Nie0+1: jpi,:,:) = .FALSE.
llmsk(:, 1:nn_hls,:) = .FALSE. !llmsk(:, 1:nn_hls,:) = .FALSE.
llmsk(:,Nje0+1: jpj,:) = .FALSE. !llmsk(:,Nje0+1: jpj,:) = .FALSE.
! !
DO_3D( 0, 0, 0, 0, 1, jpk ) ! calculate Courant numbers DO_3D( 0, 0, 0, 0, 1, jpk ) ! calculate Courant numbers
zCu_cfl(ji,jj,jk) = ABS( uu(ji,jj,jk,Kmm) ) * rDt / e1u (ji,jj) ! for i-direction zCu_cfl(ji,jj,jk) = ABS( uu(ji,jj,jk,Kmm) ) * rDt / e1u (ji,jj) ! for i-direction
......
src/OCE/DIA/diadct.F90
View file @ 4dbfc9bb
...@@ -414,9 +414,9 @@ CONTAINS ...@@ -414,9 +414,9 @@ CONTAINS
!verify if the point is on the local domain:(1,Nie0)*(1,Nje0) !verify if the point is on the local domain:(1,Nie0)*(1,Nje0)
IF( iiloc >= 1 .AND. iiloc <= Nie0 .AND. & IF( iiloc >= 1 .AND. iiloc <= Nie0 .AND. &
ijloc >= 1 .AND. ijloc <= Nje0 )THEN ijloc >= 1 .AND. ijloc <= Nje0 )THEN
iptloc = iptloc + 1 ! count local points iptloc = iptloc + 1 ! count local points
secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo),mj0(ijglo)) ! store local coordinates secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo,nn_hls),mj0(ijglo,nn_hls)) ! store local coordinates
secs(jsec)%direction(iptloc) = directemp(jpt) ! store local direction secs(jsec)%direction(iptloc) = directemp(jpt) ! store local direction
ENDIF ENDIF
! !
END DO END DO
......
src/OCE/DIA/diadetide.F90
View file @ 4dbfc9bb
...@@ -5,11 +5,11 @@ MODULE diadetide ...@@ -5,11 +5,11 @@ MODULE diadetide
!!====================================================================== !!======================================================================
!! History : ! 2019 (S. Mueller) !! History : ! 2019 (S. Mueller)
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
USE par_oce , ONLY : wp, jpi, jpj USE par_oce
USE in_out_manager , ONLY : lwp, numout USE in_out_manager
USE iom , ONLY : iom_put USE iom
USE dom_oce , ONLY : rn_Dt, nsec_day USE dom_oce
USE phycst , ONLY : rpi USE phycst
USE tide_mod USE tide_mod
#if defined key_xios #if defined key_xios
USE xios USE xios
...@@ -24,6 +24,8 @@ MODULE diadetide ...@@ -24,6 +24,8 @@ MODULE diadetide
PUBLIC :: dia_detide_init, dia_detide PUBLIC :: dia_detide_init, dia_detide
!! * Substitutions
# include "do_loop_substitute.h90"
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2019) !! NEMO/OCE 4.0 , NEMO Consortium (2019)
!! $Id$ !! $Id$
...@@ -90,9 +92,9 @@ CONTAINS ...@@ -90,9 +92,9 @@ CONTAINS
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kt INTEGER, INTENT(in) :: kt
REAL(wp), DIMENSION(jpi,jpj) :: zwght_2D REAL(wp), DIMENSION(A2D(0)) :: zwght_2D
REAL(wp) :: zwght, ztmp REAL(wp) :: zwght, ztmp
INTEGER :: jn INTEGER :: ji, jj, jn
! Compute detiding weight at the current time-step; the daily total weight ! Compute detiding weight at the current time-step; the daily total weight
! is one, and the daily summation of a diagnosed field multiplied by this ! is one, and the daily summation of a diagnosed field multiplied by this
...@@ -104,7 +106,10 @@ CONTAINS ...@@ -104,7 +106,10 @@ CONTAINS
zwght = zwght + 1.0_wp / REAL( ndiadetide, KIND=wp ) zwght = zwght + 1.0_wp / REAL( ndiadetide, KIND=wp )
END IF END IF
END DO END DO
zwght_2D(:,:) = zwght
DO_2D( 0, 0, 0, 0 )
zwght_2D(ji,jj) = zwght
END_2D
CALL iom_put( "diadetide_weight", zwght_2D) CALL iom_put( "diadetide_weight", zwght_2D)
END SUBROUTINE dia_detide END SUBROUTINE dia_detide
......