From 0a461421df4cf81af1e09c5558d82b7b545bb141 Mon Sep 17 00:00:00 2001 From: sparonuz Date: Wed, 25 Oct 2023 11:59:25 +0200 Subject: [PATCH 1/5] Fix numerical instability and indentation --- V4.0/nemo_sources/src/ICE/ice.F90 | 4 +- V4.0/nemo_sources/src/ICE/icectl.F90 | 29 ++++++--- V4.0/nemo_sources/src/ICE/icedyn_rhg_evp.F90 | 2 +- V4.0/nemo_sources/src/ICE/icevar.F90 | 4 +- V4.0/nemo_sources/src/OCE/ASM/bias.F90 | 1 - V4.0/nemo_sources/src/OCE/ASM/biaspar.F90 | 14 ++--- V4.0/nemo_sources/src/OCE/CRS/crsini.F90 | 10 ---- V4.0/nemo_sources/src/OCE/DIA/diacfl.F90 | 5 +- V4.0/nemo_sources/src/OCE/DIA/diadct.F90 | 3 - V4.0/nemo_sources/src/OCE/DIA/diaptr.F90 | 18 +++--- V4.0/nemo_sources/src/OCE/DOM/closea.F90 | 2 +- V4.0/nemo_sources/src/OCE/DOM/dom_oce.F90 | 60 +++++++++---------- V4.0/nemo_sources/src/OCE/DOM/domngb.F90 | 6 +- V4.0/nemo_sources/src/OCE/DOM/domvvl.F90 | 6 +- V4.0/nemo_sources/src/OCE/DOM/domzgr.F90 | 10 ++-- V4.0/nemo_sources/src/OCE/ICB/icbutl.F90 | 1 - V4.0/nemo_sources/src/OCE/IOM/iom.F90 | 7 +-- .../src/OCE/LBC/mpp_loc_generic.h90 | 6 +- V4.0/nemo_sources/src/OCE/LBC/mppini.F90 | 2 +- .../src/OCE/OBS/find_obs_proc.h90 | 2 +- V4.0/nemo_sources/src/OCE/OBS/greg2jul.h90 | 2 +- V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis.h90 | 2 +- .../src/OCE/OBS/grt_cir_dis_saa.h90 | 2 +- V4.0/nemo_sources/src/OCE/OBS/jul2greg.h90 | 2 +- V4.0/nemo_sources/src/OCE/OBS/linquad.h90 | 2 +- V4.0/nemo_sources/src/OCE/OBS/maxdist.h90 | 2 +- .../src/OCE/OBS/obs_averg_h2d.F90 | 4 +- .../src/OCE/OBS/obs_conv_functions.h90 | 2 +- .../src/OCE/OBS/obs_grd_bruteforce.h90 | 2 +- V4.0/nemo_sources/src/OCE/OBS/obs_grid.F90 | 1 - V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 | 4 -- V4.0/nemo_sources/src/OCE/OBS/obs_rot_vel.F90 | 3 - .../nemo_sources/src/OCE/OBS/obsinter_h2d.h90 | 2 +- .../nemo_sources/src/OCE/OBS/obsinter_z1d.h90 | 2 +- V4.0/nemo_sources/src/OCE/SBC/sbc_phy.F90 | 3 - V4.0/nemo_sources/src/OCE/SBC/sbcdcy.F90 | 2 +- V4.0/nemo_sources/src/OCE/SBC/sbcfwb.F90 | 6 +- V4.0/nemo_sources/src/OCE/SBC/sbcisf.F90 | 4 -- V4.0/nemo_sources/src/OCE/SBC/sbcrnf.F90 | 2 +- V4.0/nemo_sources/src/OCE/SBC/sbcsglcpl.F90 | 5 +- V4.0/nemo_sources/src/OCE/STO/stopar.F90 | 4 +- V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 | 4 +- V4.0/nemo_sources/src/OCE/TRA/tranpc.F90 | 2 +- V4.0/nemo_sources/src/OCE/TRD/trdvor.F90 | 2 +- V4.0/nemo_sources/src/OCE/ZDF/zdfddm.F90 | 2 +- V4.0/nemo_sources/src/OCE/stpctl.F90 | 2 +- 46 files changed, 119 insertions(+), 143 deletions(-) diff --git a/V4.0/nemo_sources/src/ICE/ice.F90 b/V4.0/nemo_sources/src/ICE/ice.F90 index fcc77b5..87e8aad 100644 --- a/V4.0/nemo_sources/src/ICE/ice.F90 +++ b/V4.0/nemo_sources/src/ICE/ice.F90 @@ -237,8 +237,8 @@ MODULE ice REAL(wp), PUBLIC :: rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft !: conservation diagnostics REAL(wp), PUBLIC, PARAMETER :: epsi06 = 1.e-06_wp !: small number REAL(wp), PUBLIC, PARAMETER :: epsi08 = 1.e-08_wp !: small number - REAL(wp), PUBLIC, PARAMETER :: epsi10 = 1.e-10_dp !: small number - REAL(wp), PUBLIC, PARAMETER :: epsi20 = 1.e-20_dp !: small number + REAL(wp), PUBLIC, PARAMETER :: epsi10 = 1.e-10_wp !: small number + REAL(wp), PUBLIC, PARAMETER :: epsi20 = 1.e-20_wp !: small number ! !!** define arrays REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce,v_oce !: surface ocean velocity used in ice dynamics diff --git a/V4.0/nemo_sources/src/ICE/icectl.F90 b/V4.0/nemo_sources/src/ICE/icectl.F90 index ee7ac2a..c13535c 100644 --- a/V4.0/nemo_sources/src/ICE/icectl.F90 +++ b/V4.0/nemo_sources/src/ICE/icectl.F90 @@ -99,29 +99,38 @@ CONTAINS ! mass flux pdiag_fv = glob_sum( 'icectl', & - & ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) * e1e2t ) + & ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & + & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) * e1e2t ) ! salt flux pdiag_fs = glob_sum( 'icectl', & - & ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) + & ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + & + & sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) ! heat flux pdiag_ft = glob_sum( 'icectl', & - & ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) + & ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & + & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) ELSEIF( icount == 1 ) THEN ! -- mass diag -- ! zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) * e1e2t ) & & - pdiag_v ) * r1_rdtice & - & + glob_sum( 'icectl', ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) * e1e2t ) & + & + glob_sum( 'icectl', ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + & + & wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + & + & wfx_ice_sub + wfx_spr ) * e1e2t ) & & - pdiag_fv ! ! -- salt diag -- ! - zdiag_salt = ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) - pdiag_s ) * r1_rdtice + glob_sum( 'icectl', ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) & + zdiag_salt = ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) - pdiag_s ) * r1_rdtice & + & + glob_sum( 'icectl', ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + & + & sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) & & - pdiag_fs ! ! -- heat diag -- ! - zdiag_heat = ( glob_sum( 'icectl', ( SUM(SUM(e_i, dim=4), dim=3) + SUM(SUM(e_s, dim=4), dim=3) ) * e1e2t ) - pdiag_t ) * r1_rdtice & - & + glob_sum( 'icectl', ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) & + zdiag_heat = ( glob_sum( 'icectl', ( SUM(SUM(e_i, dim=4), dim=3) + SUM(SUM(e_s, dim=4), dim=3) ) * e1e2t ) - pdiag_t & + & ) * r1_rdtice & + & + glob_sum( 'icectl', ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & + & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) & & - pdiag_ft ! -- min/max diag -- ! @@ -192,7 +201,8 @@ CONTAINS ! water flux ! -- mass diag -- ! - zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + wfx_pnd + diag_vice + diag_vsnw + diag_vpnd - diag_adv_mass ) * e1e2t ) + zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + wfx_pnd & + & + diag_vice + diag_vsnw + diag_vpnd - diag_adv_mass ) * e1e2t ) ! -- salt diag -- ! zdiag_salt = glob_sum( 'icectl', ( sfx + diag_sice - diag_adv_salt ) * e1e2t ) @@ -805,7 +815,8 @@ CONTAINS !!ENDIF ! -- mass diag -- ! - zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + wfx_pnd + diag_vice + diag_vsnw + diag_vpnd - diag_adv_mass ) * e1e2t ) * rdt_ice + zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + wfx_pnd & + & + diag_vice + diag_vsnw + diag_vpnd - diag_adv_mass ) * e1e2t ) * rdt_ice zdiag_adv_mass = glob_sum( 'icectl', diag_adv_mass * e1e2t ) * rdt_ice ! -- salt diag -- ! diff --git a/V4.0/nemo_sources/src/ICE/icedyn_rhg_evp.F90 b/V4.0/nemo_sources/src/ICE/icedyn_rhg_evp.F90 index a8c0136..9e36876 100644 --- a/V4.0/nemo_sources/src/ICE/icedyn_rhg_evp.F90 +++ b/V4.0/nemo_sources/src/ICE/icedyn_rhg_evp.F90 @@ -165,7 +165,7 @@ CONTAINS REAL(wp), DIMENSION(jpi,jpj) :: zmsk01x, zmsk01y ! dummy arrays REAL(wp), DIMENSION(jpi,jpj) :: zmsk00x, zmsk00y ! mask for ice presence - REAL(wp), PARAMETER :: zepsi = 1.0e-20_dp ! tolerance parameter + REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter REAL(wp), PARAMETER :: zmmin = 1._wp ! ice mass (kg/m2) below which ice velocity becomes very small REAL(wp), PARAMETER :: zamin = 0.001_wp ! ice concentration below which ice velocity becomes very small !! --- check convergence diff --git a/V4.0/nemo_sources/src/ICE/icevar.F90 b/V4.0/nemo_sources/src/ICE/icevar.F90 index 3d6a361..cf5a767 100644 --- a/V4.0/nemo_sources/src/ICE/icevar.F90 +++ b/V4.0/nemo_sources/src/ICE/icevar.F90 @@ -266,7 +266,7 @@ CONTAINS !------------------- ! Ice temperature [K] (with a minimum value (rt0 - 100.)) !------------------- - zlay_i = REAL( nlay_i , wp ) ! number of layers + zlay_i = REAL( nlay_i , dp ) ! number of layers DO jl = 1, jpl DO jk = 1, nlay_i DO jj = 1, jpj @@ -417,7 +417,7 @@ CONTAINS ! DO jl = 1, jpl DO jk = 1, nlay_i - zargtemp = ( REAL(jk,dp) - 0.5_wp ) * r1_nlay_i + zargtemp = ( REAL(jk,dp) - 0.5_dp ) * r1_nlay_i sz_i(:,:,jk,jl) = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) ) END DO END DO diff --git a/V4.0/nemo_sources/src/OCE/ASM/bias.F90 b/V4.0/nemo_sources/src/OCE/ASM/bias.F90 index 3ac2a17..5e63e10 100644 --- a/V4.0/nemo_sources/src/OCE/ASM/bias.F90 +++ b/V4.0/nemo_sources/src/OCE/ASM/bias.F90 @@ -174,7 +174,6 @@ MODULE bias REAL(wp) :: epsln = 1.0e-20_wp ! a small positive number -# include "single_precision_substitute.h90" # include "single_precision_substitute.h90" CONTAINS diff --git a/V4.0/nemo_sources/src/OCE/ASM/biaspar.F90 b/V4.0/nemo_sources/src/OCE/ASM/biaspar.F90 index 99d58ae..fd115db 100644 --- a/V4.0/nemo_sources/src/OCE/ASM/biaspar.F90 +++ b/V4.0/nemo_sources/src/OCE/ASM/biaspar.F90 @@ -33,16 +33,14 @@ MODULE biaspar REAL(wp), PUBLIC, DIMENSION(:,:,:,:), ALLOCATABLE :: & & bias_d, & !: T/S bias field for direct correction & bias_p !: T/S " " P correction - - REAL(dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: rhd_pc - - - - - REAL(dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: gru_pc, grv_pc - + + REAL(dp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: & + & rhd_pc !: Press corrtd density from online to use in dyn_hpg + REAL(dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: & + & gru_pc, & !: Press corrtd bottom pressure gradient (x-dir) + & grv_pc !: Press corrtd bottom pressure gradient (y-dir) diff --git a/V4.0/nemo_sources/src/OCE/CRS/crsini.F90 b/V4.0/nemo_sources/src/OCE/CRS/crsini.F90 index 870813d..c48bec8 100644 --- a/V4.0/nemo_sources/src/OCE/CRS/crsini.F90 +++ b/V4.0/nemo_sources/src/OCE/CRS/crsini.F90 @@ -33,16 +33,6 @@ MODULE crsini !! Software governed by the CeCILL license (see ./LICENSE) !!---------------------------------------------------------------------- # include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" CONTAINS SUBROUTINE crs_init diff --git a/V4.0/nemo_sources/src/OCE/DIA/diacfl.F90 b/V4.0/nemo_sources/src/OCE/DIA/diacfl.F90 index d2305ac..be8600b 100644 --- a/V4.0/nemo_sources/src/OCE/DIA/diacfl.F90 +++ b/V4.0/nemo_sources/src/OCE/DIA/diacfl.F90 @@ -33,6 +33,7 @@ MODULE diacfl !! * Substitutions # include "vectopt_loop_substitute.h90" +# include "single_precision_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !! $Id: diacfl.F90 11532 2019-09-11 13:30:16Z smasson $ @@ -50,9 +51,9 @@ CONTAINS INTEGER, INTENT(in) :: kt ! ocean time-step index ! INTEGER :: ji, jj, jk ! dummy loop indices - REAL(dp) :: z2dt, zCu_max, zCv_max, zCw_max ! local scalars + REAL(wp) :: z2dt, zCu_max, zCv_max, zCw_max ! local scalars INTEGER , DIMENSION(3) :: iloc_u , iloc_v , iloc_w , iloc ! workspace - REAL(dp), DIMENSION(jpi,jpj,jpk) :: zCu_cfl, zCv_cfl, zCw_cfl ! workspace + REAL(wp), DIMENSION(jpi,jpj,jpk) :: zCu_cfl, zCv_cfl, zCw_cfl ! workspace !!---------------------------------------------------------------------- ! IF( ln_timing ) CALL timing_start('dia_cfl') diff --git a/V4.0/nemo_sources/src/OCE/DIA/diadct.F90 b/V4.0/nemo_sources/src/OCE/DIA/diadct.F90 index 230836c..7dd2de2 100644 --- a/V4.0/nemo_sources/src/OCE/DIA/diadct.F90 +++ b/V4.0/nemo_sources/src/OCE/DIA/diadct.F90 @@ -95,9 +95,6 @@ MODULE diadct !! Software governed by the CeCILL license (see ./LICENSE) !!---------------------------------------------------------------------- # include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" CONTAINS INTEGER FUNCTION diadct_alloc() diff --git a/V4.0/nemo_sources/src/OCE/DIA/diaptr.F90 b/V4.0/nemo_sources/src/OCE/DIA/diaptr.F90 index 6c0d2c5..5854508 100644 --- a/V4.0/nemo_sources/src/OCE/DIA/diaptr.F90 +++ b/V4.0/nemo_sources/src/OCE/DIA/diaptr.F90 @@ -33,7 +33,7 @@ MODULE diaptr INTERFACE ptr_sj MODULE PROCEDURE ptr_sj_3d_dp, ptr_sj_3d_sp, ptr_sj_2d - END INTERFACE + END INTERFACE ptr_sj INTERFACE dia_ptr_hst MODULE PROCEDURE dia_ptr_hst_dp, dia_ptr_hst_sp @@ -397,8 +397,7 @@ CONTAINS ! END SUBROUTINE dia_ptr_init - - SUBROUTINE dia_ptr_hst_sp( ktra, cptr, pva ) + SUBROUTINE dia_ptr_hst_sp( ktra, cptr, pva ) !!---------------------------------------------------------------------- !! *** ROUTINE dia_ptr_hst *** !!---------------------------------------------------------------------- @@ -557,7 +556,7 @@ CONTAINS END FUNCTION dia_ptr_alloc - FUNCTION ptr_sj_3d_dp( pva, pmsk ) RESULT ( p_fval ) + FUNCTION ptr_sj_3d_sp( pva, pmsk ) RESULT ( p_fval ) !!---------------------------------------------------------------------- !! *** ROUTINE ptr_sj_3d *** !! @@ -568,7 +567,7 @@ CONTAINS !! !! ** Action : - p_fval: i-k-mean poleward flux of pva !!---------------------------------------------------------------------- - REAL(dp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point + REAL(sp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point REAL(wp), INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask ! INTEGER :: ji, jj, jk ! dummy loop arguments @@ -591,9 +590,9 @@ CONTAINS CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl) #endif ! - END FUNCTION ptr_sj_3d_dp + END FUNCTION ptr_sj_3d_sp - FUNCTION ptr_sj_3d_sp( pva, pmsk ) RESULT ( p_fval ) + FUNCTION ptr_sj_3d_dp( pva, pmsk ) RESULT ( p_fval ) !!---------------------------------------------------------------------- !! *** ROUTINE ptr_sj_3d *** !! @@ -604,7 +603,7 @@ CONTAINS !! !! ** Action : - p_fval: i-k-mean poleward flux of pva !!---------------------------------------------------------------------- - REAL(sp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point + REAL(dp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point REAL(wp), INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask ! INTEGER :: ji, jj, jk ! dummy loop arguments @@ -627,8 +626,7 @@ CONTAINS CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl) #endif ! - END FUNCTION ptr_sj_3d_sp - + END FUNCTION ptr_sj_3d_dp FUNCTION ptr_sj_2d( pva, pmsk ) RESULT ( p_fval ) !!---------------------------------------------------------------------- diff --git a/V4.0/nemo_sources/src/OCE/DOM/closea.F90 b/V4.0/nemo_sources/src/OCE/DOM/closea.F90 index aef933d..f2e1693 100644 --- a/V4.0/nemo_sources/src/OCE/DOM/closea.F90 +++ b/V4.0/nemo_sources/src/OCE/DOM/closea.F90 @@ -206,7 +206,7 @@ CONTAINS ! INTEGER :: ierr INTEGER :: jc, jcr, jce ! dummy loop indices - REAL(dp), PARAMETER :: rsmall = 1.e-20_dp ! Closed sea correction epsilon + REAL(wp), PARAMETER :: rsmall = 1.e-20_wp ! Closed sea correction epsilon REAL(wp) :: zfwf_total, zcoef, zcoef1 ! REAL(wp), DIMENSION(jncs) :: zfwf !: REAL(wp), DIMENSION(jncsr+1) :: zfwfr !: freshwater fluxes over closed seas diff --git a/V4.0/nemo_sources/src/OCE/DOM/dom_oce.F90 b/V4.0/nemo_sources/src/OCE/DOM/dom_oce.F90 index ed6b138..e859c36 100644 --- a/V4.0/nemo_sources/src/OCE/DOM/dom_oce.F90 +++ b/V4.0/nemo_sources/src/OCE/DOM/dom_oce.F90 @@ -110,26 +110,26 @@ MODULE dom_oce !!---------------------------------------------------------------------- !! horizontal curvilinear coordinate and scale factors !! --------------------------------------------------------------------- - REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: glamt, glamf!: longitude at t, u, v, f-points [degree] - REAL(dp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: glamu, glamv!: longitude at t, u, v, f-points [degree] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: gphit, gphif!: latitude at t, u, v, f-points [degree] - REAL(dp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: gphiu, gphiv!: latitude at t, u, v, f-points [degree] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: r1_e1t, r1_e2t!: t-point horizontal scale factors [m] - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1t, e2t!: t-point horizontal scale factors [m] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e2u!: horizontal scale factors at u-point [m] - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1u, r1_e1u, r1_e2u!: horizontal scale factors at u-point [m] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1v!: horizontal scale factors at v-point [m] - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: r1_e1v, e2v, r1_e2v!: horizontal scale factors at v-point [m] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: r1_e1f, r1_e2f!: horizontal scale factors at f-point [m] - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1f, e2f!: horizontal scale factors at f-point [m] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: glamt, glamf !: longitude at t, u, v, f-points [degree] + REAL(dp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: glamu, glamv !: longitude at t, u, v, f-points [degree] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: gphit, gphif !: latitude at t, u, v, f-points [degree] + REAL(dp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: gphiu, gphiv !: latitude at t, u, v, f-points [degree] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: r1_e1t, r1_e2t !: t-point horizontal scale factors [m] + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1t, e2t !: t-point horizontal scale factors [m] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e2u !: horizontal scale factors at u-point [m] + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1u, r1_e1u, r1_e2u !: horizontal scale factors at u-point [m] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1v !: horizontal scale factors at v-point [m] + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: r1_e1v, e2v, r1_e2v !: horizontal scale factors at v-point [m] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: r1_e1f, r1_e2f !: horizontal scale factors at f-point [m] + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1f, e2f !: horizontal scale factors at f-point [m] ! - REAL(dp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2t , r1_e1e2t !: associated metrics at t-point - REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2u , r1_e1e2u , e2_e1u !: associated metrics at u-point - REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2v , r1_e1e2v , e1_e2v !: associated metrics at v-point - REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: r1_e1e2f!: associated metrics at f-point - REAL(dp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2f!: associated metrics at f-point + REAL(dp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2t , r1_e1e2t !: associated metrics at t-point + REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2u , r1_e1e2u , e2_e1u !: associated metrics at u-point + REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2v , r1_e1e2v , e1_e2v !: associated metrics at v-point + REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: r1_e1e2f !: associated metrics at f-point + REAL(dp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2f !: associated metrics at f-point ! - REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: ff_f , ff_t !: Coriolis factor at f- & t-points [1/s] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: ff_f , ff_t !: Coriolis factor at f- & t-points [1/s] !!---------------------------------------------------------------------- !! vertical coordinate and scale factors !! --------------------------------------------------------------------- @@ -143,17 +143,17 @@ MODULE dom_oce REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f_0 , e3f_n !: f- vert. scale factor [m] REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_0 , e3w_b , e3w_n !: w- vert. scale factor [m] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_0!: uw-vert. scale factor [m] - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_b, e3uw_n!: uw-vert. scale factor [m] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_0!: vw-vert. scale factor [m] - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_b, e3vw_n!: vw-vert. scale factor [m] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_0 !: uw-vert. scale factor [m] + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_b, e3uw_n !: uw-vert. scale factor [m] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_0 !: vw-vert. scale factor [m] + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_b, e3vw_n !: vw-vert. scale factor [m] ! ! ref. ! before ! now ! - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_0, gdept_b!: t- depth [m] - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_n!: t- depth [m] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdepw_0 , gdepw_b , gdepw_n !: w- depth [m] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_0!: w- depth (sum of e3w) [m] - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_n!: w- depth (sum of e3w) [m] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_0, gdept_b !: t- depth [m] + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_n !: t- depth [m] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdepw_0 , gdepw_b , gdepw_n !: w- depth [m] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_0 !: w- depth (sum of e3w) [m] + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_n !: w- depth (sum of e3w) [m] ! ! ref. ! before ! now ! after ! REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0 , ht_n !: t-depth [m] @@ -167,9 +167,9 @@ MODULE dom_oce !! 1D reference vertical coordinate !! =-----------------====------ - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gdept_1d!: reference depth of t- and w-points (m) - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gdepw_1d!: reference depth of t- and w-points (m) - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: e3t_1d , e3w_1d !: reference vertical scale factors at T- and W-pts (m) + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gdept_1d !: reference depth of t- and w-points (m) + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gdepw_1d !: reference depth of t- and w-points (m) + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: e3t_1d , e3w_1d !: reference vertical scale factors at T- and W-pts (m) !!---------------------------------------------------------------------- diff --git a/V4.0/nemo_sources/src/OCE/DOM/domngb.F90 b/V4.0/nemo_sources/src/OCE/DOM/domngb.F90 index 9f6080d..5cf82e0 100644 --- a/V4.0/nemo_sources/src/OCE/DOM/domngb.F90 +++ b/V4.0/nemo_sources/src/OCE/DOM/domngb.F90 @@ -44,9 +44,9 @@ CONTAINS INTEGER :: ik ! working level INTEGER , DIMENSION(2) :: iloc REAL(wp) :: zlon - REAL(dp) :: zmini + REAL(wp) :: zmini REAL(wp), DIMENSION(jpi,jpj) :: zglam, zgphi, zdist - REAL(dp), DIMENSION(jpi,jpj) :: zmask + REAL(wp), DIMENSION(jpi,jpj) :: zmask !!-------------------------------------------------------------------- ! zmask(:,:) = 0._wp @@ -69,7 +69,7 @@ CONTAINS zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:) IF( lk_mpp ) THEN - CALL mpp_minloc( 'domngb', CASTDP(zdist(:,:)), zmask, zmini, iloc) + CALL mpp_minloc( 'domngb', zdist(:,:), zmask, zmini, iloc) kii = iloc(1) ; kjj = iloc(2) ELSE iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 ) diff --git a/V4.0/nemo_sources/src/OCE/DOM/domvvl.F90 b/V4.0/nemo_sources/src/OCE/DOM/domvvl.F90 index 7cd9c7c..8475394 100644 --- a/V4.0/nemo_sources/src/OCE/DOM/domvvl.F90 +++ b/V4.0/nemo_sources/src/OCE/DOM/domvvl.F90 @@ -299,7 +299,7 @@ CONTAINS INTEGER :: ji, jj, jk ! dummy loop indices INTEGER :: jj1, jj2, itid, ithreads ! openmp variables INTEGER , DIMENSION(3) :: ijk_max, ijk_min ! temporary integers - REAL(dp) :: z2dt, z_tmin, z_tmax ! local scalars + REAL(wp) :: z2dt, z_tmin, z_tmax ! local scalars LOGICAL :: ll_do_bclinic ! local logical REAL(wp), DIMENSION(jpi,jpj) :: zht, zwu, zwv, zhdiv REAL(dp), DIMENSION(jpi,jpj) :: z_scale @@ -463,8 +463,8 @@ CONTAINS ! - ML - test: for the moment, stop simulation for too large e3_t variations IF( ( z_tmax > rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN IF( lk_mpp ) THEN - CALL mpp_maxloc( 'domvvl', CASTDP(ze3t), tmask, z_tmax, ijk_max ) - CALL mpp_minloc( 'domvvl', CASTDP(ze3t), tmask, z_tmin, ijk_min ) + CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) + CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) ELSE ijk_max = MAXLOC( ze3t(:,:,:) ) ijk_max(1) = ijk_max(1) + nimpp - 1 diff --git a/V4.0/nemo_sources/src/OCE/DOM/domzgr.F90 b/V4.0/nemo_sources/src/OCE/DOM/domzgr.F90 index bae5f77..307601e 100644 --- a/V4.0/nemo_sources/src/OCE/DOM/domzgr.F90 +++ b/V4.0/nemo_sources/src/OCE/DOM/domzgr.F90 @@ -308,12 +308,12 @@ CONTAINS END DO END DO ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk - zk(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) ; miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) - zk(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) ; mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) - zk(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'F', 1.0_wp ) ; mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) + zk(:,:) = REAL( miku(:,:), dp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) ; miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) + zk(:,:) = REAL( mikv(:,:), dp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) ; mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) + zk(:,:) = REAL( mikf(:,:), dp ) ; CALL lbc_lnk( 'domzgr', zk, 'F', 1.0_wp ) ; mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) ! - zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) ; mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) - zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) ; mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) + zk(:,:) = REAL( mbku(:,:), dp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1.0_wp ) ; mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) + zk(:,:) = REAL( mbkv(:,:), dp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1.0_wp ) ; mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) ! END SUBROUTINE zgr_top_bot diff --git a/V4.0/nemo_sources/src/OCE/ICB/icbutl.F90 b/V4.0/nemo_sources/src/OCE/ICB/icbutl.F90 index ad8c157..15fce7a 100644 --- a/V4.0/nemo_sources/src/OCE/ICB/icbutl.F90 +++ b/V4.0/nemo_sources/src/OCE/ICB/icbutl.F90 @@ -52,7 +52,6 @@ MODULE icbutl !! Software governed by the CeCILL license (see ./LICENSE) !!---------------------------------------------------------------------- # include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" CONTAINS SUBROUTINE icb_utl_copy() diff --git a/V4.0/nemo_sources/src/OCE/IOM/iom.F90 b/V4.0/nemo_sources/src/OCE/IOM/iom.F90 index 23ff1ea..fb565ff 100644 --- a/V4.0/nemo_sources/src/OCE/IOM/iom.F90 +++ b/V4.0/nemo_sources/src/OCE/IOM/iom.F90 @@ -119,9 +119,6 @@ MODULE iom !! Software governed by the CeCILL license (see ./LICENSE) !!---------------------------------------------------------------------- # include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" CONTAINS #if defined key_multio @@ -3342,14 +3339,14 @@ CONTAINS ! idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') DO WHILE ( idx /= 0 ) - cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) + cldate = iom_sdate( CASTSP(fjulday + rdt / rday * REAL( nitend - nit000, dp )), ld24 = .TRUE. ) clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') END DO ! idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') DO WHILE ( idx /= 0 ) - cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) + cldate = iom_sdate( CASTSP(fjulday + rdt / rday * REAL( nitend - nit000, dp )), ld24 = .TRUE., ldfull = .TRUE. ) clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') END DO diff --git a/V4.0/nemo_sources/src/OCE/LBC/mpp_loc_generic.h90 b/V4.0/nemo_sources/src/OCE/LBC/mpp_loc_generic.h90 index 0f25c78..4e5f7fa 100644 --- a/V4.0/nemo_sources/src/OCE/LBC/mpp_loc_generic.h90 +++ b/V4.0/nemo_sources/src/OCE/LBC/mpp_loc_generic.h90 @@ -1,6 +1,6 @@ !== IN: ptab is an array ==! # if defined SINGLE_PRECISION -# define ARRAY_TYPE(i,j,k) REAL(dp) , INTENT(in ) :: ARRAY_IN(i,j,k) +# define ARRAY_TYPE(i,j,k) REAL(sp) , INTENT(in ) :: ARRAY_IN(i,j,k) # define MASK_TYPE(i,j,k) REAL(sp) , INTENT(in ) :: MASK_IN(i,j,k) # define PRECISION sp # else @@ -37,12 +37,12 @@ CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine ARRAY_TYPE(:,:,:) ! array on which loctrans operation is applied MASK_TYPE(:,:,:) ! local mask - REAL(dp) , INTENT( out) :: pmin ! Global minimum of ptab + REAL(PRECISION) , INTENT( out) :: pmin ! Global minimum of ptab INDEX_TYPE(:) ! index of minimum in global frame ! INTEGER :: ierror, ii, idim INTEGER :: index0 - REAL(dp) :: zmin ! local minimum + REAL(PRECISION) :: zmin ! local minimum INTEGER , DIMENSION(:), ALLOCATABLE :: ilocs REAL(dp), DIMENSION(2,1) :: zain, zaout !!----------------------------------------------------------------------- diff --git a/V4.0/nemo_sources/src/OCE/LBC/mppini.F90 b/V4.0/nemo_sources/src/OCE/LBC/mppini.F90 index 091a2d6..bbcd705 100644 --- a/V4.0/nemo_sources/src/OCE/LBC/mppini.F90 +++ b/V4.0/nemo_sources/src/OCE/LBC/mppini.F90 @@ -1,5 +1,5 @@ MODULE mppini -!!====================================================================== + !!====================================================================== !! *** MODULE mppini *** !! Ocean initialization : distributed memory computing initialization !!====================================================================== diff --git a/V4.0/nemo_sources/src/OCE/OBS/find_obs_proc.h90 b/V4.0/nemo_sources/src/OCE/OBS/find_obs_proc.h90 index ae385bd..5ae08dd 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/find_obs_proc.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/find_obs_proc.h90 @@ -1,4 +1,4 @@ -!!---------------------------------------------------------------------- + !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !! $Id: find_obs_proc.h90 10068 2018-08-28 14:09:04Z nicolasmartin $ !! Software governed by the CeCILL license (see ./LICENSE) diff --git a/V4.0/nemo_sources/src/OCE/OBS/greg2jul.h90 b/V4.0/nemo_sources/src/OCE/OBS/greg2jul.h90 index 84e4862..7a23296 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/greg2jul.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/greg2jul.h90 @@ -1,4 +1,4 @@ -SUBROUTINE greg2jul( ksec, kmin, khour, kday, kmonth, kyear, pjulian, & + SUBROUTINE greg2jul( ksec, kmin, khour, kday, kmonth, kyear, pjulian, & & krefdate ) !!----------------------------------------------------------------------- !! diff --git a/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis.h90 b/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis.h90 index c8e7f8c..5962383 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis.h90 @@ -1,4 +1,4 @@ -!!---------------------------------------------------------------------- + !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !! $Id: grt_cir_dis.h90 10068 2018-08-28 14:09:04Z nicolasmartin $ !! Software governed by the CeCILL license (see ./LICENSE) diff --git a/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis_saa.h90 b/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis_saa.h90 index c76484a..c0b4798 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis_saa.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis_saa.h90 @@ -1,4 +1,4 @@ -!!---------------------------------------------------------------------- + !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !! $Id: grt_cir_dis_saa.h90 10068 2018-08-28 14:09:04Z nicolasmartin $ !! Software governed by the CeCILL license (see ./LICENSE) diff --git a/V4.0/nemo_sources/src/OCE/OBS/jul2greg.h90 b/V4.0/nemo_sources/src/OCE/OBS/jul2greg.h90 index 56c5b8e..c81515d 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/jul2greg.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/jul2greg.h90 @@ -1,4 +1,4 @@ -RECURSIVE SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, & + RECURSIVE SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, & & prelday, krefdate ) !!----------------------------------------------------------------------- !! diff --git a/V4.0/nemo_sources/src/OCE/OBS/linquad.h90 b/V4.0/nemo_sources/src/OCE/OBS/linquad.h90 index b6d1e17..640c013 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/linquad.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/linquad.h90 @@ -1,4 +1,4 @@ -!!---------------------------------------------------------------------- + !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !! $Id: linquad.h90 10068 2018-08-28 14:09:04Z nicolasmartin $ !! Software governed by the CeCILL license (see ./LICENSE) diff --git a/V4.0/nemo_sources/src/OCE/OBS/maxdist.h90 b/V4.0/nemo_sources/src/OCE/OBS/maxdist.h90 index 48bfdbe..a30e3f1 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/maxdist.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/maxdist.h90 @@ -1,4 +1,4 @@ -!!---------------------------------------------------------------------- + !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !! $Id: maxdist.h90 10068 2018-08-28 14:09:04Z nicolasmartin $ !! Software governed by the CeCILL license (see ./LICENSE) diff --git a/V4.0/nemo_sources/src/OCE/OBS/obs_averg_h2d.F90 b/V4.0/nemo_sources/src/OCE/OBS/obs_averg_h2d.F90 index 6c95b31..d421d4b 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obs_averg_h2d.F90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obs_averg_h2d.F90 @@ -298,11 +298,11 @@ CONTAINS zarea_fp = 0.0_wp DO jis = 1, jnumsubgrid - zxpos = zxvert(4) + ( REAL(jis, dp) * zdx ) - (0.5_wp * zdx ) + zxpos = zxvert(4) + ( REAL(jis, dp) * zdx ) - (0.5_dp * zdx ) DO jjs = 1, jnumsubgrid !Find the distance of the centre of this sub grid box to the !centre of the obs footprint - zypos = zyvert(4) + ( REAL(jjs, dp) * zdy ) - ( 0.5_wp * zdy ) + zypos = zyvert(4) + ( REAL(jjs, dp) * zdy ) - ( 0.5_dp * zdy ) zsubdist = SQRT( (zxpos * zxpos) + (zypos * zypos) ) IF ( zsubdist < ( zphiscl_m / 2.0_wp ) ) & & zarea_fp = zarea_fp + zarea_subbox diff --git a/V4.0/nemo_sources/src/OCE/OBS/obs_conv_functions.h90 b/V4.0/nemo_sources/src/OCE/OBS/obs_conv_functions.h90 index 5215752..b3f7639 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obs_conv_functions.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obs_conv_functions.h90 @@ -1,4 +1,4 @@ -!!---------------------------------------------------------------------- + !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !! $Id: obs_conv_functions.h90 10068 2018-08-28 14:09:04Z nicolasmartin $ !! Software governed by the CeCILL license (see ./LICENSE) diff --git a/V4.0/nemo_sources/src/OCE/OBS/obs_grd_bruteforce.h90 b/V4.0/nemo_sources/src/OCE/OBS/obs_grd_bruteforce.h90 index e15bbbe..ec56519 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obs_grd_bruteforce.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obs_grd_bruteforce.h90 @@ -1,4 +1,4 @@ -SUBROUTINE obs_grd_bruteforce( kpi, kpj, kpiglo, kpjglo, & + SUBROUTINE obs_grd_bruteforce( kpi, kpj, kpiglo, kpjglo, & & kldi, klei, kldj, klej, & & kmyproc, ktotproc, & & pglam, pgphi, pmask, & diff --git a/V4.0/nemo_sources/src/OCE/OBS/obs_grid.F90 b/V4.0/nemo_sources/src/OCE/OBS/obs_grid.F90 index 91ccdcd..39a1b6c 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obs_grid.F90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obs_grid.F90 @@ -90,7 +90,6 @@ MODULE obs_grid !! Software governed by the CeCILL license (see ./LICENSE) !!---------------------------------------------------------------------- -# include "single_precision_substitute.h90" # include "single_precision_substitute.h90" CONTAINS diff --git a/V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 b/V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 index 1ef8461..03f2b48 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 @@ -37,10 +37,6 @@ MODULE obs_prep !! $Id: obs_prep.F90 10068 2018-08-28 14:09:04Z nicolasmartin $ !! Software governed by the CeCILL license (see ./LICENSE) !!---------------------------------------------------------------------- - - -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" # include "single_precision_substitute.h90" CONTAINS diff --git a/V4.0/nemo_sources/src/OCE/OBS/obs_rot_vel.F90 b/V4.0/nemo_sources/src/OCE/OBS/obs_rot_vel.F90 index c1312e3..2178d73 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obs_rot_vel.F90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obs_rot_vel.F90 @@ -33,9 +33,6 @@ MODULE obs_rot_vel !! Software governed by the CeCILL license (see ./LICENSE) !!---------------------------------------------------------------------- -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" # include "single_precision_substitute.h90" CONTAINS diff --git a/V4.0/nemo_sources/src/OCE/OBS/obsinter_h2d.h90 b/V4.0/nemo_sources/src/OCE/OBS/obsinter_h2d.h90 index 6f6408c..ad961c1 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obsinter_h2d.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obsinter_h2d.h90 @@ -1,4 +1,4 @@ -!!---------------------------------------------------------------------- + !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !! $Id: obsinter_h2d.h90 10353 2018-11-21 16:04:47Z mathiot $ !! Software governed by the CeCILL license (see ./LICENSE) diff --git a/V4.0/nemo_sources/src/OCE/OBS/obsinter_z1d.h90 b/V4.0/nemo_sources/src/OCE/OBS/obsinter_z1d.h90 index 009774f..a76ae00 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obsinter_z1d.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obsinter_z1d.h90 @@ -1,4 +1,4 @@ -!!---------------------------------------------------------------------- + !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !! $Id: obsinter_z1d.h90 10068 2018-08-28 14:09:04Z nicolasmartin $ !! Software governed by the CeCILL license (see ./LICENSE) diff --git a/V4.0/nemo_sources/src/OCE/SBC/sbc_phy.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbc_phy.F90 index 5a97bdf..fd6bff6 100644 --- a/V4.0/nemo_sources/src/OCE/SBC/sbc_phy.F90 +++ b/V4.0/nemo_sources/src/OCE/SBC/sbc_phy.F90 @@ -151,9 +151,6 @@ MODULE sbc_phy !! Software governed by the CeCILL license (see ./LICENSE) !!---------------------------------------------------------------------- # include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" CONTAINS FUNCTION virt_temp_sclr( pta, pqa ) !!------------------------------------------------------------------------ diff --git a/V4.0/nemo_sources/src/OCE/SBC/sbcdcy.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbcdcy.F90 index 62c4b43..9e1f797 100644 --- a/V4.0/nemo_sources/src/OCE/SBC/sbcdcy.F90 +++ b/V4.0/nemo_sources/src/OCE/SBC/sbcdcy.F90 @@ -83,7 +83,7 @@ CONTAINS zconvrad = ztwopi / 360._wp ! When are we during the day (from 0 to 1) - zlo = ( REAL(nsec_day, dp) - 0.5_wp * rdt ) / rday + zlo = ( REAL(nsec_day, dp) - 0.5_dp * rdt ) / rday zup = zlo + ( REAL(nn_fsbc, dp) * rdt ) / rday ! IF( nday_qsr == -1 ) THEN ! first time step only diff --git a/V4.0/nemo_sources/src/OCE/SBC/sbcfwb.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbcfwb.F90 index 39f9e3a..fa52bef 100644 --- a/V4.0/nemo_sources/src/OCE/SBC/sbcfwb.F90 +++ b/V4.0/nemo_sources/src/OCE/SBC/sbcfwb.F90 @@ -690,11 +690,11 @@ CONTAINS ztmsk_tospread(:,:) = tmask_i(:,:) ELSEIF ( aj_ssh == 2 ) THEN IF( zsum_flxm > 0._wp ) THEN ! spread out over emp < 0 area to reduce precipitation - zsurf_pos = glob_sum( 'sbcfwb', CASTDP(e1e2t(:,:)*ztmsk_pos(:,:)) ) + zsurf_pos = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_pos(:,:) ) zsurf_tospread = zsurf_pos ztmsk_tospread(:,:) = ztmsk_pos(:,:) ELSE ! spread out over emp > 0 area to reduce evaporation - zsurf_neg = glob_sum( 'sbcfwb', CASTDP(e1e2t(:,:)*ztmsk_neg(:,:)) ) ! Area filled by <0 and >0 erp + zsurf_neg = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp zsurf_tospread = zsurf_neg ztmsk_tospread(:,:) = ztmsk_neg(:,:) ENDIF @@ -705,7 +705,7 @@ CONTAINS WHERE( icbmsk == 1._wp ) ztmsk_tospread = 0._wp ! ! weight to respect emp field 2D structure - zsum_emp = glob_sum( 'sbcfwb', CASTDP(ztmsk_tospread(:,:) * ABS( emp(:,:) )* e1e2t(:,:) )) + zsum_emp = glob_sum( 'sbcfwb', ztmsk_tospread(:,:) * ABS( emp(:,:) )* e1e2t(:,:) ) z_wgt(:,:) = ztmsk_tospread(:,:) * ABS( emp(:,:) ) / ( zsum_emp + rsmall ) ! z_wgt should be seperated for mass and volume adjustments diff --git a/V4.0/nemo_sources/src/OCE/SBC/sbcisf.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbcisf.F90 index 3503033..1fe9dc1 100644 --- a/V4.0/nemo_sources/src/OCE/SBC/sbcisf.F90 +++ b/V4.0/nemo_sources/src/OCE/SBC/sbcisf.F90 @@ -74,10 +74,6 @@ MODULE sbcisf !! Software governed by the CeCILL license (see ./LICENSE) !!---------------------------------------------------------------------- # include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" -# include "single_precision_substitute.h90" CONTAINS SUBROUTINE sbc_isf( kt ) diff --git a/V4.0/nemo_sources/src/OCE/SBC/sbcrnf.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbcrnf.F90 index 4053ca4..045a174 100644 --- a/V4.0/nemo_sources/src/OCE/SBC/sbcrnf.F90 +++ b/V4.0/nemo_sources/src/OCE/SBC/sbcrnf.F90 @@ -136,7 +136,7 @@ CONTAINS IF( ln_rnf_icb ) THEN fwficb(:,:) = rn_rfact * ( sf_i_rnf(1)%fnow(:,:,1)) * tmask(:,:,1) ! updated runoff value at time step kt CALL iom_put( 'iceberg_cea' , fwficb(:,:) ) ! output iceberg flux - CALL iom_put( 'hflx_icb_cea' , CASTDP(fwficb(:,:)) * rLfus ) ! output Heat Flux into Sea Water due to Iceberg Thermodynamics --> + CALL iom_put( 'hflx_icb_cea' , fwficb(:,:) * rLfus ) ! output Heat Flux into Sea Water due to Iceberg Thermodynamics --> ENDIF ENDIF ! diff --git a/V4.0/nemo_sources/src/OCE/SBC/sbcsglcpl.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbcsglcpl.F90 index 4d620f7..1c9469f 100644 --- a/V4.0/nemo_sources/src/OCE/SBC/sbcsglcpl.F90 +++ b/V4.0/nemo_sources/src/OCE/SBC/sbcsglcpl.F90 @@ -315,6 +315,7 @@ CONTAINS IF (.NOT.lallociceflx) THEN call ctl_stop('sbc_sglcpl_ice_flx_get called before sbc_sglcpl_ice_flx_put') ENDIF + ! compute ice lead (open water) fraction @@ -575,10 +576,10 @@ CONTAINS ! ! ================== ! ! ! ice skin temp. ! Sarah Nothing done as yet. ! ! ================== ! -#endif + lfluxupdated=.FALSE. ENDIF - +#endif IF( ln_timing ) CALL timing_stop('sbc_sglcpl_ice_flx') IF(lhook) CALL dr_hook('sbc_sglcpl_ice_flx',1,zhook_handle) diff --git a/V4.0/nemo_sources/src/OCE/STO/stopar.F90 b/V4.0/nemo_sources/src/OCE/STO/stopar.F90 index 5c4a4a2..37201b4 100644 --- a/V4.0/nemo_sources/src/OCE/STO/stopar.F90 +++ b/V4.0/nemo_sources/src/OCE/STO/stopar.F90 @@ -598,7 +598,7 @@ CONTAINS ELSE ! Approximate formula, valid for tcor >> 1 jordm1 = sto2d_ord(jsto) - 1 - rinflate = SQRT ( REAL( jordm1 , dp ) / REAL( 2*(2*jordm1-1) , wp ) ) + rinflate = SQRT ( REAL( jordm1 , dp ) / REAL( 2*(2*jordm1-1) , dp ) ) ENDIF sto2d_abc(jsto,2) = rinflate * SQRT ( 1._wp - sto2d_abc(jsto,1) & * sto2d_abc(jsto,1) ) @@ -616,7 +616,7 @@ CONTAINS ELSE ! Approximate formula, valid for tcor >> 1 jordm1 = sto3d_ord(jsto) - 1 - rinflate = SQRT ( REAL( jordm1 , dp ) / REAL( 2*(2*jordm1-1) , wp ) ) + rinflate = SQRT ( REAL( jordm1 , dp ) / REAL( 2*(2*jordm1-1) , dp ) ) ENDIF sto3d_abc(jsto,2) = rinflate * SQRT ( 1._wp - sto3d_abc(jsto,1) & * sto3d_abc(jsto,1) ) diff --git a/V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 b/V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 index f45aa25..87eb556 100644 --- a/V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 +++ b/V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 @@ -95,7 +95,7 @@ CONTAINS REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu, zltv REAL(dp), DIMENSION(jpi,jpj,jpk) :: zwi, zwx, zwy, zwz, ztw REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdx, ztrdy, ztrdz - REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: zptry + REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zptry REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zwinf, zwdia, zwsup LOGICAL :: ll_zAimp ! flag to apply adaptive implicit vertical advection !!---------------------------------------------------------------------- @@ -479,7 +479,7 @@ CONTAINS !$omp barrier !$omp master zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< add anti-diffusive fluxes - CALL dia_ptr_hst( jn, 'adv', CASTSP(zptry(:,:,:)) ) + CALL dia_ptr_hst( jn, 'adv',zptry(:,:,:) ) !$omp end master !$omp barrier ENDIF diff --git a/V4.0/nemo_sources/src/OCE/TRA/tranpc.F90 b/V4.0/nemo_sources/src/OCE/TRA/tranpc.F90 index 677a053..40d08aa 100644 --- a/V4.0/nemo_sources/src/OCE/TRA/tranpc.F90 +++ b/V4.0/nemo_sources/src/OCE/TRA/tranpc.F90 @@ -65,7 +65,7 @@ CONTAINS LOGICAL :: l_bottom_reached, l_column_treated REAL(wp) :: zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z REAL(wp) :: zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt - REAL(dp), PARAMETER :: zn2_zero = 1.e-14_dp ! acceptance criteria for neutrality (N2==0) + REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp ! acceptance criteria for neutrality (N2==0) REAL(wp), DIMENSION( jpk ) :: zvn2 ! vertical profile of N2 at 1 given point... REAL(wp), DIMENSION( jpk,jpts) :: zvts, zvab ! vertical profile of T & S , and alpha & betaat 1 given point REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zn2 ! N^2 diff --git a/V4.0/nemo_sources/src/OCE/TRD/trdvor.F90 b/V4.0/nemo_sources/src/OCE/TRD/trdvor.F90 index f1fd337..b897d52 100644 --- a/V4.0/nemo_sources/src/OCE/TRD/trdvor.F90 +++ b/V4.0/nemo_sources/src/OCE/TRD/trdvor.F90 @@ -384,7 +384,7 @@ CONTAINS ! III.1 compute total trend ! ------------------------ - zmean = 1._wp / ( REAL( nmoydpvor, dp ) * 2._wp * rdt ) + zmean = 1._wp / ( REAL( nmoydpvor, dp ) * 2._dp * rdt ) vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean diff --git a/V4.0/nemo_sources/src/OCE/ZDF/zdfddm.F90 b/V4.0/nemo_sources/src/OCE/ZDF/zdfddm.F90 index 68bfa11..25c3838 100644 --- a/V4.0/nemo_sources/src/OCE/ZDF/zdfddm.F90 +++ b/V4.0/nemo_sources/src/OCE/ZDF/zdfddm.F90 @@ -82,7 +82,7 @@ CONTAINS REAL(wp) :: zinr ! - - REAL(dp) :: zrr ! - - REAL(wp) :: zavft ! - - - REAL(dp) :: zavfs ! - - + REAL(wp) :: zavfs ! - - REAL(wp) :: zavdt, zavds ! - - REAL(wp), DIMENSION(jpi,jpj) :: zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 !!---------------------------------------------------------------------- diff --git a/V4.0/nemo_sources/src/OCE/stpctl.F90 b/V4.0/nemo_sources/src/OCE/stpctl.F90 index bacb918..92be418 100644 --- a/V4.0/nemo_sources/src/OCE/stpctl.F90 +++ b/V4.0/nemo_sources/src/OCE/stpctl.F90 @@ -183,7 +183,7 @@ CONTAINS ! first: close the netcdf file, so we can read it IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(idrun) CALL mpp_maxloc( 'stpctl', ABS(sshn) , CASTDP(ssmask(:,:)) , zzz, ih(1:2) ) ; ih(3) = 0 - CALL mpp_maxloc( 'stpctl', CASTDP(ABS(un)) , CASTDP(umask (:,:,:)), zzz, iu ) + CALL mpp_maxloc( 'stpctl', CASTDP(ABS(un)) , CASTDP(umask (:,:,:)), zzz, iu ) CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), CASTDP(tmask (:,:,:)), zzz, is1 ) CALL mpp_maxloc( 'stpctl', tsn(:,:,:,jp_sal), CASTDP(tmask (:,:,:)), zzz, is2 ) ! find which subdomain has the max. -- GitLab From fae3a353b3592b0a21a1c3bccde70cc4f0cb0800 Mon Sep 17 00:00:00 2001 From: sparonuz Date: Wed, 25 Oct 2023 14:20:49 +0200 Subject: [PATCH 2/5] Removed .mod files --- V4.0/nemo_sources/src/ICE/ice.mod | Bin 162 -> 0 bytes V4.0/nemo_sources/src/ICE/icecor.mod | Bin 165 -> 0 bytes V4.0/nemo_sources/src/ICE/icectl.mod | Bin 165 -> 0 bytes V4.0/nemo_sources/src/ICE/icedia.mod | Bin 165 -> 0 bytes V4.0/nemo_sources/src/ICE/icedyn.mod | Bin 165 -> 0 bytes V4.0/nemo_sources/src/ICE/icedyn_adv.mod | Bin 170 -> 0 bytes V4.0/nemo_sources/src/ICE/icedyn_adv_pra.mod | Bin 173 -> 0 bytes V4.0/nemo_sources/src/ICE/icedyn_adv_umx.mod | Bin 173 -> 0 bytes V4.0/nemo_sources/src/ICE/icedyn_rdgrft.mod | Bin 172 -> 0 bytes V4.0/nemo_sources/src/ICE/icedyn_rhg.mod | Bin 170 -> 0 bytes V4.0/nemo_sources/src/ICE/icedyn_rhg_evp.mod | Bin 173 -> 0 bytes V4.0/nemo_sources/src/ICE/iceistate.mod | Bin 168 -> 0 bytes V4.0/nemo_sources/src/ICE/iceitd.mod | Bin 165 -> 0 bytes V4.0/nemo_sources/src/ICE/icerst.mod | Bin 164 -> 0 bytes V4.0/nemo_sources/src/ICE/icesbc.mod | Bin 165 -> 0 bytes V4.0/nemo_sources/src/ICE/icestp.mod | Bin 308 -> 0 bytes V4.0/nemo_sources/src/ICE/icethd.mod | Bin 165 -> 0 bytes V4.0/nemo_sources/src/ICE/icethd_da.mod | Bin 169 -> 0 bytes V4.0/nemo_sources/src/ICE/icethd_dh.mod | Bin 169 -> 0 bytes V4.0/nemo_sources/src/ICE/icethd_do.mod | Bin 169 -> 0 bytes V4.0/nemo_sources/src/ICE/icethd_pnd.mod | Bin 170 -> 0 bytes V4.0/nemo_sources/src/ICE/icethd_sal.mod | Bin 170 -> 0 bytes V4.0/nemo_sources/src/ICE/icethd_zdf.mod | Bin 170 -> 0 bytes V4.0/nemo_sources/src/ICE/icethd_zdf_bl99.mod | Bin 174 -> 0 bytes V4.0/nemo_sources/src/ICE/iceupdate.mod | Bin 168 -> 0 bytes V4.0/nemo_sources/src/ICE/icevar.mod | Bin 165 -> 0 bytes V4.0/nemo_sources/src/ICE/icewri.mod | Bin 165 -> 0 bytes 27 files changed, 0 insertions(+), 0 deletions(-) delete mode 100644 V4.0/nemo_sources/src/ICE/ice.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icecor.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icectl.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icedia.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icedyn.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icedyn_adv.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icedyn_adv_pra.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icedyn_adv_umx.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icedyn_rdgrft.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icedyn_rhg.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icedyn_rhg_evp.mod delete mode 100644 V4.0/nemo_sources/src/ICE/iceistate.mod delete mode 100644 V4.0/nemo_sources/src/ICE/iceitd.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icerst.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icesbc.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icestp.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icethd.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icethd_da.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icethd_dh.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icethd_do.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icethd_pnd.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icethd_sal.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icethd_zdf.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icethd_zdf_bl99.mod delete mode 100644 V4.0/nemo_sources/src/ICE/iceupdate.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icevar.mod delete mode 100644 V4.0/nemo_sources/src/ICE/icewri.mod diff --git a/V4.0/nemo_sources/src/ICE/ice.mod b/V4.0/nemo_sources/src/ICE/ice.mod deleted file mode 100644 index 6c96b8a023144ceec34d83686bac0090e1a2cc99..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 162 zcmV;T0A2qdiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=++#Naa9QQ z^Y-%(_tW+C3vu-efpY_b{GDMO7|ms%U;wcRCSd@DFh0-;U_Qh_1_(!jbaH{50&#+Y Qf{`W{0QbCDsxbio0NkoW6aWAK diff --git a/V4.0/nemo_sources/src/ICE/icecor.mod b/V4.0/nemo_sources/src/ICE/icecor.mod deleted file mode 100644 index 5168235bf658306f7f60b7f7a9302fca70d72193..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 165 zcmV;W09yYaiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+R+s{ATPuJ5g#MLhZ&J76icZPAeptOR4f&s)nBmppl@qrEj^C8YMKsXholMCb^ TxGM}4j5N6bwvDDFJplj!ar{H- diff --git a/V4.0/nemo_sources/src/ICE/icectl.mod b/V4.0/nemo_sources/src/ICE/icectl.mod deleted file mode 100644 index bc6349fae400df487199e0c0db1bba7fe8495574..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 165 zcmV;W09yYaiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+R+s{ATPuJ5g#MLhZ&J76icZPAeptOR4f&s)nBmppl@qrEj^C8YMKsXholMCb^ TxGM}4j5N6b_VU4?Jplj!b~;5L diff --git a/V4.0/nemo_sources/src/ICE/icedia.mod b/V4.0/nemo_sources/src/ICE/icedia.mod deleted file mode 100644 index 327bb294fd42e1422e5b577b3c4e07b2779266f8..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 165 zcmV;W09yYaiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+R+s{ATPuJ5g#MLhZ&J76icZPAeptOR4f&s)nBmppl@qrEj^C8YMKsXholMCb^ TxGM}4j5N6b(+oQ7Jplj!d#*$L diff --git a/V4.0/nemo_sources/src/ICE/icedyn.mod b/V4.0/nemo_sources/src/ICE/icedyn.mod deleted file mode 100644 index cb11a3e82b74ee1d312d84057c0594802d2b80fd..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 165 zcmV;W09yYaiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+R+s{ATPuJ5g#MLhZ&J76icZPAeptOR4f&s)nBmppl@qrEj^C8YMKsXholMCb^ TxGM}4j5N6b0ssW%Jplj!n_xph diff --git a/V4.0/nemo_sources/src/ICE/icedyn_adv.mod b/V4.0/nemo_sources/src/ICE/icedyn_adv.mod deleted file mode 100644 index f52443bcfba17959d7243920ddca2d6aec5d01f8..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 170 zcmV;b09F4ViwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+R+s{ATPuJ5g#MLhZ&J76icjkg}V1fz;3I-5+kp#dH#s@kG%!fG70O4Mc YPA-tcP+Vf5V5G?f0AI$#C`|zX0HMc4;{X5v diff --git a/V4.0/nemo_sources/src/ICE/icedyn_adv_pra.mod b/V4.0/nemo_sources/src/ICE/icedyn_adv_pra.mod deleted file mode 100644 index e198d8eb09060e15dc1f2e080eb2bd3a8d5fcf07..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 173 zcmV;e08;-SiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+$_9f-FNy diff --git a/V4.0/nemo_sources/src/ICE/icedyn_adv_umx.mod b/V4.0/nemo_sources/src/ICE/icedyn_adv_umx.mod deleted file mode 100644 index 610878b4ed31cbaa7df04057bf2df6a1a4eda279..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 173 zcmV;e08;-SiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+$_9@}Wex diff --git a/V4.0/nemo_sources/src/ICE/icedyn_rdgrft.mod b/V4.0/nemo_sources/src/ICE/icedyn_rdgrft.mod deleted file mode 100644 index e2f6bcd1e0a2e88e5630852ab7fd75cda441434b..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 172 zcmV;d08{@TiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+D$dN$Q&2ZFRaZzZN=+R+s{ATPuJ5g#MLhZ&J76icjkg}V1fz;3I-5+kp#dH#s@kG%!fG70O4Mc YPA-tcP+Vf5V5G?f0ATkS2TcJ00M)ET%K!iX diff --git a/V4.0/nemo_sources/src/ICE/icedyn_rhg_evp.mod b/V4.0/nemo_sources/src/ICE/icedyn_rhg_evp.mod deleted file mode 100644 index fa8d57a22910c98096acff871566648b0b3e5070..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 173 zcmV;e08;-SiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+$_9v|2*k diff --git a/V4.0/nemo_sources/src/ICE/iceistate.mod b/V4.0/nemo_sources/src/ICE/iceistate.mod deleted file mode 100644 index 47c2a43eb462869bdea920066f68b269d643464a..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 168 zcmV;Z09XGXiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+0*Bj>=Y7FjUac@bz~I z^>I}Q_4D@g5BJmc^b2wI3xRV3g8ZGipd6T>f`Nho#8xB$Fof}e&H?iwjx#{G7NnC4 WD$dN$Q&2ZFRaZzZN=+R+s{ATPuJ5g#MLhZ&J76icZPAeptOR4f&s)nBmppl@qrEj^C8YMKsXholMCb^ TxGM}4j5N6b*m6#YJplj!ZpK6O diff --git a/V4.0/nemo_sources/src/ICE/icerst.mod b/V4.0/nemo_sources/src/ICE/icerst.mod deleted file mode 100644 index 4c2908b4d6d1eb5ec221a67514efce1367d7960b..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 164 zcmV;V09*ebiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+**Kb>K6j%1_b##!#G?}TERfU0Ae4K02spfK!D$dN$Q&2ZFRaZzZN=+R+s{ATPuJ5g#MLhZ&J76icZPAeptOR4f&s)nBmppl@qrEj^C8YMKsXholMCb^ TxGM}4j5N6bIO>C*VPWn zylC3DtJO6lj^n~5CK&>kV0h-60L8MKa$mNz3sHapg)ulzs*-?*T5-_wMke=iBxJ^A z25}PVh>y%Vggl7IVI3HbTfJ0?&V=M3;xrP0$Tle+(o5`}W(+wJff06)v*RUjlS`&O zv&UUn`MYaoJRZ!yXvCr|EYOLp2b{8ov~wL2oA!ryg74nR1Nzc-^>NOSaOW%GFA*W+ z*}`Dg33VJl^lf9TYp%Mhn=#}+m!D(#<|+R_fN5!~p&3l9#$hl${vrkomwW;pX%2my G0{{S0N|M(A diff --git a/V4.0/nemo_sources/src/ICE/icethd.mod b/V4.0/nemo_sources/src/ICE/icethd.mod deleted file mode 100644 index 5f45f3f4ff98661a7b873ac4d929bf1b0e686173..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 165 zcmV;W09yYaiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+R+s{ATPuJ5g#MLhZ&J76icZPAeptOR4f&s)nBmppl@qrEj^C8YMKsXholMCb^ TxGM}4j5N6bDeo64Jplj!XF)?K diff --git a/V4.0/nemo_sources/src/ICE/icethd_da.mod b/V4.0/nemo_sources/src/ICE/icethd_da.mod deleted file mode 100644 index cceaa7ba19992e76a67e02aa2e72617ea4a4f805..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 169 zcmV;a09OAWiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+D$dN$Q&2ZFRaZzZN=+D$dN$Q&2ZFRaZzZN=+D$dN$Q&2ZFRaZzZN=+R+s{ATPuJ5g#MLhZ&J76icjkg}V1fz;3I-5+kp#dH#s@kG%!fG70O4Mc YPA-tcP+Vf5V5G?f0Nrejkxc;r0G-fAFaQ7m diff --git a/V4.0/nemo_sources/src/ICE/icethd_sal.mod b/V4.0/nemo_sources/src/ICE/icethd_sal.mod deleted file mode 100644 index 403598d62ba14689c9e395e7f389df4a2f72bc96..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 170 zcmV;b09F4ViwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+R+s{ATPuJ5g#MLhZ&J76icjkg}V1fz;3I-5+kp#dH#s@kG%!fG70O4Mc YPA-tcP+Vf5V5G?f0QBC(0!;w`0HUTwXaE2J diff --git a/V4.0/nemo_sources/src/ICE/icethd_zdf.mod b/V4.0/nemo_sources/src/ICE/icethd_zdf.mod deleted file mode 100644 index 90664b2a983e465d9a65a1f8056fe9135e9967c1..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 170 zcmV;b09F4ViwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+R+s{ATPuJ5g#MLhZ&J76icjkg}V1fz;3I-5+kp#dH#s@kG%!fG70O4Mc YPA-tcP+Vf5V5G?f0OG`k<4pko0HZ2K+5i9m diff --git a/V4.0/nemo_sources/src/ICE/icethd_zdf_bl99.mod b/V4.0/nemo_sources/src/ICE/icethd_zdf_bl99.mod deleted file mode 100644 index b0c92ca258d571751858ac150bfb4d862cf3307b..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 174 zcmV;f08#%RiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+TIofFuBhFh0;}U_QjH c1_;N4baH{5i0K>y1tU!^0MBW#Enxuw0EW0l9RL6T diff --git a/V4.0/nemo_sources/src/ICE/iceupdate.mod b/V4.0/nemo_sources/src/ICE/iceupdate.mod deleted file mode 100644 index af3d34791fa0a8c7a6f36acd072a115250a8bb8e..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 168 zcmV;Z09XGXiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+0*Bj>=Y7FjUac@bz~I z^>I}Q_4D@g5BJmc^b2wI3xRV3g8ZGipd6T>f`Nho#8xB$Fof}e&H?iwjx#{G7NnC4 WD$dN$Q&2ZFRaZzZN=+R+s{ATPuJ5g#MLhZ&J76icZPAeptOR4f&s)nBmppl@qrEj^C8YMKsXholMCb^ TxGM}4j5N6bWP8*-Jplj!DYQc; diff --git a/V4.0/nemo_sources/src/ICE/icewri.mod b/V4.0/nemo_sources/src/ICE/icewri.mod deleted file mode 100644 index f85c67780c4128091dc7048345f53d833ae435bc..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 165 zcmV;W09yYaiwFP!0000019Nxt4+;r#^i#;qPbtkwRVYg>D$dN$Q&2ZFRaZzZN=+R+s{ATPuJ5g#MLhZ&J76icZPAeptOR4f&s)nBmppl@qrEj^C8YMKsXholMCb^ TxGM}4j5N6b-^Kf*Jplj!Y79jE -- GitLab From d1589ed8bd2aa8be20fdd90f6e8f169cc94193f9 Mon Sep 17 00:00:00 2001 From: omichel Date: Fri, 27 Oct 2023 15:58:20 +0200 Subject: [PATCH 3/5] Fix indentations and comments --- V4.0/nemo_sources/src/ICE/icectl.F90 | 2 +- V4.0/nemo_sources/src/ICE/icedia.F90 | 4 +- V4.0/nemo_sources/src/ICE/icedyn_adv_pra.F90 | 12 +- V4.0/nemo_sources/src/ICE/icedyn_rhg.F90 | 2 +- .../src/OCE/LBC/mpp_loc_generic.h90 | 2 +- V4.0/nemo_sources/src/OCE/LBC/mppini.F90 | 4 +- .../src/OCE/OBS/ddatetoymdhms.h90 | 4 +- .../src/OCE/OBS/find_obs_proc.h90 | 2 +- V4.0/nemo_sources/src/OCE/OBS/greg2jul.h90 | 2 +- V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis.h90 | 2 +- .../src/OCE/OBS/grt_cir_dis_saa.h90 | 2 +- V4.0/nemo_sources/src/OCE/OBS/jul2greg.h90 | 2 +- V4.0/nemo_sources/src/OCE/OBS/linquad.h90 | 2 +- V4.0/nemo_sources/src/OCE/OBS/maxdist.h90 | 2 +- .../src/OCE/OBS/obs_averg_h2d.F90 | 2 +- .../src/OCE/OBS/obs_grd_bruteforce.h90 | 2 +- V4.0/nemo_sources/src/OCE/OBS/obs_grid.F90 | 2 +- .../src/OCE/OBS/obs_level_search.h90 | 4 +- V4.0/nemo_sources/src/OCE/OBS/obs_mpp.F90 | 2 +- V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 | 30 +- .../nemo_sources/src/OCE/OBS/str_c_to_for.h90 | 4 +- V4.0/nemo_sources/src/OCE/SBC/sbc_oce.F90 | 6 +- .../src/OCE/SBC/sbcblk_algo_coare.F90 | 8 +- .../src/OCE/SBC/sbcblk_algo_coare3p5.F90 | 9 +- V4.0/nemo_sources/src/OCE/SBC/sbccpl.F90 | 4 +- V4.0/nemo_sources/src/OCE/SBC/tide.h90 | 4 +- V4.0/nemo_sources/src/OCE/TRA/eosbn2.F90 | 20 +- V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 | 27 +- V4.0/nemo_sources/src/OCE/TRA/traadv_ubs.F90 | 10 +- V4.0/nemo_sources/src/OCE/TRA/trabbl.F90 | 6 +- V4.0/nemo_sources/src/OCE/TRA/traldf_iso.F90 | 6 +- .../src/OCE/TRA/traldf_lap_blp.F90 | 16 +- .../nemo_sources/src/OCE/TRA/traldf_triad.F90 | 6 +- V4.0/nemo_sources/src/OCE/TRA/tranxt.F90 | 14 +- V4.0/nemo_sources/src/OCE/TRA/trazdf.F90 | 6 +- V4.0/nemo_sources/src/OCE/TRA/zpshde.F90 | 16 +- V4.0/nemo_sources/src/OCE/TRD/trdtra.F90 | 6 +- V4.0/nemo_sources/src/OCE/TRD/trdtrc.F90 | 2 +- V4.0/nemo_sources/src/OCE/USR/usrdef_hgr.F90 | 18 +- V4.0/nemo_sources/src/OCE/USR/usrdef_zgr.F90 | 22 +- V4.0/nemo_sources/src/OCE/ZDF/zdfgls.F90 | 4 +- V4.0/nemo_sources/src/OCE/ZDF/zdfric.F90 | 6 +- V4.0/nemo_sources/src/OCE/ZDF/zdfswm.F90 | 6 +- V4.0/nemo_sources/src/OCE/ZDF/zdftke.F90 | 38 +- V4.0/nemo_sources/src/OCE/oce.F90 | 28 +- .../src/OCE/vectopt_loop_substitute.h90 | 4 +- .../src/TOP/PISCES/P4Z/p4zche.F90 | 2 +- .../src/TOP/PISCES/SED/sedchem.F90 | 2 +- V4.0/nemo_sources/src/zpshde.F90 | 1040 ----------------- 49 files changed, 188 insertions(+), 1238 deletions(-) delete mode 100644 V4.0/nemo_sources/src/zpshde.F90 diff --git a/V4.0/nemo_sources/src/ICE/icectl.F90 b/V4.0/nemo_sources/src/ICE/icectl.F90 index c13535c..1ce45aa 100644 --- a/V4.0/nemo_sources/src/ICE/icectl.F90 +++ b/V4.0/nemo_sources/src/ICE/icectl.F90 @@ -913,4 +913,4 @@ CONTAINS #endif !!====================================================================== -END MODULE icectl \ No newline at end of file +END MODULE icectl diff --git a/V4.0/nemo_sources/src/ICE/icedia.F90 b/V4.0/nemo_sources/src/ICE/icedia.F90 index d24b685..a2a542e 100644 --- a/V4.0/nemo_sources/src/ICE/icedia.F90 +++ b/V4.0/nemo_sources/src/ICE/icedia.F90 @@ -82,7 +82,7 @@ CONTAINS ENDIF IF( kt == nit000 ) THEN - z1_e1e2 = 1._wp / glob_sum( 'icedia', e1e2t(:,:)) + z1_e1e2 = 1._wp / glob_sum( 'icedia', e1e2t(:,:) ) ENDIF ! ----------------------- ! @@ -285,4 +285,4 @@ CONTAINS #endif !!====================================================================== -END MODULE icedia \ No newline at end of file +END MODULE icedia diff --git a/V4.0/nemo_sources/src/ICE/icedyn_adv_pra.F90 b/V4.0/nemo_sources/src/ICE/icedyn_adv_pra.F90 index 61ac086..f55a8f2 100644 --- a/V4.0/nemo_sources/src/ICE/icedyn_adv_pra.F90 +++ b/V4.0/nemo_sources/src/ICE/icedyn_adv_pra.F90 @@ -97,7 +97,7 @@ CONTAINS REAL(wp), DIMENSION(1) :: zcflprv, zcflnow ! for global communication REAL(wp), DIMENSION(jpi,jpj) :: zati1, zati2 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx - REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zhip_max, zs_i, zsi_max + REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zs_i, zhip_max, zsi_max REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: ze_i, zei_max REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) :: ze_s, zes_max REAL(wp), DIMENSION(jpi,jpj,jpl) :: zarea @@ -135,7 +135,7 @@ CONTAINS WHERE( pv_s(:,:,:) >= epsi10 ) ; ze_s(:,:,jk,:) = pe_s(:,:,jk,:) / pv_s(:,:,:) ELSEWHERE ; ze_s(:,:,jk,:) = 0._wp END WHERE - END DO + END DO CALL icemax4D( ze_i , zei_max ) CALL icemax4D( ze_s , zes_max ) CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1.0_wp ) @@ -147,7 +147,6 @@ CONTAINS ! this should not affect too much the stability zcflnow(1) = MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) zcflnow(1) = MAX( zcflnow(1), MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) - ! non-blocking global communication send zcflnow and receive zcflprv CALL mpp_delay_max( 'icedyn_adv_pra', 'cflice', zcflnow(:), zcflprv(:), kt == nitend - nn_fsbc + 1 ) @@ -181,7 +180,7 @@ CONTAINS END DO !$omp end do - ! --- transported fields --- ! + ! --- transported fields --- ! DO jl = 1, jpl !$omp do DO jj = 1, jpj @@ -208,9 +207,7 @@ CONTAINS END DO !$omp end do END DO - !$omp end parallel - ! ! !--------------------------------------------! IF( MOD( (kt - 1) / nn_fsbc , 2 ) == MOD( (jt - 1) , 2 ) ) THEN !== odd ice time step: adv_x then adv_y ==! @@ -286,7 +283,6 @@ CONTAINS ENDIF ! ENDIF - ! --- Lateral boundary conditions --- ! ! caution: for gradients (sx and sy) the sign changes CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ice , 'T', 1._wp, sxice , 'T', -1._wp, syice , 'T', -1._wp & ! ice volume @@ -1384,4 +1380,4 @@ CONTAINS #endif !!====================================================================== -END MODULE icedyn_adv_pra \ No newline at end of file +END MODULE icedyn_adv_pra diff --git a/V4.0/nemo_sources/src/ICE/icedyn_rhg.F90 b/V4.0/nemo_sources/src/ICE/icedyn_rhg.F90 index 6f2141d..4864df4 100644 --- a/V4.0/nemo_sources/src/ICE/icedyn_rhg.F90 +++ b/V4.0/nemo_sources/src/ICE/icedyn_rhg.F90 @@ -155,4 +155,4 @@ CONTAINS #endif !!====================================================================== -END MODULE icedyn_rhg \ No newline at end of file +END MODULE icedyn_rhg diff --git a/V4.0/nemo_sources/src/OCE/LBC/mpp_loc_generic.h90 b/V4.0/nemo_sources/src/OCE/LBC/mpp_loc_generic.h90 index 4e5f7fa..40e64e0 100644 --- a/V4.0/nemo_sources/src/OCE/LBC/mpp_loc_generic.h90 +++ b/V4.0/nemo_sources/src/OCE/LBC/mpp_loc_generic.h90 @@ -1,4 +1,4 @@ -!== IN: ptab is an array ==! + !== IN: ptab is an array ==! # if defined SINGLE_PRECISION # define ARRAY_TYPE(i,j,k) REAL(sp) , INTENT(in ) :: ARRAY_IN(i,j,k) # define MASK_TYPE(i,j,k) REAL(sp) , INTENT(in ) :: MASK_IN(i,j,k) diff --git a/V4.0/nemo_sources/src/OCE/LBC/mppini.F90 b/V4.0/nemo_sources/src/OCE/LBC/mppini.F90 index bbcd705..c55761a 100644 --- a/V4.0/nemo_sources/src/OCE/LBC/mppini.F90 +++ b/V4.0/nemo_sources/src/OCE/LBC/mppini.F90 @@ -1,4 +1,4 @@ -MODULE mppini + MODULE mppini !!====================================================================== !! *** MODULE mppini *** !! Ocean initialization : distributed memory computing initialization @@ -1316,4 +1316,4 @@ CONTAINS #endif !!====================================================================== -END MODULE mppini \ No newline at end of file +END MODULE mppini diff --git a/V4.0/nemo_sources/src/OCE/OBS/ddatetoymdhms.h90 b/V4.0/nemo_sources/src/OCE/OBS/ddatetoymdhms.h90 index 77de081..cf16f5a 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/ddatetoymdhms.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/ddatetoymdhms.h90 @@ -1,4 +1,4 @@ -!!---------------------------------------------------------------------- + !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !! $Id: ddatetoymdhms.h90 10068 2018-08-28 14:09:04Z nicolasmartin $ !! Software governed by the CeCILL license (see ./LICENSE) @@ -40,4 +40,4 @@ kmin = ihhmmss / 100 - 100 * khou ksec = MOD( ihhmmss, 100 ) - END SUBROUTINE ddatetoymdhms \ No newline at end of file + END SUBROUTINE ddatetoymdhms diff --git a/V4.0/nemo_sources/src/OCE/OBS/find_obs_proc.h90 b/V4.0/nemo_sources/src/OCE/OBS/find_obs_proc.h90 index 5ae08dd..e9a7c21 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/find_obs_proc.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/find_obs_proc.h90 @@ -57,4 +57,4 @@ WHERE(kobsp(:) /= kmyproc) kobsp(:)=1000000 - END SUBROUTINE find_obs_proc \ No newline at end of file + END SUBROUTINE find_obs_proc diff --git a/V4.0/nemo_sources/src/OCE/OBS/greg2jul.h90 b/V4.0/nemo_sources/src/OCE/OBS/greg2jul.h90 index 7a23296..dd6fa7c 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/greg2jul.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/greg2jul.h90 @@ -90,4 +90,4 @@ END IF pjulian = ( ijultmp - iref ) + ( ( 60 * khour + kmin ) * 60 + ksec ) / 86400.0_dp - END SUBROUTINE greg2jul \ No newline at end of file + END SUBROUTINE greg2jul diff --git a/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis.h90 b/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis.h90 index 5962383..a7221a0 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis.h90 @@ -36,4 +36,4 @@ grt_cir_dis = & & ASIN( SQRT( 1.0_wp - cosdist**2.0_wp ) ) - END FUNCTION grt_cir_dis \ No newline at end of file + END FUNCTION grt_cir_dis diff --git a/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis_saa.h90 b/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis_saa.h90 index c0b4798..7e0906b 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis_saa.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/grt_cir_dis_saa.h90 @@ -28,4 +28,4 @@ grt_cir_dis_saa = SQRT( pa * pa + ( pb * pc )**2 ) - END FUNCTION grt_cir_dis_saa \ No newline at end of file + END FUNCTION grt_cir_dis_saa diff --git a/V4.0/nemo_sources/src/OCE/OBS/jul2greg.h90 b/V4.0/nemo_sources/src/OCE/OBS/jul2greg.h90 index c81515d..79a299c 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/jul2greg.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/jul2greg.h90 @@ -118,4 +118,4 @@ IF ( kmonth > 2 ) kyear = kyear - 1 IF ( kyear <= 0 ) kyear = kyear - 1 - END SUBROUTINE jul2greg \ No newline at end of file + END SUBROUTINE jul2greg diff --git a/V4.0/nemo_sources/src/OCE/OBS/linquad.h90 b/V4.0/nemo_sources/src/OCE/OBS/linquad.h90 index 640c013..343e3e8 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/linquad.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/linquad.h90 @@ -55,4 +55,4 @@ ENDIF ENDIF - END FUNCTION linquad \ No newline at end of file + END FUNCTION linquad diff --git a/V4.0/nemo_sources/src/OCE/OBS/maxdist.h90 b/V4.0/nemo_sources/src/OCE/OBS/maxdist.h90 index a30e3f1..a7417d5 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/maxdist.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/maxdist.h90 @@ -73,4 +73,4 @@ !----------------------------------------------------------------------- maxdist = maxdist / rad - END FUNCTION maxdist \ No newline at end of file + END FUNCTION maxdist diff --git a/V4.0/nemo_sources/src/OCE/OBS/obs_averg_h2d.F90 b/V4.0/nemo_sources/src/OCE/OBS/obs_averg_h2d.F90 index d421d4b..fa333d6 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obs_averg_h2d.F90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obs_averg_h2d.F90 @@ -821,4 +821,4 @@ CONTAINS END SUBROUTINE obs_dist2corners -END MODULE obs_averg_h2d \ No newline at end of file +END MODULE obs_averg_h2d diff --git a/V4.0/nemo_sources/src/OCE/OBS/obs_grd_bruteforce.h90 b/V4.0/nemo_sources/src/OCE/OBS/obs_grd_bruteforce.h90 index ec56519..5a41fa3 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obs_grd_bruteforce.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obs_grd_bruteforce.h90 @@ -346,4 +346,4 @@ & zpphi & & ) - END SUBROUTINE obs_grd_bruteforce \ No newline at end of file + END SUBROUTINE obs_grd_bruteforce diff --git a/V4.0/nemo_sources/src/OCE/OBS/obs_grid.F90 b/V4.0/nemo_sources/src/OCE/OBS/obs_grid.F90 index 39a1b6c..f93a700 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obs_grid.F90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obs_grid.F90 @@ -1179,4 +1179,4 @@ CONTAINS #include "find_obs_proc.h90" -END MODULE obs_grid \ No newline at end of file +END MODULE obs_grid diff --git a/V4.0/nemo_sources/src/OCE/OBS/obs_level_search.h90 b/V4.0/nemo_sources/src/OCE/OBS/obs_level_search.h90 index 6e503bc..4261496 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obs_level_search.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obs_level_search.h90 @@ -1,4 +1,4 @@ -!!---------------------------------------------------------------------- + !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !! $Id: obs_level_search.h90 10068 2018-08-28 14:09:04Z nicolasmartin $ !! Software governed by the CeCILL license (see ./LICENSE) @@ -48,4 +48,4 @@ kobsk(ji) = jk END DO - END SUBROUTINE obs_level_search \ No newline at end of file + END SUBROUTINE obs_level_search diff --git a/V4.0/nemo_sources/src/OCE/OBS/obs_mpp.F90 b/V4.0/nemo_sources/src/OCE/OBS/obs_mpp.F90 index fcecffb..153b6ba 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obs_mpp.F90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obs_mpp.F90 @@ -448,4 +448,4 @@ INCLUDE 'mpif.h' END SUBROUTINE mpp_alltoallv_real !!====================================================================== -END MODULE obs_mpp \ No newline at end of file +END MODULE obs_mpp diff --git a/V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 b/V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 index 03f2b48..e2f6551 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 @@ -274,16 +274,14 @@ CONTAINS INTEGER, INTENT(IN) :: kpi, kpj, kpk ! Local domain sizes INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & & kdailyavtypes ! Types for daily averages - REAL(dp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: zmask1, zmask2 - - - - REAL(dp), INTENT(IN), DIMENSION(kpi,kpj) :: pglam1, pglam2, pgphi1, pgphi2 - - - - - + REAL(dp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & + & zmask1, & + & zmask2 + REAL(dp), INTENT(IN), DIMENSION(kpi,kpj) :: & + & pglam1, & + & pglam2, & + & pgphi1, & + & pgphi2 INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff ! cut off for QC value !! * Local declarations @@ -1143,14 +1141,12 @@ CONTAINS & pobsphi REAL(KIND=wp), DIMENSION(kobsno), INTENT(INOUT) :: & & pobsdep ! Observation depths - REAL(KIND=dp), DIMENSION(kpi,kpj), INTENT(IN) :: plam, pphi - - + REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: & + & plam, pphi ! Model (lon,lat) coordinates REAL(KIND=wp), DIMENSION(kpk), INTENT(IN) :: & & pdep ! Model depth coordinates - REAL(KIND=dp), DIMENSION(kpi,kpj,kpk), INTENT(IN) :: pmask - - + REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) :: & + & pmask ! Land mask array INTEGER, DIMENSION(kprofno), INTENT(INOUT) :: & & kpobsqc ! Profile quality control INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: & @@ -1451,4 +1447,4 @@ CONTAINS END SUBROUTINE obs_uv_rej !!===================================================================== -END MODULE obs_prep \ No newline at end of file +END MODULE obs_prep diff --git a/V4.0/nemo_sources/src/OCE/OBS/str_c_to_for.h90 b/V4.0/nemo_sources/src/OCE/OBS/str_c_to_for.h90 index 97f8ef1..6c575f9 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/str_c_to_for.h90 +++ b/V4.0/nemo_sources/src/OCE/OBS/str_c_to_for.h90 @@ -1,4 +1,4 @@ -!!---------------------------------------------------------------------- + !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !! $Id: str_c_to_for.h90 10068 2018-08-28 14:09:04Z nicolasmartin $ !! Software governed by the CeCILL license (see ./LICENSE) @@ -36,4 +36,4 @@ & .OR.( IACHAR( cd_str(ji:ji) ) < 32 ) ) cd_str(ji:ji) = ' ' END DO - END SUBROUTINE str_c_to_for \ No newline at end of file + END SUBROUTINE str_c_to_for diff --git a/V4.0/nemo_sources/src/OCE/SBC/sbc_oce.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbc_oce.F90 index 8978479..8f3bb54 100644 --- a/V4.0/nemo_sources/src/OCE/SBC/sbc_oce.F90 +++ b/V4.0/nemo_sources/src/OCE/SBC/sbc_oce.F90 @@ -137,10 +137,10 @@ MODULE sbc_oce REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx , sfx_b !: salt flux [PSS.kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tot !: total E-P over ocean and ice [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmflx !: freshwater budget: freezing/melting [Kg/m2/s] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf!: river runoff [Kg/m2/s] - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf_b!: river runoff [Kg/m2/s] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf !: river runoff [Kg/m2/s] + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf_b !: river runoff [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwfisf , fwfisf_b !: ice shelf melting [Kg/m2/s] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwficb_b !: iceberg melting [Kg/m2/s] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwficb_b !: iceberg melting [Kg/m2/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fwficb !! diff --git a/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare.F90 index bc6b657..647035b 100644 --- a/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare.F90 +++ b/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare.F90 @@ -296,9 +296,9 @@ CONTAINS !! (https://sourceforge.net/p/aerobulk) !!------------------------------------------------------------------------ REAL(wp), DIMENSION(jpi,jpj) :: One_on_L !: 1./(Monin Obukhov length) [m^-1] - REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus, pts, pqs - REAL(dp), DIMENSION(jpi,jpj), INTENT(in) :: ptha, pqa - + REAL(dp), DIMENSION(jpi,jpj), INTENT(in) :: ptha, & !: average potetntial air temperature [K] + & pqa, & !: average specific humidity of air [kg/kg] + REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus, pts, pqs !: frictional velocity, temperature and humidity ! INTEGER :: ji, jj ! dummy loop indices @@ -446,4 +446,4 @@ CONTAINS END FUNCTION visc_air -END MODULE sbcblk_algo_coare \ No newline at end of file +END MODULE sbcblk_algo_coare diff --git a/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare3p5.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare3p5.F90 index d8f690a..217272c 100644 --- a/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare3p5.F90 +++ b/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare3p5.F90 @@ -267,10 +267,9 @@ CONTAINS !! (https://sourceforge.net/p/aerobulk) !!------------------------------------------------------------------------ REAL(wp), DIMENSION(jpi,jpj) :: One_on_L !: 1./(Monin Obukhov length) [m^-1] - REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus, pts, pqs - REAL(dp), DIMENSION(jpi,jpj), INTENT(in) :: ptha, pqa - - + REAL(dp), DIMENSION(jpi,jpj), INTENT(in) :: ptha, & !: average potetntial air temperature [K] + & pqa, & !: average specific humidity of air [kg/kg] + REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus, pts, pqs !: frictional velocity, temperature and humidity ! INTEGER :: ji, jj ! dummy loop indices REAL(wp) :: zqa ! local scalar @@ -415,4 +414,4 @@ CONTAINS END FUNCTION visc_air !!====================================================================== -END MODULE sbcblk_algo_coare3p5 \ No newline at end of file +END MODULE sbcblk_algo_coare3p5 diff --git a/V4.0/nemo_sources/src/OCE/SBC/sbccpl.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbccpl.F90 index 11758fc..5e2c5c2 100644 --- a/V4.0/nemo_sources/src/OCE/SBC/sbccpl.F90 +++ b/V4.0/nemo_sources/src/OCE/SBC/sbccpl.F90 @@ -2699,7 +2699,7 @@ CONTAINS ENDIF ! ! first T level thickness IF( ssnd(jps_e3t1st )%laction ) THEN - CALL cpl_snd( jps_e3t1st, isec, CASTSP(RESHAPE ( e3t_n(:,:,1) , (/jpi,jpj,1/) )), info ) + CALL cpl_snd( jps_e3t1st, isec, CASTSP(RESHAPE ( e3t_n(:,:,1) , (/jpi,jpj,1/) )), info ) ENDIF ! ! Qsr fraction IF( ssnd(jps_fraqsr)%laction ) THEN @@ -2730,4 +2730,4 @@ CONTAINS END SUBROUTINE sbc_cpl_snd !!====================================================================== -END MODULE sbccpl \ No newline at end of file +END MODULE sbccpl diff --git a/V4.0/nemo_sources/src/OCE/SBC/tide.h90 b/V4.0/nemo_sources/src/OCE/SBC/tide.h90 index f59ff28..35efe61 100644 --- a/V4.0/nemo_sources/src/OCE/SBC/tide.h90 +++ b/V4.0/nemo_sources/src/OCE/SBC/tide.h90 @@ -1,4 +1,4 @@ -!!---------------------------------------------------------------------- + !!---------------------------------------------------------------------- !! History : 3.2 ! 2007 (O. Le Galloudec) Original code !!---------------------------------------------------------------------- @@ -26,4 +26,4 @@ Wave(16) = tide( 'MU2' , 0.005841 , 2 , 2 , -4 , 4 , 0 , 0 , 0 , 2 , -2 , 0 , 0 , 0 , 78 ) Wave(17) = tide( 'NU2' , 0.009094 , 2 , 2 , -3 , 4 , -1 , 0 , 0 , 2 , -2 , 0 , 0 , 0 , 78 ) Wave(18) = tide( 'L2' , 0.006694 , 2 , 2 , -1 , 2 , -1 , 0 , +180 , 2 , -2 , 0 , 0 , 0 , 215 ) - Wave(19) = tide( 'T2' , 0.006614 , 2 , 2 , 0 , -1 , 0 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ) \ No newline at end of file + Wave(19) = tide( 'T2' , 0.006614 , 2 , 2 , 0 , -1 , 0 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ) diff --git a/V4.0/nemo_sources/src/OCE/TRA/eosbn2.F90 b/V4.0/nemo_sources/src/OCE/TRA/eosbn2.F90 index acd5b2e..b36749b 100644 --- a/V4.0/nemo_sources/src/OCE/TRA/eosbn2.F90 +++ b/V4.0/nemo_sources/src/OCE/TRA/eosbn2.F90 @@ -231,10 +231,10 @@ CONTAINS REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] ! INTEGER :: ji, jj, jk ! dummy loop indices - REAL(wp) :: zt, zh, ztm! local scalars - REAL(dp) :: zs! local scalars - REAL(wp) :: zn1, zn2! - - - REAL(dp) :: zn, zn0, zn3! - - + REAL(wp) :: zt, zh, ztm ! local scalars + REAL(dp) :: zs ! - - + REAL(wp) :: zn1, zn2 ! - - + REAL(dp) :: zn, zn0, zn3 ! - - !!---------------------------------------------------------------------- ! IF( ln_timing ) CALL timing_start('eos-insitu') @@ -334,10 +334,10 @@ CONTAINS ! INTEGER :: ji, jj, jk, jsmp ! dummy loop indices INTEGER :: jdof - REAL(wp) :: zt, zstemp, ztm! local scalars - REAL(dp) :: zh, zs! local scalars - REAL(wp) :: zn1, zn2, zn3! - - - REAL(dp) :: zn, zn0! - - + REAL(wp) :: zt, zstemp, ztm ! local scalars + REAL(dp) :: zh, zs ! - - + REAL(wp) :: zn1, zn2, zn3 ! - - + REAL(dp) :: zn, zn0 ! - - REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors !!---------------------------------------------------------------------- ! @@ -1797,8 +1797,8 @@ CONTAINS !!---------------------------------------------------------------------- INTEGER :: jk ! dummy loop indices - REAL(wp) :: zh, zxk, zq, zsr, zr1, zr2, zr3, zr4 - REAL(dp) :: zp, zt, zs + REAL(wp) :: zh, zxk, zq, zsr, zr1, zr2, zr3, zr4 + REAL(dp) :: zp, zt, zs REAL(wp) :: ze, zbw, zc, zd, zaw, za, zb, zb1, za1, zkw, zk0 REAL(wp), DIMENSION(jpk) :: zwkx, zwky, zwkz !!---------------------------------------------------------------------- diff --git a/V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 b/V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 index 87eb556..9c796d5 100644 --- a/V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 +++ b/V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 @@ -44,8 +44,7 @@ MODULE traadv_fct ! ! tridiag solver associated indices: INTEGER, PARAMETER :: np_NH = 0 ! Neumann homogeneous boundary condition INTEGER, PARAMETER :: np_CEN2 = 1 ! 2nd order centered boundary condition - REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: zbetup, zbup, zbdo - REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: zbetdo + REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo !! * Substitutions # include "vectopt_loop_substitute.h90" @@ -88,12 +87,12 @@ CONTAINS INTEGER :: ji, jj, jk, jn ! dummy loop indices INTEGER :: jj1, jj2, itid, ithreads ! OpenMP variables REAL(dp) :: ztra ! local scalar - REAL(wp) :: zfp_ui, zfp_vj, zC2t_u, zC4t_u! - - - REAL(dp) :: zfp_wk! - - - REAL(wp) :: zC2t_v! - - - REAL(dp) :: zfm_ui, zfm_vj, zfm_wk, zC4t_v! - - - REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu, zltv - REAL(dp), DIMENSION(jpi,jpj,jpk) :: zwi, zwx, zwy, zwz, ztw + REAL(wp) :: zfp_ui, zfp_vj, zC2t_u, zC4t_ui ! - - + REAL(dp) :: zfp_wk ! - - + REAL(wp) :: zC2t_v ! - - + REAL(dp) :: zfm_ui, zfm_vj, zfm_wk, zC4t_v ! - - + REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu, zltv + REAL(dp), DIMENSION(jpi,jpj,jpk) :: zwi, zwx, zwy, zwz, ztw REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdx, ztrdy, ztrdz REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zptry REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zwinf, zwdia, zwsup @@ -527,12 +526,12 @@ CONTAINS ! INTEGER :: ji, jj, jk ! dummy loop indices INTEGER :: ikm1 ! local integer - REAL(dp) :: zbt, za, zb! local scalars - REAL(wp) :: zc, zpos, zneg, zrtrn! local scalars - REAL(dp) :: zbig - REAL(dp) :: zau, zbu, zav, zup, zdo! - - - REAL(wp) :: zcu, zcv! - - - REAL(dp) :: zbv + REAL(dp) :: zbt, za, zb ! local scalars + REAL(wp) :: zc, zpos, zneg, zrtrn ! - - + REAL(dp) :: zbig ! - - + REAL(dp) :: zau, zbu, zav, zup, zdo ! - - + REAL(wp) :: zcu, zcv ! - - + REAL(dp) :: zbv ! - - !!---------------------------------------------------------------------- ! IF( ln_timing_detail .AND. ktid == 0 ) CALL timing_start('nonosc') diff --git a/V4.0/nemo_sources/src/OCE/TRA/traadv_ubs.F90 b/V4.0/nemo_sources/src/OCE/TRA/traadv_ubs.F90 index 2eec128..a8a917d 100644 --- a/V4.0/nemo_sources/src/OCE/TRA/traadv_ubs.F90 +++ b/V4.0/nemo_sources/src/OCE/TRA/traadv_ubs.F90 @@ -97,10 +97,10 @@ CONTAINS ! INTEGER :: ji, jj, jk, jn ! dummy loop indices REAL(wp) :: ztra, zbtr, zcoef ! local scalars - REAL(wp) :: zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk ! - - - REAL(wp) :: zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn ! - - - REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu, zltv, zti! 3D workspace - REAL(dp), DIMENSION(jpi,jpj,jpk) :: ztw! 3D workspace + REAL(wp) :: zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk ! - - + REAL(wp) :: zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn ! - - + REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu, zltv, zti ! 3D workspace + REAL(dp), DIMENSION(jpi,jpj,jpk) :: ztw ! - - !!---------------------------------------------------------------------- ! IF( ln_timing_detail ) CALL timing_start('tra_adv_ubs') @@ -308,7 +308,7 @@ CONTAINS INTEGER :: ji, jj, jk ! dummy loop indices INTEGER :: ikm1 ! local integer REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zrtrn ! local scalars - REAL(dp) :: zbig + REAL(dp) :: zbig ! - - REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo ! 3D workspace !!---------------------------------------------------------------------- ! diff --git a/V4.0/nemo_sources/src/OCE/TRA/trabbl.F90 b/V4.0/nemo_sources/src/OCE/TRA/trabbl.F90 index d7ca539..1fad976 100644 --- a/V4.0/nemo_sources/src/OCE/TRA/trabbl.F90 +++ b/V4.0/nemo_sources/src/OCE/TRA/trabbl.F90 @@ -331,8 +331,8 @@ CONTAINS INTEGER :: ijs, ijd, ikvs, ikvd ! - - REAL(wp) :: za, zb, zgdrho ! local scalars REAL(wp) :: zsign, zsigna, zgbbl ! - - - REAL(wp), DIMENSION(jpi,jpj,jpts) :: zab! 3D workspace - REAL(dp), DIMENSION(jpi,jpj,jpts) :: zts! 3D workspace + REAL(wp), DIMENSION(jpi,jpj,jpts) :: zab ! 3D workspace + REAL(dp), DIMENSION(jpi,jpj,jpts) :: zts ! - - REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb, zdep ! 2D workspace !!---------------------------------------------------------------------- ! @@ -560,4 +560,4 @@ CONTAINS END SUBROUTINE tra_bbl_init !!====================================================================== -END MODULE trabbl \ No newline at end of file +END MODULE trabbl diff --git a/V4.0/nemo_sources/src/OCE/TRA/traldf_iso.F90 b/V4.0/nemo_sources/src/OCE/TRA/traldf_iso.F90 index 25611d3..acf128e 100644 --- a/V4.0/nemo_sources/src/OCE/TRA/traldf_iso.F90 +++ b/V4.0/nemo_sources/src/OCE/TRA/traldf_iso.F90 @@ -98,8 +98,8 @@ CONTAINS INTEGER , INTENT(in ) :: kjpt ! number of tracers INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] - REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu! tracer gradient at pstep levels - REAL(dp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgv! tracer gradient at pstep levels + REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu ! tracer gradient at pstep levels + REAL(dp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgv ! - - - - - REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! tracer (kpass=1) or laplacian of tracer (kpass=2) REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptbb ! tracer (only used in kpass=2) @@ -424,4 +424,4 @@ CONTAINS END SUBROUTINE tra_ldf_iso !!============================================================================== -END MODULE traldf_iso \ No newline at end of file +END MODULE traldf_iso diff --git a/V4.0/nemo_sources/src/OCE/TRA/traldf_lap_blp.F90 b/V4.0/nemo_sources/src/OCE/TRA/traldf_lap_blp.F90 index 195f52c..ec56bf1 100644 --- a/V4.0/nemo_sources/src/OCE/TRA/traldf_lap_blp.F90 +++ b/V4.0/nemo_sources/src/OCE/TRA/traldf_lap_blp.F90 @@ -70,9 +70,9 @@ CONTAINS INTEGER , INTENT(in ) :: kjpt ! number of tracers INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] - REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu! tracer gradient at pstep levels - REAL(dp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgv! tracer gradient at pstep levels - REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels + REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu ! tracer gradient at pstep levels + REAL(dp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgv ! - - - - - + REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend ! @@ -184,16 +184,16 @@ CONTAINS INTEGER , INTENT(in ) :: kjpt ! number of tracers INTEGER , INTENT(in ) :: kldf ! type of operator used REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] - REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu! tracer gradient at pstep levels - REAL(dp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgv! tracer gradient at pstep levels + REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu ! tracer gradient at pstep levels + REAL(dp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgv ! - - - - - REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend ! INTEGER :: ji, jj, jk, jn ! dummy loop indices REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt) :: zlap ! laplacian at t-point - REAL(wp), DIMENSION(jpi,jpj, kjpt) :: zglu! bottom GRADh of the laplacian (u- and v-points) - REAL(dp), DIMENSION(jpi,jpj, kjpt) :: zglv! bottom GRADh of the laplacian (u- and v-points) + REAL(wp), DIMENSION(jpi,jpj, kjpt) :: zglu ! bottom GRADh of the laplacian (u-point) + REAL(dp), DIMENSION(jpi,jpj, kjpt) :: zglv ! - - - - - (v-point) REAL(wp), DIMENSION(jpi,jpj, kjpt) :: zgui, zgvi ! top GRADh of the laplacian (u- and v-points) !!--------------------------------------------------------------------- ! @@ -242,4 +242,4 @@ CONTAINS END SUBROUTINE tra_ldf_blp !!============================================================================== -END MODULE traldf_lap_blp \ No newline at end of file +END MODULE traldf_lap_blp diff --git a/V4.0/nemo_sources/src/OCE/TRA/traldf_triad.F90 b/V4.0/nemo_sources/src/OCE/TRA/traldf_triad.F90 index 17adf2f..d150015 100644 --- a/V4.0/nemo_sources/src/OCE/TRA/traldf_triad.F90 +++ b/V4.0/nemo_sources/src/OCE/TRA/traldf_triad.F90 @@ -76,8 +76,8 @@ CONTAINS INTEGER , INTENT(in ) :: kjpt ! number of tracers INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] - REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu! tracer gradient at pstep levels - REAL(dp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgv! tracer gradient at pstep levels + REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu ! tracer gradient at pstep levels + REAL(dp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgv ! - - - - - REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! tracer (kpass=1) or laplacian of tracer (kpass=2) REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptbb ! tracer (only used in kpass=2) @@ -436,4 +436,4 @@ CONTAINS END SUBROUTINE tra_ldf_triad !!============================================================================== -END MODULE traldf_triad \ No newline at end of file +END MODULE traldf_triad diff --git a/V4.0/nemo_sources/src/OCE/TRA/tranxt.F90 b/V4.0/nemo_sources/src/OCE/TRA/tranxt.F90 index aae313b..0945c3f 100644 --- a/V4.0/nemo_sources/src/OCE/TRA/tranxt.F90 +++ b/V4.0/nemo_sources/src/OCE/TRA/tranxt.F90 @@ -281,12 +281,12 @@ CONTAINS REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: psbc_tc ! surface tracer content REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: psbc_tc_b ! before surface tracer content ! - LOGICAL :: ll_traqsr, ll_rnf, ll_isf ! local logical - INTEGER :: ji, jj, jk, jn ! dummy loop indices - REAL(wp) :: zfact, zfact1, ztc_d! local scalar - REAL(dp) :: ztc_a, ztc_n, ztc_b, ztc_f! local scalar - REAL(wp) :: zfact2, ze3t_b, ze3t_a, ze3t_d, zscale! - - - REAL(dp) :: ze3t_f, ze3t_n! - - + LOGICAL :: ll_traqsr, ll_rnf, ll_isf ! local logical + INTEGER :: ji, jj, jk, jn ! dummy loop indices + REAL(wp) :: zfact, zfact1, ztc_d ! local scalar + REAL(dp) :: ztc_a, ztc_n, ztc_b, ztc_f ! - - + REAL(wp) :: zfact2, ze3t_b, ze3t_a, ze3t_d, zscale ! - - + REAL(dp) :: ze3t_f, ze3t_n ! - - !!---------------------------------------------------------------------- ! IF( kt == kit000 .AND. ktid == 0 ) THEN @@ -398,4 +398,4 @@ CONTAINS END SUBROUTINE tra_nxt_vvl !!====================================================================== -END MODULE tranxt \ No newline at end of file +END MODULE tranxt diff --git a/V4.0/nemo_sources/src/OCE/TRA/trazdf.F90 b/V4.0/nemo_sources/src/OCE/TRA/trazdf.F90 index ac52fdc..69a6f5f 100644 --- a/V4.0/nemo_sources/src/OCE/TRA/trazdf.F90 +++ b/V4.0/nemo_sources/src/OCE/TRA/trazdf.F90 @@ -148,8 +148,8 @@ CONTAINS REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! in: tracer trend ; out: after tracer field ! INTEGER :: ji, jj, jk, jn ! dummy loop indices - REAL(wp) :: zzwi, zzws! local scalars - REAL(dp) :: zrhs! local scalars + REAL(wp) :: zzwi, zzws ! local scalars + REAL(dp) :: zrhs ! - - REAL(dp), DIMENSION(jpi,kj1:kj2,jpk) :: zwi, zwt, zwd REAL(wp), DIMENSION(jpi,kj1:kj2,jpk) :: zws !!--------------------------------------------------------------------- @@ -289,4 +289,4 @@ CONTAINS END SUBROUTINE tra_zdf_imp !!============================================================================== -END MODULE trazdf \ No newline at end of file +END MODULE trazdf diff --git a/V4.0/nemo_sources/src/OCE/TRA/zpshde.F90 b/V4.0/nemo_sources/src/OCE/TRA/zpshde.F90 index da5b0d4..f7fbbab 100644 --- a/V4.0/nemo_sources/src/OCE/TRA/zpshde.F90 +++ b/V4.0/nemo_sources/src/OCE/TRA/zpshde.F90 @@ -87,15 +87,15 @@ CONTAINS INTEGER , INTENT(in ) :: kt ! ocean time-step index INTEGER , INTENT(in ) :: kjpt ! number of tracers REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields - REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu! hor. grad. of ptra at u- & v-pts - REAL(dp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtv! hor. grad. of ptra at u- & v-pts + REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu ! hor. grad. of ptra at u-pts + REAL(dp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtv ! - - - - - v-pts REAL(dp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields REAL(dp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) ! INTEGER :: ji, jj, jn ! Dummy loop indices INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points - REAL(wp) :: ze3wv, zmaxu! local scalars - REAL(dp) :: ze3wu, zmaxv! local scalars + REAL(wp) :: ze3wv, zmaxu ! local scalars + REAL(dp) :: ze3wu, zmaxv ! - - REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos REAL(dp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj ! !!---------------------------------------------------------------------- @@ -149,7 +149,7 @@ CONTAINS END DO ! CALL lbc_lnk_multi( 'zpshde', pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. - CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp ) + CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp ) ! - - - ! IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) pgru(:,:) = 0._wp @@ -246,8 +246,8 @@ CONTAINS INTEGER , INTENT(in ) :: kt ! ocean time-step index INTEGER , INTENT(in ) :: kjpt ! number of tracers REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields - REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu! hor. grad. of ptra at u- & v-pts - REAL(dp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtv! hor. grad. of ptra at u- & v-pts + REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu ! hor. grad. of ptra at u-pts + REAL(dp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtv ! - - - - - v-pts REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) REAL(dp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields REAL(dp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) @@ -312,7 +312,7 @@ CONTAINS END DO ! CALL lbc_lnk_multi( 'zpshde', pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. - CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp ) + CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp ) ! - - ! horizontal derivative of density anomalies (rd) IF( PRESENT( prd ) ) THEN ! depth of the partial step level diff --git a/V4.0/nemo_sources/src/OCE/TRD/trdtra.F90 b/V4.0/nemo_sources/src/OCE/TRD/trdtra.F90 index 9d97d65..11bd60e 100644 --- a/V4.0/nemo_sources/src/OCE/TRD/trdtra.F90 +++ b/V4.0/nemo_sources/src/OCE/TRD/trdtra.F90 @@ -83,8 +83,8 @@ CONTAINS INTEGER :: jk ! loop indices INTEGER :: i01 ! 0 or 1 REAL(dp), DIMENSION(jpi,jpj,jpk) :: ztrds ! 3D workspace - REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwt, zws! 3D workspace - REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt! 3D workspace + REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwt, zws ! - - + REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt ! - - !!---------------------------------------------------------------------- ! IF( .NOT. ALLOCATED( trdtx ) ) THEN ! allocate trdtra arrays @@ -369,4 +369,4 @@ CONTAINS END SUBROUTINE trd_tra_iom !!====================================================================== -END MODULE trdtra \ No newline at end of file +END MODULE trdtra diff --git a/V4.0/nemo_sources/src/OCE/TRD/trdtrc.F90 b/V4.0/nemo_sources/src/OCE/TRD/trdtrc.F90 index 51c9c84..df17827 100644 --- a/V4.0/nemo_sources/src/OCE/TRD/trdtrc.F90 +++ b/V4.0/nemo_sources/src/OCE/TRD/trdtrc.F90 @@ -13,7 +13,7 @@ CONTAINS SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt ) INTEGER :: kt, kjn, ktrd - REAL(dp) :: ptrtrd(:,:,:) + REAL(dp) :: ptrtrd(:,:,:) WRITE(*,*) 'trd_trc : You should not have seen this print! error?', ptrtrd(1,1,1) WRITE(*,*) ' " " : You should not have seen this print! error?', kjn, ktrd, kt END SUBROUTINE trd_trc diff --git a/V4.0/nemo_sources/src/OCE/USR/usrdef_hgr.F90 b/V4.0/nemo_sources/src/OCE/USR/usrdef_hgr.F90 index 5be606a..766aeaa 100644 --- a/V4.0/nemo_sources/src/OCE/USR/usrdef_hgr.F90 +++ b/V4.0/nemo_sources/src/OCE/USR/usrdef_hgr.F90 @@ -56,16 +56,16 @@ CONTAINS !! - define i- & j-scale factors at t-, u-, v- and f-points (in meters) !! - define u- & v-surfaces (if gridsize reduction is used in some straits) (in m2) !!---------------------------------------------------------------------- - REAL(wp), DIMENSION(:,:), INTENT(out) :: plamt, plamf! longitude outputs [degrees] - REAL(dp), DIMENSION(:,:), INTENT(out) :: plamu, plamv! longitude outputs [degrees] - REAL(wp), DIMENSION(:,:), INTENT(out) :: pphit, pphif! latitude outputs [degrees] - REAL(dp), DIMENSION(:,:), INTENT(out) :: pphiu, pphiv! latitude outputs [degrees] + REAL(wp), DIMENSION(:,:), INTENT(out) :: plamt, plamf! longitude outputs [degrees] + REAL(dp), DIMENSION(:,:), INTENT(out) :: plamu, plamv! - - [degrees] + REAL(wp), DIMENSION(:,:), INTENT(out) :: pphit, pphif! latitude outputs [degrees] + REAL(dp), DIMENSION(:,:), INTENT(out) :: pphiu, pphiv! - - [degrees] INTEGER , INTENT(out) :: kff ! =1 Coriolis parameter computed here, =0 otherwise REAL(wp), DIMENSION(:,:), INTENT(out) :: pff_f, pff_t ! Coriolis factor at f-point [1/s] - REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1v! i-scale factors [m] - REAL(dp), DIMENSION(:,:), INTENT(out) :: pe1t, pe1u, pe1f! i-scale factors [m] - REAL(wp), DIMENSION(:,:), INTENT(out) :: pe2u! j-scale factors [m] - REAL(dp), DIMENSION(:,:), INTENT(out) :: pe2t, pe2v, pe2f! j-scale factors [m] + REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1v ! i-scale factors [m] + REAL(dp), DIMENSION(:,:), INTENT(out) :: pe1t, pe1u, pe1f ! - - [m] + REAL(wp), DIMENSION(:,:), INTENT(out) :: pe2u ! j-scale factors [m] + REAL(dp), DIMENSION(:,:), INTENT(out) :: pe2t, pe2v, pe2f ! - - [m] INTEGER , INTENT(out) :: ke1e2u_v ! =1 u- & v-surfaces computed here, =0 otherwise REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1e2u, pe1e2v ! u- & v-surfaces (if reduction in strait) [m2] ! @@ -173,4 +173,4 @@ CONTAINS END SUBROUTINE usr_def_hgr !!====================================================================== -END MODULE usrdef_hgr \ No newline at end of file +END MODULE usrdef_hgr diff --git a/V4.0/nemo_sources/src/OCE/USR/usrdef_zgr.F90 b/V4.0/nemo_sources/src/OCE/USR/usrdef_zgr.F90 index 6f34bcb..6b135c6 100644 --- a/V4.0/nemo_sources/src/OCE/USR/usrdef_zgr.F90 +++ b/V4.0/nemo_sources/src/OCE/USR/usrdef_zgr.F90 @@ -51,13 +51,13 @@ CONTAINS !!---------------------------------------------------------------------- LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag - REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d! 1D grid-point depth [m] - REAL(dp), DIMENSION(:) , INTENT(out) :: pdepw_1d! 1D grid-point depth [m] + REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d ! 1D grid-point depth [m] + REAL(dp), DIMENSION(:) , INTENT(out) :: pdepw_1d ! 1D grid-point depth [m] REAL(dp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m] REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pdept, pdepw ! grid-point depth [m] REAL(dp), DIMENSION(:,:,:), INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m] - REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3uw, pe3vw! i-scale factors - REAL(dp), DIMENSION(:,:,:), INTENT(out) :: pe3w! i-scale factors + REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3uw, pe3vw ! i-scale factors + REAL(dp), DIMENSION(:,:,:), INTENT(out) :: pe3w ! i-scale factors INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level ! INTEGER :: inum ! local logical unit @@ -123,8 +123,8 @@ CONTAINS !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766. !! Madec and Imbard, 1996, Clim. Dyn. !!---------------------------------------------------------------------- - REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d! 1D grid-point depth [m] - REAL(dp), DIMENSION(:) , INTENT(out) :: pdepw_1d! 1D grid-point depth [m] + REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d ! 1D grid-point depth [m] + REAL(dp), DIMENSION(:) , INTENT(out) :: pdepw_1d ! 1D grid-point depth [m] REAL(dp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D vertical scale factors [m] ! INTEGER :: jk ! dummy loop indices @@ -224,13 +224,13 @@ CONTAINS !! !! ** Method : set 3D coord. arrays to reference 1D array !!---------------------------------------------------------------------- - REAL(wp), DIMENSION(:) , INTENT(in ) :: pdept_1d! 1D grid-point depth [m] - REAL(dp), DIMENSION(:) , INTENT(in ) :: pdepw_1d! 1D grid-point depth [m] + REAL(wp), DIMENSION(:) , INTENT(in ) :: pdept_1d ! 1D grid-point depth [m] + REAL(dp), DIMENSION(:) , INTENT(in ) :: pdepw_1d ! 1D grid-point depth [m] REAL(dp), DIMENSION(:) , INTENT(in ) :: pe3t_1d , pe3w_1d ! 1D vertical scale factors [m] REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pdept, pdepw ! grid-point depth [m] REAL(dp), DIMENSION(:,:,:), INTENT( out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m] - REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3uw, pe3vw! - - - - REAL(dp), DIMENSION(:,:,:), INTENT( out) :: pe3w! - - - + REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3uw, pe3vw ! - - - + REAL(dp), DIMENSION(:,:,:), INTENT( out) :: pe3w ! - - - ! INTEGER :: jk !!---------------------------------------------------------------------- @@ -250,4 +250,4 @@ CONTAINS END SUBROUTINE zgr_zco !!====================================================================== -END MODULE usrdef_zgr \ No newline at end of file +END MODULE usrdef_zgr diff --git a/V4.0/nemo_sources/src/OCE/ZDF/zdfgls.F90 b/V4.0/nemo_sources/src/OCE/ZDF/zdfgls.F90 index 2c049f4..a4385e8 100644 --- a/V4.0/nemo_sources/src/OCE/ZDF/zdfgls.F90 +++ b/V4.0/nemo_sources/src/OCE/ZDF/zdfgls.F90 @@ -138,8 +138,8 @@ CONTAINS !! INTEGER , INTENT(in ) :: kt ! ocean time step REAL(dp), DIMENSION(:,:,:), INTENT(in ) :: p_sh2 ! shear production term - REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avt! momentum and tracer Kz (w-points) - REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: p_avm! momentum and tracer Kz (w-points) + REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avt ! momentum and tracer Kz (w-points) + REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: p_avm ! momentum and tracer Kz (w-points) ! INTEGER :: ji, jj, jk ! dummy loop arguments INTEGER :: ibot, ibotm1 ! local integers diff --git a/V4.0/nemo_sources/src/OCE/ZDF/zdfric.F90 b/V4.0/nemo_sources/src/OCE/ZDF/zdfric.F90 index 45d2f6f..5244d0b 100644 --- a/V4.0/nemo_sources/src/OCE/ZDF/zdfric.F90 +++ b/V4.0/nemo_sources/src/OCE/ZDF/zdfric.F90 @@ -154,8 +154,8 @@ CONTAINS INTEGER , INTENT(in ) :: kt ! ocean time-step REAL(dp), DIMENSION(:,:,:), INTENT(in ) :: pdept ! depth of t-point [m] REAL(dp), DIMENSION(:,:,:), INTENT(in ) :: p_sh2 ! shear production term - REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avt! momentum and tracer Kz (w-points) - REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: p_avm! momentum and tracer Kz (w-points) + REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avt ! momentum and tracer Kz (w-points) + REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: p_avm ! momentum and tracer Kz (w-points) !! INTEGER :: ji, jj, jk ! dummy loop indices REAL(wp) :: zcfRi, zav, zustar, zhek ! local scalars @@ -250,4 +250,4 @@ CONTAINS END SUBROUTINE ric_rst !!====================================================================== -END MODULE zdfric \ No newline at end of file +END MODULE zdfric diff --git a/V4.0/nemo_sources/src/OCE/ZDF/zdfswm.F90 b/V4.0/nemo_sources/src/OCE/ZDF/zdfswm.F90 index 4f699d1..77b9e51 100644 --- a/V4.0/nemo_sources/src/OCE/ZDF/zdfswm.F90 +++ b/V4.0/nemo_sources/src/OCE/ZDF/zdfswm.F90 @@ -53,8 +53,8 @@ CONTAINS !!--------------------------------------------------------------------- INTEGER , INTENT(in ) :: kt ! ocean time step REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm ! momentum Kz (w-points) - REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avt! tracer Kz (w-points) - REAL(dp), DIMENSION(:,:,:) , INTENT(inout) :: p_avs! tracer Kz (w-points) + REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avt ! tracer Kz (w-points) + REAL(dp), DIMENSION(:,:,:) , INTENT(inout) :: p_avs ! tracer Kz (w-points) ! INTEGER :: ji, jj, jk ! dummy loop indices REAL(wp):: zcoef, zqb ! local scalar @@ -100,4 +100,4 @@ CONTAINS END SUBROUTINE zdf_swm_init !!====================================================================== -END MODULE zdfswm \ No newline at end of file +END MODULE zdfswm diff --git a/V4.0/nemo_sources/src/OCE/ZDF/zdftke.F90 b/V4.0/nemo_sources/src/OCE/ZDF/zdftke.F90 index 8380b84..0849480 100644 --- a/V4.0/nemo_sources/src/OCE/ZDF/zdftke.F90 +++ b/V4.0/nemo_sources/src/OCE/ZDF/zdftke.F90 @@ -177,8 +177,8 @@ CONTAINS !!---------------------------------------------------------------------- INTEGER , INTENT(in ) :: kt ! ocean time step REAL(dp), DIMENSION(:,:,:), INTENT(in ) :: p_sh2 ! shear production term - REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avt! momentum and tracer Kz (w-points) - REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: p_avm! momentum and tracer Kz (w-points) + REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avt ! momentum and tracer Kz (w-points) + REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: p_avm ! momentum and tracer Kz (w-points) INTEGER :: jj1, jj2, itid, ithreads ! openmp variables !!---------------------------------------------------------------------- ! @@ -221,8 +221,8 @@ CONTAINS REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdepw ! depth of w-points REAL(dp), DIMENSION(:,:,:) , INTENT(in ) :: p_e3t, p_e3w ! level thickness (t- & w-points) REAL(dp), DIMENSION(:,:,:) , INTENT(in ) :: p_sh2 ! shear production term - REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: p_avt! vertical eddy viscosity & diffusivity (w-points) - REAL(dp), DIMENSION(:,:,:) , INTENT(in ) :: p_avm! vertical eddy viscosity & diffusivity (w-points) + REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: p_avt ! vertical eddy viscosity & diffusivity (w-points) + REAL(dp), DIMENSION(:,:,:) , INTENT(in ) :: p_avm ! vertical eddy viscosity & diffusivity (w-points) ! INTEGER :: ji, jj, jk ! dummy loop arguments REAL(wp), PARAMETER :: ztwothird = 2._wp/3._wp @@ -231,15 +231,15 @@ CONTAINS REAL(wp), PARAMETER :: zrhoa = 1.22 ! Air density kg/m3 REAL(wp), PARAMETER :: zcdrag = 1.5e-3 ! drag coefficient REAL(wp) :: zetop, zebot, zmsku, zmskv ! local scalars - REAL(wp) :: zbbirau! local scalars - REAL(dp) :: zbbrau, zri! local scalars - REAL(wp) :: zfact1, zfact2! - - - REAL(dp) :: zfact3! - - - REAL(wp) :: ztx2, zty2! - - - REAL(dp) :: zcof! - - + REAL(wp) :: zbbirau ! - - + REAL(dp) :: zbbrau, zri ! - - + REAL(wp) :: zfact1, zfact2 ! - - + REAL(dp) :: zfact3 ! - - + REAL(wp) :: ztx2, zty2 ! - - + REAL(dp) :: zcof ! - - REAL(wp) :: ztau , zdif ! - - - REAL(wp) :: zind! - - - REAL(dp) :: zus, zwlc! - - + REAL(wp) :: zind ! - - + REAL(dp) :: zus, zwlc ! - - REAL(wp) :: zzd_up, zzd_lw ! - - REAL(wp) :: zlamb , zz0 ! - - REAL(wp) :: zlam , zphi ! - - @@ -627,14 +627,14 @@ CONTAINS INTEGER, INTENT(in) :: ktid, kj1, kj2 ! openmp variables REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdepw ! depth (w-points) REAL(dp), DIMENSION(:,:,:), INTENT(in ) :: p_e3t, p_e3w ! level thickness (t- & w-points) - REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_avt! vertical eddy viscosity & diffusivity (w-points) - REAL(dp), DIMENSION(:,:,:), INTENT( out) :: p_avm! vertical eddy viscosity & diffusivity (w-points) + REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_avt ! vertical eddy viscosity & diffusivity (w-points) + REAL(dp), DIMENSION(:,:,:), INTENT( out) :: p_avm ! vertical eddy viscosity & diffusivity (w-points) ! - INTEGER :: ji, jj, jk ! dummy loop indices - REAL(wp) :: zcoef! local scalars - REAL(dp) :: zrn2, zraug, zav! local scalars - REAL(wp) :: zdku, zdkv! - - - REAL(dp) :: zsqen! - - + INTEGER :: ji, jj, jk ! dummy loop indices + REAL(wp) :: zcoef ! local scalars + REAL(dp) :: zrn2, zraug, zav ! - - + REAL(wp) :: zdku, zdkv ! - - + REAL(dp) :: zsqen ! - - REAL(wp) :: zemxl, zemlm, zemlp, zmaxice ! - - REAL(dp), DIMENSION(jpi,jpj,jpk) :: zmxlm, zmxld ! 3D workspace REAL(wp), PARAMETER :: zcharnock_oc = 2.e5_wp ! mean value of ocean side Charnock parameter diff --git a/V4.0/nemo_sources/src/OCE/oce.F90 b/V4.0/nemo_sources/src/OCE/oce.F90 index 03153d1..b9bee7c 100644 --- a/V4.0/nemo_sources/src/OCE/oce.F90 +++ b/V4.0/nemo_sources/src/OCE/oce.F90 @@ -18,10 +18,10 @@ MODULE oce !! dynamics and tracer fields ! before ! now ! after ! the after trends becomes the fields !! -------------------------- ! fields ! fields ! trends ! only after tra_zdf and dyn_spg - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ub, un!: i-horizontal velocity [m/s] - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ua!: i-horizontal velocity [m/s] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vb, vn!: j-horizontal velocity [m/s] - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: va!: j-horizontal velocity [m/s] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ub , un !: i-horizontal velocity [m/s] + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ua !: i-horizontal velocity [m/s] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vb , vn !: j-horizontal velocity [m/s] + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: va !: j-horizontal velocity [m/s] REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wn !: vertical velocity [m/s] REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wi !: vertical vel. (adaptive-implicit) [m/s] REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivn !: horizontal divergence [s-1] @@ -36,21 +36,21 @@ MODULE oce !! free surface ! before ! now ! after ! !! ------------ ! fields ! fields ! fields ! REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub_b , un_b , ua_b !: Barotropic velocities at u-point [m/s] - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vn_b!: Barotropic velocities at v-point [m/s] - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vb_b, va_b!: Barotropic velocities at v-point [m/s] + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vn_b !: Barotropic velocities at v-point [m/s] + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vb_b , va_b !: Barotropic velocities at v-point [m/s] REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshb , sshn , ssha !: sea surface height at t-point [m] !! Arrays at barotropic time step: ! befbefore! before ! now ! after ! REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubb_e , ub_e , un_e , ua_e !: u-external velocity - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vbb_e, va_e!: v-external velocity - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vb_e, vn_e!: v-external velocity + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vbb_e , va_e !: v-external velocity + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vb_e , vn_e !: v-external velocity REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshbb_e, sshb_e, sshn_e, ssha_e !: external ssh REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e !: external u-depth REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hv_e !: external v-depth REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur_e !: inverse of u-depth REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hvr_e !: inverse of v-depth - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_b!: Half step fluxes (ln_bt_fw=T) - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vb2_b!: Half step fluxes (ln_bt_fw=T) + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_b !: Half step fluxes (ln_bt_fw=T) + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vb2_b !: Half step fluxes (ln_bt_fw=T) REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_bf , vn_bf !: Asselin filtered half step fluxes (ln_bt_fw=T) #if defined key_agrif REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_i_b, vb2_i_b !: Half step time integrated fluxes @@ -60,9 +60,9 @@ MODULE oce !! interpolated gradient (only used in zps case) !! --------------------- - REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtsu!: horizontal gradient of T, S bottom u-point - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtsv!: horizontal gradient of T, S bottom u-point - REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gru , grv !: horizontal gradient of rd at bottom u-point + REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtsu !: horizontal gradient of T, S bottom u-point + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtsv !: horizontal gradient of T, S bottom u-point + REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gru , grv !: horizontal gradient of rd at bottom u-point !! (ISF) interpolated gradient (only used for ice shelf case) !! --------------------- @@ -126,4 +126,4 @@ CONTAINS END FUNCTION oce_alloc !!====================================================================== -END MODULE oce \ No newline at end of file +END MODULE oce diff --git a/V4.0/nemo_sources/src/OCE/vectopt_loop_substitute.h90 b/V4.0/nemo_sources/src/OCE/vectopt_loop_substitute.h90 index 2884f75..131e8f8 100644 --- a/V4.0/nemo_sources/src/OCE/vectopt_loop_substitute.h90 +++ b/V4.0/nemo_sources/src/OCE/vectopt_loop_substitute.h90 @@ -1,4 +1,4 @@ -!!---------------------------------------------------------------------- + !!---------------------------------------------------------------------- !! *** vectopt_loop_substitute *** !!---------------------------------------------------------------------- !! ** purpose : substitute the inner loop start/end indices with CPP macro @@ -15,4 +15,4 @@ #else # define fs_2 2 # define fs_jpim1 jpim1 -#endif \ No newline at end of file +#endif diff --git a/V4.0/nemo_sources/src/TOP/PISCES/P4Z/p4zche.F90 b/V4.0/nemo_sources/src/TOP/PISCES/P4Z/p4zche.F90 index a3eb565..8880873 100644 --- a/V4.0/nemo_sources/src/TOP/PISCES/P4Z/p4zche.F90 +++ b/V4.0/nemo_sources/src/TOP/PISCES/P4Z/p4zche.F90 @@ -600,7 +600,7 @@ CONTAINS END DO END DO - zeqn_absmin(:,:,:) = HUGE(1._dp) + zeqn_absmin(:,:,:) = HUGE(1._wp) DO jn = 1, jp_maxniter_atgen DO jk = 1, jpk diff --git a/V4.0/nemo_sources/src/TOP/PISCES/SED/sedchem.F90 b/V4.0/nemo_sources/src/TOP/PISCES/SED/sedchem.F90 index 1956900..367bb36 100644 --- a/V4.0/nemo_sources/src/TOP/PISCES/SED/sedchem.F90 +++ b/V4.0/nemo_sources/src/TOP/PISCES/SED/sedchem.F90 @@ -353,7 +353,7 @@ CONTAINS END DO END DO - zeqn_absmin(:,:) = HUGE(1._dp) + zeqn_absmin(:,:) = HUGE(1._wp) DO jn = 1, jp_maxniter_atgen DO jk = 1, jpksed diff --git a/V4.0/nemo_sources/src/zpshde.F90 b/V4.0/nemo_sources/src/zpshde.F90 deleted file mode 100644 index a57595c..0000000 --- a/V4.0/nemo_sources/src/zpshde.F90 +++ /dev/null @@ -1,1040 +0,0 @@ -MODULE zpshde - !!====================================================================== - !! *** MODULE zpshde *** - !! z-coordinate + partial step : Horizontal Derivative at ocean bottom level - !!====================================================================== - !! History : OPA ! 2002-04 (A. Bozec) Original code - !! NEMO 1.0 ! 2002-08 (G. Madec E. Durand) Optimization and Free form - !! - ! 2004-03 (C. Ethe) adapted for passive tracers - !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA - !! 3.6 ! 2014-11 (P. Mathiot) Add zps_hde_isf (needed to open a cavity) - !!====================================================================== - - !!---------------------------------------------------------------------- - !! zps_hde : Horizontal DErivative of T, S and rd at the last - !! ocean level (Z-coord. with Partial Steps) - !!---------------------------------------------------------------------- - USE oce ! ocean: dynamics and tracers variables - USE dom_oce ! domain: ocean variables - USE phycst ! physical constants - USE eosbn2 ! ocean equation of state - USE in_out_manager ! I/O manager - USE lbclnk ! lateral boundary conditions (or mpp link) - USE lib_mpp ! MPP library - USE timing ! Timing - - IMPLICIT NONE - PRIVATE - - PUBLIC zps_hde ! routine called by step.F90 - PUBLIC zps_hde_isf ! routine called by step.F90 - - ! INTERFACE zps_hde - ! MODULE PROCEDURE zps_hde_sp, zps_hde_dp, zps_hde_exc - ! END INTERFACE zps_hde - - INTERFACE zps_hde_isf - MODULE PROCEDURE zps_hde_isf_sp, zps_hde_isf_dp - END INTERFACE zps_hde_isf - !! * Substitutions -# include "vectopt_loop_substitute.h90" - !!---------------------------------------------------------------------- - !! NEMO/OCE 4.0 , NEMO Consortium (2018) - !! $Id: zpshde.F90 10425 2018-12-19 21:54:16Z smasson $ - !! Software governed by the CeCILL license (see ./LICENSE) - !!---------------------------------------------------------------------- -CONTAINS - -! SUBROUTINE zps_hde_sp( kt, kjpt, pta, pgtu, pgtv, & -! & prd, pgru, pgrv ) -! !!---------------------------------------------------------------------- -! !! *** ROUTINE zps_hde *** -! !! -! !! ** Purpose : Compute the horizontal derivative of T, S and rho -! !! at u- and v-points with a linear interpolation for z-coordinate -! !! with partial steps. -! !! -! !! ** Method : In z-coord with partial steps, scale factors on last -! !! levels are different for each grid point, so that T, S and rd -! !! points are not at the same depth as in z-coord. To have horizontal -! !! gradients again, we interpolate T and S at the good depth : -! !! Linear interpolation of T, S -! !! Computation of di(tb) and dj(tb) by vertical interpolation: -! !! di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~ -! !! dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~ -! !! This formulation computes the two cases: -! !! CASE 1 CASE 2 -! !! k-1 ___ ___________ k-1 ___ ___________ -! !! Ti T~ T~ Ti+1 -! !! _____ _____ -! !! k | |Ti+1 k Ti | | -! !! | |____ ____| | -! !! ___ | | | ___ | | | -! !! -! !! case 1-> e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then -! !! t~ = t(i+1,j ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1) -! !! ( t~ = t(i ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1) ) -! !! or -! !! case 2-> e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then -! !! t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i ) -! !! ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) ) -! !! Idem for di(s) and dj(s) -! !! -! !! For rho, we call eos which will compute rd~(t~,s~) at the right -! !! depth zh from interpolated T and S for the different formulations -! !! of the equation of state (eos). -! !! Gradient formulation for rho : -! !! di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~ -! !! -! !! ** Action : compute for top interfaces -! !! - pgtu, pgtv: horizontal gradient of tracer at u- & v-points -! !! - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points -! !!---------------------------------------------------------------------- -! INTEGER , INTENT(in ) :: kt ! ocean time-step index -! INTEGER , INTENT(in ) :: kjpt ! number of tracers -! REAL(sp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields -! REAL(sp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts -! REAL(sp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields -! REAL(sp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) -! ! -! INTEGER :: ji, jj, jn ! Dummy loop indices -! INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points -! REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! local scalars -! REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos -! REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj ! -! !!---------------------------------------------------------------------- -! ! -! IF( ln_timing ) CALL timing_start( 'zps_hde') -! ! -! pgtu(:,:,:) = 0._wp ; zti (:,:,:) = 0._wp ; zhi (:,:) = 0._wp -! pgtv(:,:,:) = 0._wp ; ztj (:,:,:) = 0._wp ; zhj (:,:) = 0._wp -! ! -! DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! -! ! -! DO jj = 1, jpjm1 -! DO ji = 1, jpim1 -! iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points -! ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 -! !!gm BUG ? when applied to before fields, e3w_b should be used.... -! ze3wu = e3w_n(ji+1,jj ,iku) - e3w_n(ji,jj,iku) -! ze3wv = e3w_n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv) -! ! -! ! i- direction -! IF( ze3wu >= 0._wp ) THEN ! case 1 -! zmaxu = ze3wu / e3w_n(ji+1,jj,iku) -! ! interpolated values of tracers -! zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) -! ! gradient of tracers -! pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) -! ELSE ! case 2 -! zmaxu = -ze3wu / e3w_n(ji,jj,iku) -! ! interpolated values of tracers -! zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) -! ! gradient of tracers -! pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) -! ENDIF -! ! -! ! j- direction -! IF( ze3wv >= 0._wp ) THEN ! case 1 -! zmaxv = ze3wv / e3w_n(ji,jj+1,ikv) -! ! interpolated values of tracers -! ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) -! ! gradient of tracers -! pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) -! ELSE ! case 2 -! zmaxv = -ze3wv / e3w_n(ji,jj,ikv) -! ! interpolated values of tracers -! ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) -! ! gradient of tracers -! pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) -! ENDIF -! END DO -! END DO -! END DO -! ! -! CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. -! ! -! IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) -! pgru(:,:) = 0._wp -! pgrv(:,:) = 0._wp ! depth of the partial step level -! DO jj = 1, jpjm1 -! DO ji = 1, jpim1 -! iku = mbku(ji,jj) -! ikv = mbkv(ji,jj) -! ze3wu = e3w_n(ji+1,jj ,iku) - e3w_n(ji,jj,iku) -! ze3wv = e3w_n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv) -! IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept_n(ji ,jj,iku) ! i-direction: case 1 -! ELSE ; zhi(ji,jj) = gdept_n(ji+1,jj,iku) ! - - case 2 -! ENDIF -! IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept_n(ji,jj ,ikv) ! j-direction: case 1 -! ELSE ; zhj(ji,jj) = gdept_n(ji,jj+1,ikv) ! - - case 2 -! ENDIF -! END DO -! END DO -! ! -! CALL eos( zti, zhi, zri ) ! interpolated density from zti, ztj -! CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj -! ! -! DO jj = 1, jpjm1 ! Gradient of density at the last level -! DO ji = 1, jpim1 -! iku = mbku(ji,jj) -! ikv = mbkv(ji,jj) -! ze3wu = e3w_n(ji+1,jj ,iku) - e3w_n(ji,jj,iku) -! ze3wv = e3w_n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv) -! IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 -! ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 -! ENDIF -! IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 -! ELSE ; pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 -! ENDIF -! END DO -! END DO -! CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions -! ! -! END IF -! ! -! IF( ln_timing ) CALL timing_stop( 'zps_hde') -! ! -! END SUBROUTINE zps_hde_sp - - SUBROUTINE zps_hde_exc( kt, kjpt, pta, pgtu, pgtv, & - & prd, pgru, pgrv ) - !!---------------------------------------------------------------------- - !! *** ROUTINE zps_hde *** - !! - !! ** Purpose : Compute the horizontal derivative of T, S and rho - !! at u- and v-points with a linear interpolation for z-coordinate - !! with partial steps. - !! - !! ** Method : In z-coord with partial steps, scale factors on last - !! levels are different for each grid point, so that T, S and rd - !! points are not at the same depth as in z-coord. To have horizontal - !! gradients again, we interpolate T and S at the good depth : - !! Linear interpolation of T, S - !! Computation of di(tb) and dj(tb) by vertical interpolation: - !! di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~ - !! dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~ - !! This formulation computes the two cases: - !! CASE 1 CASE 2 - !! k-1 ___ ___________ k-1 ___ ___________ - !! Ti T~ T~ Ti+1 - !! _____ _____ - !! k | |Ti+1 k Ti | | - !! | |____ ____| | - !! ___ | | | ___ | | | - !! - !! case 1-> e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then - !! t~ = t(i+1,j ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1) - !! ( t~ = t(i ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1) ) - !! or - !! case 2-> e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then - !! t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i ) - !! ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) ) - !! Idem for di(s) and dj(s) - !! - !! For rho, we call eos which will compute rd~(t~,s~) at the right - !! depth zh from interpolated T and S for the different formulations - !! of the equation of state (eos). - !! Gradient formulation for rho : - !! di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~ - !! - !! ** Action : compute for top interfaces - !! - pgtu, pgtv: horizontal gradient of tracer at u- & v-points - !! - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points - !!---------------------------------------------------------------------- - INTEGER , INTENT(in ) :: kt ! ocean time-step index - INTEGER , INTENT(in ) :: kjpt ! number of tracers - REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields - REAL(sp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts - REAL(dp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields - REAL(sp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) - ! - INTEGER :: ji, jj, jn ! Dummy loop indices - INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points - REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! local scalars - REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos - REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj ! - !!---------------------------------------------------------------------- - ! - IF( ln_timing ) CALL timing_start( 'zps_hde') - ! - pgtu(:,:,:) = 0._wp ; zti (:,:,:) = 0._wp ; zhi (:,:) = 0._wp - pgtv(:,:,:) = 0._wp ; ztj (:,:,:) = 0._wp ; zhj (:,:) = 0._wp - ! - DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! - ! - DO jj = 1, jpjm1 - DO ji = 1, jpim1 - iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points - ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 -!!gm BUG ? when applied to before fields, e3w_b should be used.... - ze3wu = e3w_n(ji+1,jj ,iku) - e3w_n(ji,jj,iku) - ze3wv = e3w_n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv) - ! - ! i- direction - IF( ze3wu >= 0._wp ) THEN ! case 1 - zmaxu = ze3wu / e3w_n(ji+1,jj,iku) - ! interpolated values of tracers - zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) - ! gradient of tracers - pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) - ELSE ! case 2 - zmaxu = -ze3wu / e3w_n(ji,jj,iku) - ! interpolated values of tracers - zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) - ! gradient of tracers - pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) - ENDIF - ! - ! j- direction - IF( ze3wv >= 0._wp ) THEN ! case 1 - zmaxv = ze3wv / e3w_n(ji,jj+1,ikv) - ! interpolated values of tracers - ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) - ! gradient of tracers - pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) - ELSE ! case 2 - zmaxv = -ze3wv / e3w_n(ji,jj,ikv) - ! interpolated values of tracers - ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) - ! gradient of tracers - pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) - ENDIF - END DO - END DO - END DO - ! - CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. - ! - IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) - pgru(:,:) = 0._wp - pgrv(:,:) = 0._wp ! depth of the partial step level - DO jj = 1, jpjm1 - DO ji = 1, jpim1 - iku = mbku(ji,jj) - ikv = mbkv(ji,jj) - ze3wu = e3w_n(ji+1,jj ,iku) - e3w_n(ji,jj,iku) - ze3wv = e3w_n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv) - IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept_n(ji ,jj,iku) ! i-direction: case 1 - ELSE ; zhi(ji,jj) = gdept_n(ji+1,jj,iku) ! - - case 2 - ENDIF - IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept_n(ji,jj ,ikv) ! j-direction: case 1 - ELSE ; zhj(ji,jj) = gdept_n(ji,jj+1,ikv) ! - - case 2 - ENDIF - END DO - END DO - ! - CALL eos( zti, zhi, zri ) ! interpolated density from zti, ztj - CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj - ! - DO jj = 1, jpjm1 ! Gradient of density at the last level - DO ji = 1, jpim1 - iku = mbku(ji,jj) - ikv = mbkv(ji,jj) - ze3wu = e3w_n(ji+1,jj ,iku) - e3w_n(ji,jj,iku) - ze3wv = e3w_n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv) - IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 - ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 - ENDIF - IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 - ELSE ; pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 - ENDIF - END DO - END DO - CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions - ! - END IF - ! - IF( ln_timing ) CALL timing_stop( 'zps_hde') - ! - END SUBROUTINE zps_hde_exc - - - SUBROUTINE zps_hde_isf_sp( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi, & - & prd, pgru, pgrv, pgrui, pgrvi ) - !!---------------------------------------------------------------------- - !! *** ROUTINE zps_hde_isf *** - !! - !! ** Purpose : Compute the horizontal derivative of T, S and rho - !! at u- and v-points with a linear interpolation for z-coordinate - !! with partial steps for top (ice shelf) and bottom. - !! - !! ** Method : In z-coord with partial steps, scale factors on last - !! levels are different for each grid point, so that T, S and rd - !! points are not at the same depth as in z-coord. To have horizontal - !! gradients again, we interpolate T and S at the good depth : - !! For the bottom case: - !! Linear interpolation of T, S - !! Computation of di(tb) and dj(tb) by vertical interpolation: - !! di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~ - !! dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~ - !! This formulation computes the two cases: - !! CASE 1 CASE 2 - !! k-1 ___ ___________ k-1 ___ ___________ - !! Ti T~ T~ Ti+1 - !! _____ _____ - !! k | |Ti+1 k Ti | | - !! | |____ ____| | - !! ___ | | | ___ | | | - !! - !! case 1-> e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then - !! t~ = t(i+1,j ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1) - !! ( t~ = t(i ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1) ) - !! or - !! case 2-> e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then - !! t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i ) - !! ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) ) - !! Idem for di(s) and dj(s) - !! - !! For rho, we call eos which will compute rd~(t~,s~) at the right - !! depth zh from interpolated T and S for the different formulations - !! of the equation of state (eos). - !! Gradient formulation for rho : - !! di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~ - !! - !! For the top case (ice shelf): As for the bottom case but upside down - !! - !! ** Action : compute for top and bottom interfaces - !! - pgtu, pgtv, pgtui, pgtvi: horizontal gradient of tracer at u- & v-points - !! - pgru, pgrv, pgrui, pgtvi: horizontal gradient of rho (if present) at u- & v-points - !!---------------------------------------------------------------------- - INTEGER , INTENT(in ) :: kt ! ocean time-step index - INTEGER , INTENT(in ) :: kjpt ! number of tracers - REAL(sp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields - REAL(sp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts - REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) - REAL(sp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields - REAL(sp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) - REAL(sp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgrui - REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgrvi ! hor. grad of prd at u- & v-pts (top) - ! - INTEGER :: ji, jj, jn ! Dummy loop indices - INTEGER :: iku, ikv, ikum1, ikvm1,ikup1, ikvp1 ! partial step level (ocean bottom level) at u- and v-points - REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars - REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos - REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj ! - !!---------------------------------------------------------------------- - ! - IF( ln_timing ) CALL timing_start( 'zps_hde_isf') - ! - pgtu (:,:,:) = 0._wp ; pgtv (:,:,:) =0._wp - pgtui(:,:,:) = 0._wp ; pgtvi(:,:,:) =0._wp - zti (:,:,:) = 0._wp ; ztj (:,:,:) =0._wp - zhi (:,: ) = 0._wp ; zhj (:,: ) =0._wp - ! - DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! - ! - DO jj = 1, jpjm1 - DO ji = 1, jpim1 - - iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points - ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 - ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku) - ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv) - ! - ! i- direction - IF( ze3wu >= 0._wp ) THEN ! case 1 - zmaxu = ze3wu / e3w_n(ji+1,jj,iku) - ! interpolated values of tracers - zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) - ! gradient of tracers - pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) - ELSE ! case 2 - zmaxu = -ze3wu / e3w_n(ji,jj,iku) - ! interpolated values of tracers - zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) - ! gradient of tracers - pgtu(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) - ENDIF - ! - ! j- direction - IF( ze3wv >= 0._wp ) THEN ! case 1 - zmaxv = ze3wv / e3w_n(ji,jj+1,ikv) - ! interpolated values of tracers - ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) - ! gradient of tracers - pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) - ELSE ! case 2 - zmaxv = -ze3wv / e3w_n(ji,jj,ikv) - ! interpolated values of tracers - ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) - ! gradient of tracers - pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) - ENDIF - - END DO - END DO - END DO - ! - CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. - - ! horizontal derivative of density anomalies (rd) - IF( PRESENT( prd ) ) THEN ! depth of the partial step level - pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ; - ! - DO jj = 1, jpjm1 - DO ji = 1, jpim1 - - iku = mbku(ji,jj) - ikv = mbkv(ji,jj) - ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku) - ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv) - ! - IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept_n(ji ,jj,iku) ! i-direction: case 1 - ELSE ; zhi(ji,jj) = gdept_n(ji+1,jj,iku) ! - - case 2 - ENDIF - IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept_n(ji,jj ,ikv) ! j-direction: case 1 - ELSE ; zhj(ji,jj) = gdept_n(ji,jj+1,ikv) ! - - case 2 - ENDIF - - END DO - END DO - - ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial - ! step and store it in zri, zrj for each case - CALL eos( zti, zhi, zri ) - CALL eos( ztj, zhj, zrj ) - - DO jj = 1, jpjm1 ! Gradient of density at the last level - DO ji = 1, jpim1 - iku = mbku(ji,jj) - ikv = mbkv(ji,jj) - ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku) - ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv) - - IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 - ELSE ; pgru(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 - ENDIF - IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = ssvmask(ji,jj) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 - ELSE ; pgrv(ji,jj) = ssvmask(ji,jj) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 - ENDIF - - END DO - END DO - - CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp ) ! Lateral boundary conditions - ! - END IF - ! - ! !== (ISH) compute grui and gruvi ==! - ! - DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! ! - DO jj = 1, jpjm1 - DO ji = 1, jpim1 - iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 - ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 - ! - ! (ISF) case partial step top and bottom in adjacent cell in vertical - ! cannot used e3w because if 2 cell water column, we have ps at top and bottom - ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj - ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 - ze3wu = gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku) - ze3wv = gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) - - ! i- direction - IF( ze3wu >= 0._wp ) THEN ! case 1 - zmaxu = ze3wu / e3w_n(ji+1,jj,ikup1) - ! interpolated values of tracers - zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) ) - ! gradient of tracers - pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) - ELSE ! case 2 - zmaxu = - ze3wu / e3w_n(ji,jj,ikup1) - ! interpolated values of tracers - zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) ) - ! gradient of tracers - pgtui(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) - ENDIF - ! - ! j- direction - IF( ze3wv >= 0._wp ) THEN ! case 1 - zmaxv = ze3wv / e3w_n(ji,jj+1,ikvp1) - ! interpolated values of tracers - ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) ) - ! gradient of tracers - pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) - ELSE ! case 2 - zmaxv = - ze3wv / e3w_n(ji,jj,ikvp1) - ! interpolated values of tracers - ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) ) - ! gradient of tracers - pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) - ENDIF - - END DO - END DO - ! - END DO - CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. - - IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) - ! - pgrui(:,:) =0.0_wp; pgrvi(:,:) =0.0_wp; - DO jj = 1, jpjm1 - DO ji = 1, jpim1 - - iku = miku(ji,jj) - ikv = mikv(ji,jj) - ze3wu = gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku) - ze3wv = gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) - ! - IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept_n(ji ,jj,iku) ! i-direction: case 1 - ELSE ; zhi(ji,jj) = gdept_n(ji+1,jj,iku) ! - - case 2 - ENDIF - - IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept_n(ji,jj ,ikv) ! j-direction: case 1 - ELSE ; zhj(ji,jj) = gdept_n(ji,jj+1,ikv) ! - - case 2 - ENDIF - - END DO - END DO - ! - CALL eos( zti, zhi, zri ) ! interpolated density from zti, ztj - CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj - ! - DO jj = 1, jpjm1 ! Gradient of density at the last level - DO ji = 1, jpim1 - iku = miku(ji,jj) - ikv = mikv(ji,jj) - ze3wu = gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku) - ze3wv = gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) - - IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 - ELSE ; pgrui(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj ,iku) - zri(ji,jj ) ) ! i: 2 - ENDIF - IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( zrj(ji ,jj ) - prd(ji,jj,ikv) ) ! j: 1 - ELSE ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( prd(ji ,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 - ENDIF - - END DO - END DO - CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp ) ! Lateral boundary conditions - ! - END IF - ! - IF( ln_timing ) CALL timing_stop( 'zps_hde_isf') - ! - END SUBROUTINE zps_hde_isf_sp - - SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv, & - & prd, pgru, pgrv ) - !!---------------------------------------------------------------------- - !! *** ROUTINE zps_hde *** - !! - !! ** Purpose : Compute the horizontal derivative of T, S and rho - !! at u- and v-points with a linear interpolation for z-coordinate - !! with partial steps. - !! - !! ** Method : In z-coord with partial steps, scale factors on last - !! levels are different for each grid point, so that T, S and rd - !! points are not at the same depth as in z-coord. To have horizontal - !! gradients again, we interpolate T and S at the good depth : - !! Linear interpolation of T, S - !! Computation of di(tb) and dj(tb) by vertical interpolation: - !! di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~ - !! dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~ - !! This formulation computes the two cases: - !! CASE 1 CASE 2 - !! k-1 ___ ___________ k-1 ___ ___________ - !! Ti T~ T~ Ti+1 - !! _____ _____ - !! k | |Ti+1 k Ti | | - !! | |____ ____| | - !! ___ | | | ___ | | | - !! - !! case 1-> e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then - !! t~ = t(i+1,j ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1) - !! ( t~ = t(i ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1) ) - !! or - !! case 2-> e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then - !! t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i ) - !! ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) ) - !! Idem for di(s) and dj(s) - !! - !! For rho, we call eos which will compute rd~(t~,s~) at the right - !! depth zh from interpolated T and S for the different formulations - !! of the equation of state (eos). - !! Gradient formulation for rho : - !! di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~ - !! - !! ** Action : compute for top interfaces - !! - pgtu, pgtv: horizontal gradient of tracer at u- & v-points - !! - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points - !!---------------------------------------------------------------------- - INTEGER , INTENT(in ) :: kt ! ocean time-step index - INTEGER , INTENT(in ) :: kjpt ! number of tracers - REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields - REAL(dp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts - REAL(dp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields - REAL(dp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) - ! - INTEGER :: ji, jj, jn ! Dummy loop indices - INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points - REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! local scalars - REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos - REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj ! - !!---------------------------------------------------------------------- - ! - IF( ln_timing ) CALL timing_start( 'zps_hde') - ! - pgtu(:,:,:) = 0._wp ; zti (:,:,:) = 0._wp ; zhi (:,:) = 0._wp - pgtv(:,:,:) = 0._wp ; ztj (:,:,:) = 0._wp ; zhj (:,:) = 0._wp - ! - DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! - ! - DO jj = 1, jpjm1 - DO ji = 1, jpim1 - iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points - ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 -!!gm BUG ? when applied to before fields, e3w_b should be used.... - ze3wu = e3w_n(ji+1,jj ,iku) - e3w_n(ji,jj,iku) - ze3wv = e3w_n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv) - ! - ! i- direction - IF( ze3wu >= 0._wp ) THEN ! case 1 - zmaxu = ze3wu / e3w_n(ji+1,jj,iku) - ! interpolated values of tracers - zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) - ! gradient of tracers - pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) - ELSE ! case 2 - zmaxu = -ze3wu / e3w_n(ji,jj,iku) - ! interpolated values of tracers - zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) - ! gradient of tracers - pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) - ENDIF - ! - ! j- direction - IF( ze3wv >= 0._wp ) THEN ! case 1 - zmaxv = ze3wv / e3w_n(ji,jj+1,ikv) - ! interpolated values of tracers - ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) - ! gradient of tracers - pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) - ELSE ! case 2 - zmaxv = -ze3wv / e3w_n(ji,jj,ikv) - ! interpolated values of tracers - ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) - ! gradient of tracers - pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) - ENDIF - END DO - END DO - END DO - ! - CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_dp , pgtv(:,:,:), 'V', -1.0_dp ) ! Lateral boundary cond. - ! - IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) - pgru(:,:) = 0._wp - pgrv(:,:) = 0._wp ! depth of the partial step level - DO jj = 1, jpjm1 - DO ji = 1, jpim1 - iku = mbku(ji,jj) - ikv = mbkv(ji,jj) - ze3wu = e3w_n(ji+1,jj ,iku) - e3w_n(ji,jj,iku) - ze3wv = e3w_n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv) - IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept_n(ji ,jj,iku) ! i-direction: case 1 - ELSE ; zhi(ji,jj) = gdept_n(ji+1,jj,iku) ! - - case 2 - ENDIF - IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept_n(ji,jj ,ikv) ! j-direction: case 1 - ELSE ; zhj(ji,jj) = gdept_n(ji,jj+1,ikv) ! - - case 2 - ENDIF - END DO - END DO - ! - CALL eos( zti, zhi, zri ) ! interpolated density from zti, ztj - CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj - ! - DO jj = 1, jpjm1 ! Gradient of density at the last level - DO ji = 1, jpim1 - iku = mbku(ji,jj) - ikv = mbkv(ji,jj) - ze3wu = e3w_n(ji+1,jj ,iku) - e3w_n(ji,jj,iku) - ze3wv = e3w_n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv) - IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 - ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 - ENDIF - IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 - ELSE ; pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 - ENDIF - END DO - END DO - CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_dp , pgrv , 'V', -1.0_dp ) ! Lateral boundary conditions - ! - END IF - ! - IF( ln_timing ) CALL timing_stop( 'zps_hde') - ! - END SUBROUTINE zps_hde_dp - - - SUBROUTINE zps_hde_isf_dp( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi, & - & prd, pgru, pgrv, pgrui, pgrvi ) - !!---------------------------------------------------------------------- - !! *** ROUTINE zps_hde_isf *** - !! - !! ** Purpose : Compute the horizontal derivative of T, S and rho - !! at u- and v-points with a linear interpolation for z-coordinate - !! with partial steps for top (ice shelf) and bottom. - !! - !! ** Method : In z-coord with partial steps, scale factors on last - !! levels are different for each grid point, so that T, S and rd - !! points are not at the same depth as in z-coord. To have horizontal - !! gradients again, we interpolate T and S at the good depth : - !! For the bottom case: - !! Linear interpolation of T, S - !! Computation of di(tb) and dj(tb) by vertical interpolation: - !! di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~ - !! dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~ - !! This formulation computes the two cases: - !! CASE 1 CASE 2 - !! k-1 ___ ___________ k-1 ___ ___________ - !! Ti T~ T~ Ti+1 - !! _____ _____ - !! k | |Ti+1 k Ti | | - !! | |____ ____| | - !! ___ | | | ___ | | | - !! - !! case 1-> e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then - !! t~ = t(i+1,j ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1) - !! ( t~ = t(i ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1) ) - !! or - !! case 2-> e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then - !! t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i ) - !! ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) ) - !! Idem for di(s) and dj(s) - !! - !! For rho, we call eos which will compute rd~(t~,s~) at the right - !! depth zh from interpolated T and S for the different formulations - !! of the equation of state (eos). - !! Gradient formulation for rho : - !! di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~ - !! - !! For the top case (ice shelf): As for the bottom case but upside down - !! - !! ** Action : compute for top and bottom interfaces - !! - pgtu, pgtv, pgtui, pgtvi: horizontal gradient of tracer at u- & v-points - !! - pgru, pgrv, pgrui, pgtvi: horizontal gradient of rho (if present) at u- & v-points - !!---------------------------------------------------------------------- - INTEGER , INTENT(in ) :: kt ! ocean time-step index - INTEGER , INTENT(in ) :: kjpt ! number of tracers - REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields - REAL(dp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts - REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) - REAL(dp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields - REAL(dp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) - REAL(dp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgrui - REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgrvi ! hor. grad of prd at u- & v-pts (top) - ! - INTEGER :: ji, jj, jn ! Dummy loop indices - INTEGER :: iku, ikv, ikum1, ikvm1,ikup1, ikvp1 ! partial step level (ocean bottom level) at u- and v-points - REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars - REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos - REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj ! - !!---------------------------------------------------------------------- - ! - IF( ln_timing ) CALL timing_start( 'zps_hde_isf') - ! - pgtu (:,:,:) = 0._wp ; pgtv (:,:,:) =0._wp - pgtui(:,:,:) = 0._wp ; pgtvi(:,:,:) =0._wp - zti (:,:,:) = 0._wp ; ztj (:,:,:) =0._wp - zhi (:,: ) = 0._wp ; zhj (:,: ) =0._wp - ! - DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! - ! - DO jj = 1, jpjm1 - DO ji = 1, jpim1 - - iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points - ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 - ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku) - ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv) - ! - ! i- direction - IF( ze3wu >= 0._wp ) THEN ! case 1 - zmaxu = ze3wu / e3w_n(ji+1,jj,iku) - ! interpolated values of tracers - zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) - ! gradient of tracers - pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) - ELSE ! case 2 - zmaxu = -ze3wu / e3w_n(ji,jj,iku) - ! interpolated values of tracers - zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) - ! gradient of tracers - pgtu(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) - ENDIF - ! - ! j- direction - IF( ze3wv >= 0._wp ) THEN ! case 1 - zmaxv = ze3wv / e3w_n(ji,jj+1,ikv) - ! interpolated values of tracers - ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) - ! gradient of tracers - pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) - ELSE ! case 2 - zmaxv = -ze3wv / e3w_n(ji,jj,ikv) - ! interpolated values of tracers - ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) - ! gradient of tracers - pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) - ENDIF - - END DO - END DO - END DO - ! - CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_dp , pgtv(:,:,:), 'V', -1.0_dp ) ! Lateral boundary cond. - - ! horizontal derivative of density anomalies (rd) - IF( PRESENT( prd ) ) THEN ! depth of the partial step level - pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ; - ! - DO jj = 1, jpjm1 - DO ji = 1, jpim1 - - iku = mbku(ji,jj) - ikv = mbkv(ji,jj) - ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku) - ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv) - ! - IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept_n(ji ,jj,iku) ! i-direction: case 1 - ELSE ; zhi(ji,jj) = gdept_n(ji+1,jj,iku) ! - - case 2 - ENDIF - IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept_n(ji,jj ,ikv) ! j-direction: case 1 - ELSE ; zhj(ji,jj) = gdept_n(ji,jj+1,ikv) ! - - case 2 - ENDIF - - END DO - END DO - - ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial - ! step and store it in zri, zrj for each case - CALL eos( zti, zhi, zri ) - CALL eos( ztj, zhj, zrj ) - - DO jj = 1, jpjm1 ! Gradient of density at the last level - DO ji = 1, jpim1 - iku = mbku(ji,jj) - ikv = mbkv(ji,jj) - ze3wu = gdept_n(ji+1,jj,iku) - gdept_n(ji,jj,iku) - ze3wv = gdept_n(ji,jj+1,ikv) - gdept_n(ji,jj,ikv) - - IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 - ELSE ; pgru(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 - ENDIF - IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = ssvmask(ji,jj) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 - ELSE ; pgrv(ji,jj) = ssvmask(ji,jj) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 - ENDIF - - END DO - END DO - - CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_dp , pgrv , 'V', -1.0_dp ) ! Lateral boundary conditions - ! - END IF - ! - ! !== (ISH) compute grui and gruvi ==! - ! - DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! ! - DO jj = 1, jpjm1 - DO ji = 1, jpim1 - iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 - ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 - ! - ! (ISF) case partial step top and bottom in adjacent cell in vertical - ! cannot used e3w because if 2 cell water column, we have ps at top and bottom - ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj - ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 - ze3wu = gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku) - ze3wv = gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) - - ! i- direction - IF( ze3wu >= 0._wp ) THEN ! case 1 - zmaxu = ze3wu / e3w_n(ji+1,jj,ikup1) - ! interpolated values of tracers - zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) ) - ! gradient of tracers - pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) - ELSE ! case 2 - zmaxu = - ze3wu / e3w_n(ji,jj,ikup1) - ! interpolated values of tracers - zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) ) - ! gradient of tracers - pgtui(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) - ENDIF - ! - ! j- direction - IF( ze3wv >= 0._wp ) THEN ! case 1 - zmaxv = ze3wv / e3w_n(ji,jj+1,ikvp1) - ! interpolated values of tracers - ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) ) - ! gradient of tracers - pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) - ELSE ! case 2 - zmaxv = - ze3wv / e3w_n(ji,jj,ikvp1) - ! interpolated values of tracers - ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) ) - ! gradient of tracers - pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) - ENDIF - - END DO - END DO - ! - END DO - CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp ) ! Lateral boundary cond. - - IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) - ! - pgrui(:,:) =0.0_wp; pgrvi(:,:) =0.0_wp; - DO jj = 1, jpjm1 - DO ji = 1, jpim1 - - iku = miku(ji,jj) - ikv = mikv(ji,jj) - ze3wu = gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku) - ze3wv = gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) - ! - IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept_n(ji ,jj,iku) ! i-direction: case 1 - ELSE ; zhi(ji,jj) = gdept_n(ji+1,jj,iku) ! - - case 2 - ENDIF - - IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept_n(ji,jj ,ikv) ! j-direction: case 1 - ELSE ; zhj(ji,jj) = gdept_n(ji,jj+1,ikv) ! - - case 2 - ENDIF - - END DO - END DO - ! - CALL eos( zti, zhi, zri ) ! interpolated density from zti, ztj - CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj - ! - DO jj = 1, jpjm1 ! Gradient of density at the last level - DO ji = 1, jpim1 - iku = miku(ji,jj) - ikv = mikv(ji,jj) - ze3wu = gdept_n(ji,jj,iku) - gdept_n(ji+1,jj,iku) - ze3wv = gdept_n(ji,jj,ikv) - gdept_n(ji,jj+1,ikv) - - IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 - ELSE ; pgrui(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj ,iku) - zri(ji,jj ) ) ! i: 2 - ENDIF - IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( zrj(ji ,jj ) - prd(ji,jj,ikv) ) ! j: 1 - ELSE ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( prd(ji ,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 - ENDIF - - END DO - END DO - CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_dp ) - CALL lbc_lnk_multi( 'zpshde', pgrvi, 'V', -1.0_wp ) ! Lateral boundary conditions - ! - END IF - ! - IF( ln_timing ) CALL timing_stop( 'zps_hde_isf') - ! - END SUBROUTINE zps_hde_isf_dp - - !!====================================================================== -END MODULE zpshde \ No newline at end of file -- GitLab From 8a85042269eb655bfd74fffd58813c1249482f9c Mon Sep 17 00:00:00 2001 From: omichel Date: Mon, 30 Oct 2023 10:23:41 +0100 Subject: [PATCH 4/5] Fixed small compilation issues --- V4.0/nemo_sources/src/OCE/ICB/icbrst.F90 | 2 +- V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 | 4 ++-- V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare.F90 | 2 +- V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare3p5.F90 | 2 +- V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 | 2 +- 5 files changed, 6 insertions(+), 6 deletions(-) diff --git a/V4.0/nemo_sources/src/OCE/ICB/icbrst.F90 b/V4.0/nemo_sources/src/OCE/ICB/icbrst.F90 index 838d94b..1dbb3ac 100644 --- a/V4.0/nemo_sources/src/OCE/ICB/icbrst.F90 +++ b/V4.0/nemo_sources/src/OCE/ICB/icbrst.F90 @@ -504,4 +504,4 @@ CONTAINS END SUBROUTINE icb_rst_write ! !!====================================================================== -END MODULE icbrst \ No newline at end of file +END MODULE icbrst diff --git a/V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 b/V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 index e2f6551..c0e4cb5 100644 --- a/V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 +++ b/V4.0/nemo_sources/src/OCE/OBS/obs_prep.F90 @@ -1141,11 +1141,11 @@ CONTAINS & pobsphi REAL(KIND=wp), DIMENSION(kobsno), INTENT(INOUT) :: & & pobsdep ! Observation depths - REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: & + REAL(KIND=dp), DIMENSION(kpi,kpj), INTENT(IN) :: & & plam, pphi ! Model (lon,lat) coordinates REAL(KIND=wp), DIMENSION(kpk), INTENT(IN) :: & & pdep ! Model depth coordinates - REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) :: & + REAL(KIND=dp), DIMENSION(kpi,kpj,kpk), INTENT(IN) :: & & pmask ! Land mask array INTEGER, DIMENSION(kprofno), INTENT(INOUT) :: & & kpobsqc ! Profile quality control diff --git a/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare.F90 index 647035b..b886585 100644 --- a/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare.F90 +++ b/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare.F90 @@ -297,7 +297,7 @@ CONTAINS !!------------------------------------------------------------------------ REAL(wp), DIMENSION(jpi,jpj) :: One_on_L !: 1./(Monin Obukhov length) [m^-1] REAL(dp), DIMENSION(jpi,jpj), INTENT(in) :: ptha, & !: average potetntial air temperature [K] - & pqa, & !: average specific humidity of air [kg/kg] + & pqa !: average specific humidity of air [kg/kg] REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus, pts, pqs !: frictional velocity, temperature and humidity ! diff --git a/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare3p5.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare3p5.F90 index 217272c..49b645e 100644 --- a/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare3p5.F90 +++ b/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare3p5.F90 @@ -268,7 +268,7 @@ CONTAINS !!------------------------------------------------------------------------ REAL(wp), DIMENSION(jpi,jpj) :: One_on_L !: 1./(Monin Obukhov length) [m^-1] REAL(dp), DIMENSION(jpi,jpj), INTENT(in) :: ptha, & !: average potetntial air temperature [K] - & pqa, & !: average specific humidity of air [kg/kg] + & pqa !: average specific humidity of air [kg/kg] REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pus, pts, pqs !: frictional velocity, temperature and humidity ! INTEGER :: ji, jj ! dummy loop indices diff --git a/V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 b/V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 index 9c796d5..35b14e3 100644 --- a/V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 +++ b/V4.0/nemo_sources/src/OCE/TRA/traadv_fct.F90 @@ -87,7 +87,7 @@ CONTAINS INTEGER :: ji, jj, jk, jn ! dummy loop indices INTEGER :: jj1, jj2, itid, ithreads ! OpenMP variables REAL(dp) :: ztra ! local scalar - REAL(wp) :: zfp_ui, zfp_vj, zC2t_u, zC4t_ui ! - - + REAL(wp) :: zfp_ui, zfp_vj, zC2t_u, zC4t_u ! - - REAL(dp) :: zfp_wk ! - - REAL(wp) :: zC2t_v ! - - REAL(dp) :: zfm_ui, zfm_vj, zfm_wk, zC4t_v ! - - -- GitLab From c82a414a0aa0cee27945ac95e915275d92a7d7e3 Mon Sep 17 00:00:00 2001 From: omichel Date: Tue, 31 Oct 2023 09:18:01 +0100 Subject: [PATCH 5/5] Fixed performance issue with icedyn routine --- V4.0/nemo_sources/src/ICE/icedyn_adv_pra.F90 | 80 ++++++++++---------- 1 file changed, 40 insertions(+), 40 deletions(-) diff --git a/V4.0/nemo_sources/src/ICE/icedyn_adv_pra.F90 b/V4.0/nemo_sources/src/ICE/icedyn_adv_pra.F90 index f55a8f2..9bb38f2 100644 --- a/V4.0/nemo_sources/src/ICE/icedyn_adv_pra.F90 +++ b/V4.0/nemo_sources/src/ICE/icedyn_adv_pra.F90 @@ -453,13 +453,13 @@ CONTAINS zpsxy = psxy(ji,jj,jl) ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) - zpsm = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * zpsm , epsi20 ) + zpsm = MAX( pcrh * e1e2t(ji,jj) + ( 1.0_wp - pcrh ) * zpsm , epsi20 ) ! zslpmax = MAX( 0._wp, zps0 ) - zs1max = 1.5 * zslpmax + zs1max = 1.5_wp * zslpmax zs1new = MIN( zs1max, MAX( -zs1max, zpsx ) ) - zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), MAX( ABS( zs1new ) - zslpmax, zpsxx ) ) - rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask + zs2new = MIN( 2.0_wp * zslpmax - 0.3334_wp * ABS( zs1new ), MAX( ABS( zs1new ) - zslpmax, zpsxx ) ) + rswitch = ( 1.0_wp - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask zps0 = zslpmax zpsx = zs1new * rswitch @@ -473,12 +473,12 @@ CONTAINS zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) zalf = MAX( 0._wp, put(ji,jj) ) * pdt / zpsm zalfq = zalf * zalf - zalf1 = 1.0 - zalf + zalf1 = 1.0_wp - zalf zalf1q = zalf1 * zalf1 ! zfm (ji,jj) = zalf * zpsm zf0 (ji,jj) = zalf * ( zps0 + zalf1 * ( zpsx + (zalf1 - zalf) * zpsxx ) ) - zfx (ji,jj) = zalfq * ( zpsx + 3.0 * zalf1 * zpsxx ) + zfx (ji,jj) = zalfq * ( zpsx + 3.0_wp * zalf1 * zpsxx ) zfxx(ji,jj) = zalf * zpsxx * zalfq zfy (ji,jj) = zalf * ( zpsy + zalf1 * zpsxy ) zfxy(ji,jj) = zalfq * zpsxy @@ -487,7 +487,7 @@ CONTAINS ! ! Readjust moments remaining in the box. zpsm = zpsm - zfm(ji,jj) zps0 = zps0 - zf0(ji,jj) - zpsx = zalf1q * ( zpsx - 3.0 * zalf * zpsxx ) + zpsx = zalf1q * ( zpsx - 3.0_wp * zalf * zpsxx ) zpsxx = zalf1 * zalf1q * zpsxx zpsy = zpsy - zfy (ji,jj) zpsyy = zpsyy - zfyy(ji,jj) @@ -508,7 +508,7 @@ CONTAINS zalf = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) zalg (ji,jj) = zalf zalfq = zalf * zalf - zalf1 = 1.0 - zalf + zalf1 = 1.0_wp - zalf zalg1 (ji,jj) = zalf1 zalf1q = zalf1 * zalf1 zalg1q(ji,jj) = zalf1q @@ -516,7 +516,7 @@ CONTAINS zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji+1,jj,jl) zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji+1,jj,jl) & & - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) ) - zfx (ji,jj) = zfx (ji,jj) + zalfq * ( psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) ) + zfx (ji,jj) = zfx (ji,jj) + zalfq * ( psx (ji+1,jj,jl) - 3.0_wp * zalf1 * psxx(ji+1,jj,jl) ) zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji+1,jj,jl) * zalfq zfy (ji,jj) = zfy (ji,jj) + zalf * ( psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) ) zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji+1,jj,jl) @@ -538,7 +538,7 @@ CONTAINS ! zpsm = zbt * zpsm + zbt1 * ( zpsm - zfm(ji-1,jj) ) zps0 = zbt * zps0 + zbt1 * ( zps0 - zf0(ji-1,jj) ) - zpsx = zalg1q(ji-1,jj) * ( zpsx + 3.0 * zalg(ji-1,jj) * zpsxx ) + zpsx = zalg1q(ji-1,jj) * ( zpsx + 3.0_wp * zalg(ji-1,jj) * zpsxx ) zpsxx = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * zpsxx zpsy = zbt * zpsy + zbt1 * ( zpsy - zfy (ji-1,jj) ) zpsyy = zbt * zpsyy + zbt1 * ( zpsyy - zfyy(ji-1,jj) ) @@ -547,38 +547,38 @@ CONTAINS ! Put the temporary moments into appropriate neighboring boxes. ! ! Flux from i to i+1 IF u GT 0. zbt = zbet(ji-1,jj) - zbt1 = 1.0 - zbet(ji-1,jj) + zbt1 = 1.0_wp - zbet(ji-1,jj) zpsm = zbt * ( zpsm + zfm(ji-1,jj) ) + zbt1 * zpsm zalf = zbt * zfm(ji-1,jj) / zpsm - zalf1 = 1.0 - zalf + zalf1 = 1.0_wp - zalf ztemp = zalf * zps0 - zalf1 * zf0(ji-1,jj) ! zps0 = zbt * ( zps0 + zf0(ji-1,jj) ) + zbt1 * zps0 - zpsx = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * zpsx + 3.0 * ztemp ) + zbt1 * zpsx + zpsx = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * zpsx + 3.0_wp * ztemp ) + zbt1 * zpsx zpsxx = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * zpsxx & - & + 5.0 * ( zalf * zalf1 * ( zpsx - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp ) ) & + & + 5.0_wp * ( zalf * zalf1 * ( zpsx - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp ) ) & & + zbt1 * zpsxx zpsxy = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * zpsxy & - & + 3.0 * (- zalf1*zfy(ji-1,jj) + zalf * zpsy ) ) & + & + 3.0_wp * (- zalf1*zfy(ji-1,jj) + zalf * zpsy ) ) & & + zbt1 * zpsxy zpsy = zbt * ( zpsy + zfy (ji-1,jj) ) + zbt1 * zpsy zpsyy = zbt * ( zpsyy + zfyy(ji-1,jj) ) + zbt1 * zpsyy ! ! Flux from i+1 to i IF u LT 0. zbt = zbet(ji,jj) - zbt1 = 1.0 - zbet(ji,jj) + zbt1 = 1.0_wp - zbet(ji,jj) zpsm = zbt * zpsm + zbt1 * ( zpsm + zfm(ji,jj) ) zalf = zbt1 * zfm(ji,jj) / zpsm - zalf1 = 1.0 - zalf + zalf1 = 1.0_wp - zalf ztemp = - zalf * zps0 + zalf1 * zf0(ji,jj) ! zps0 = zbt * zps0 + zbt1 * ( zps0 + zf0(ji,jj) ) - zpsx = zbt * zpsx + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * zpsx + 3.0 * ztemp ) + zpsx = zbt * zpsx + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * zpsx + 3.0_wp * ztemp ) zpsxx = zbt * zpsxx + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * zpsxx & - & + 5.0 * ( zalf * zalf1 * ( - zpsx + zfx(ji,jj) ) & + & + 5.0_wp * ( zalf * zalf1 * ( - zpsx + zfx(ji,jj) ) & & + ( zalf1 - zalf ) * ztemp ) ) zpsxy = zbt * zpsxy + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * zpsxy & - & + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * zpsy ) ) + & + 3.0_wp * ( zalf1 * zfy(ji,jj) - zalf * zpsy ) ) zpsy = zbt * zpsy + zbt1 * ( zpsy + zfy (ji,jj) ) zpsyy = zbt * zpsyy + zbt1 * ( zpsyy + zfyy(ji,jj) ) ! @@ -658,13 +658,13 @@ CONTAINS zpsxy = psxy(ji,jj,jl) ! ! Initialize volumes of boxes (=area if adv_y first called, =psm otherwise) - zpsm = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * zpsm , epsi20 ) + zpsm = MAX( pcrh * e1e2t(ji,jj) + ( 1.0_wp - pcrh ) * zpsm , epsi20 ) ! zslpmax = MAX( 0._wp, zps0 ) - zs1max = 1.5 * zslpmax + zs1max = 1.5_wp * zslpmax zs1new = MIN( zs1max, MAX( -zs1max, zpsy ) ) - zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), MAX( ABS( zs1new )-zslpmax, zpsyy ) ) - rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask + zs2new = MIN( ( 2.0_wp * zslpmax - 0.3334_wp * ABS( zs1new ) ), MAX( ABS( zs1new )-zslpmax, zpsyy ) ) + rswitch = ( 1.0_wp - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask ! zps0 = zslpmax zpsx = zpsx * rswitch @@ -678,12 +678,12 @@ CONTAINS zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) zalf = MAX( 0._wp, pvt(ji,jj) ) * pdt / zpsm zalfq = zalf * zalf - zalf1 = 1.0 - zalf + zalf1 = 1.0_wp - zalf zalf1q = zalf1 * zalf1 ! zfm (ji,jj) = zalf * zpsm zf0 (ji,jj) = zalf * ( zps0 + zalf1 * ( zpsy + (zalf1-zalf) * zpsyy ) ) - zfy (ji,jj) = zalfq *( zpsy + 3.0*zalf1*zpsyy ) + zfy (ji,jj) = zalfq *( zpsy + 3.0_wp*zalf1*zpsyy ) zfyy(ji,jj) = zalf * zalfq * zpsyy zfx (ji,jj) = zalf * ( zpsx + zalf1 * zpsxy ) zfxy(ji,jj) = zalfq * zpsxy @@ -692,7 +692,7 @@ CONTAINS ! ! Readjust moments remaining in the box. zpsm = zpsm - zfm(ji,jj) zps0 = zps0 - zf0(ji,jj) - zpsy = zalf1q * ( zpsy -3.0 * zalf * zpsyy ) + zpsy = zalf1q * ( zpsy -3.0_wp * zalf * zpsyy ) zpsyy = zalf1 * zalf1q * zpsyy zpsx = zpsx - zfx(ji,jj) zpsxx = zpsxx - zfxx(ji,jj) @@ -716,7 +716,7 @@ CONTAINS zalf = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) zalg (ji,jj) = zalf zalfq = zalf * zalf - zalf1 = 1.0 - zalf + zalf1 = 1.0_wp - zalf zalg1 (ji,jj) = zalf1 zalf1q = zalf1 * zalf1 zalg1q(ji,jj) = zalf1q @@ -724,7 +724,7 @@ CONTAINS zfm (ji,jj) = zfm (ji,jj) + zalf * psm (ji,jj+1,jl) zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0 (ji,jj+1,jl) & & - zalf1 * (psy(ji,jj+1,jl) - (zalf1 - zalf ) * psyy(ji,jj+1,jl) ) ) - zfy (ji,jj) = zfy (ji,jj) + zalfq * ( psy (ji,jj+1,jl) - 3.0 * zalf1 * psyy(ji,jj+1,jl) ) + zfy (ji,jj) = zfy (ji,jj) + zalfq * ( psy (ji,jj+1,jl) - 3.0_wp * zalf1 * psyy(ji,jj+1,jl) ) zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji,jj+1,jl) * zalfq zfx (ji,jj) = zfx (ji,jj) + zalf * ( psx (ji,jj+1,jl) - zalf1 * psxy(ji,jj+1,jl) ) zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji,jj+1,jl) @@ -738,7 +738,7 @@ CONTAINS DO ji = jimin, jimax ! ! Readjust moments remaining in the box. zbt = zbet(ji,jj-1) - zbt1 = ( 1.0 - zbet(ji,jj-1) ) + zbt1 = ( 1.0_wp - zbet(ji,jj-1) ) ! zpsm = psm (ji,jj,jl) ! optimization zps0 = ps0 (ji,jj,jl) @@ -750,7 +750,7 @@ CONTAINS ! zpsm = zbt * zpsm + zbt1 * ( zpsm - zfm(ji,jj-1) ) zps0 = zbt * zps0 + zbt1 * ( zps0 - zf0(ji,jj-1) ) - zpsy = zalg1q(ji,jj-1) * ( zpsy + 3.0 * zalg(ji,jj-1) * zpsyy ) + zpsy = zalg1q(ji,jj-1) * ( zpsy + 3.0_wp * zalg(ji,jj-1) * zpsyy ) zpsyy = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * zpsyy zpsx = zbt * zpsx + zbt1 * ( zpsx - zfx (ji,jj-1) ) zpsxx = zbt * zpsxx + zbt1 * ( zpsxx - zfxx(ji,jj-1) ) @@ -759,39 +759,39 @@ CONTAINS ! Put the temporary moments into appropriate neighboring boxes. ! ! Flux from j to j+1 IF v GT 0. zbt = zbet(ji,jj-1) - zbt1 = 1.0 - zbet(ji,jj-1) + zbt1 = 1.0_wp - zbet(ji,jj-1) zpsm = zbt * ( zpsm + zfm(ji,jj-1) ) + zbt1 * zpsm zalf = zbt * zfm(ji,jj-1) / zpsm - zalf1 = 1.0 - zalf + zalf1 = 1.0_wp - zalf ztemp = zalf * zps0 - zalf1 * zf0(ji,jj-1) ! zps0 = zbt * ( zps0 + zf0(ji,jj-1) ) + zbt1 * zps0 zpsy = zbt * ( zalf * zfy(ji,jj-1) + zalf1 * zpsy + 3.0 * ztemp ) & & + zbt1 * zpsy zpsyy = zbt * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * zpsyy & - & + 5.0 * ( zalf * zalf1 * ( zpsy - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & + & + 5.0_wp * ( zalf * zalf1 * ( zpsy - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & & + zbt1 * zpsyy zpsxy = zbt * ( zalf * zfxy(ji,jj-1) + zalf1 * zpsxy & - & + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * zpsx ) ) & + & + 3.0_wp * (- zalf1 * zfx(ji,jj-1) + zalf * zpsx ) ) & & + zbt1 * zpsxy zpsx = zbt * ( zpsx + zfx (ji,jj-1) ) + zbt1 * zpsx zpsxx = zbt * ( zpsxx + zfxx(ji,jj-1) ) + zbt1 * zpsxx ! ! Flux from j+1 to j IF v LT 0. zbt = zbet(ji,jj) - zbt1 = 1.0 - zbet(ji,jj) + zbt1 = 1.0_wp - zbet(ji,jj) zpsm = zbt * zpsm + zbt1 * ( zpsm + zfm(ji,jj) ) zalf = zbt1 * zfm(ji,jj) / zpsm - zalf1 = 1.0 - zalf + zalf1 = 1.0_wp - zalf ztemp = - zalf * zps0 + zalf1 * zf0(ji,jj) ! zps0 = zbt * zps0 + zbt1 * ( zps0 + zf0(ji,jj) ) - zpsy = zbt * zpsy + zbt1 * ( zalf * zfy(ji,jj) + zalf1 * zpsy + 3.0 * ztemp ) + zpsy = zbt * zpsy + zbt1 * ( zalf * zfy(ji,jj) + zalf1 * zpsy + 3.0_wp * ztemp ) zpsyy = zbt * zpsyy + zbt1 * ( zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * zpsyy & - & + 5.0 * ( zalf * zalf1 * ( - zpsy + zfy(ji,jj) ) & + & + 5.0_wp * ( zalf * zalf1 * ( - zpsy + zfy(ji,jj) ) & & + ( zalf1 - zalf ) * ztemp ) ) zpsxy = zbt * zpsxy + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * zpsxy & - & + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * zpsx ) ) + & + 3.0_wp * ( zalf1 * zfx(ji,jj) - zalf * zpsx ) ) zpsx = zbt * zpsx + zbt1 * ( zpsx + zfx (ji,jj) ) zpsxx = zbt * zpsxx + zbt1 * ( zpsxx + zfxx(ji,jj) ) ! -- GitLab