diff --git a/V4.0/nemo_sources/src/ICE/ice.F90 b/V4.0/nemo_sources/src/ICE/ice.F90 index fcc77b58ecc1a7d7f68f3167b0554ef363456c74..87e8aad90f58f7f0fbc2a891fd9dfaa5138ece48 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/ice.mod b/V4.0/nemo_sources/src/ICE/ice.mod deleted file mode 100644 index 6c96b8a023144ceec34d83686bac0090e1a2cc99..0000000000000000000000000000000000000000 Binary files a/V4.0/nemo_sources/src/ICE/ice.mod and /dev/null differ 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 Binary files a/V4.0/nemo_sources/src/ICE/icecor.mod and /dev/null differ diff --git a/V4.0/nemo_sources/src/ICE/icectl.F90 b/V4.0/nemo_sources/src/ICE/icectl.F90 index ee7ac2ad9879138c5976acb487764131bcad08a8..1ce45aa052f9d461dd64e15edd75f71dad7ac87e 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 -- ! @@ -902,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/icectl.mod b/V4.0/nemo_sources/src/ICE/icectl.mod deleted file mode 100644 index bc6349fae400df487199e0c0db1bba7fe8495574..0000000000000000000000000000000000000000 Binary files a/V4.0/nemo_sources/src/ICE/icectl.mod and /dev/null differ diff --git a/V4.0/nemo_sources/src/ICE/icedia.F90 b/V4.0/nemo_sources/src/ICE/icedia.F90 index d24b685f1ea62a879ca8935f9c6df0691e57137f..a2a542ec898d50aea1822fe3c4f22f877864da93 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/icedia.mod b/V4.0/nemo_sources/src/ICE/icedia.mod deleted file mode 100644 index 327bb294fd42e1422e5b577b3c4e07b2779266f8..0000000000000000000000000000000000000000 Binary files a/V4.0/nemo_sources/src/ICE/icedia.mod and /dev/null differ 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 Binary files a/V4.0/nemo_sources/src/ICE/icedyn.mod and /dev/null differ 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 Binary files a/V4.0/nemo_sources/src/ICE/icedyn_adv.mod and /dev/null differ 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 61ac0861fcd622379a9d7f76290e6987d36a78f9..9bb38f26d1279189f04195335c2b7827bf0c1c5b 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 @@ -457,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 @@ -477,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 @@ -491,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) @@ -512,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 @@ -520,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) @@ -542,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) ) @@ -551,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) ) ! @@ -662,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 @@ -682,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 @@ -696,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) @@ -720,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 @@ -728,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) @@ -742,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) @@ -754,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) ) @@ -763,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) ) ! @@ -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_adv_pra.mod b/V4.0/nemo_sources/src/ICE/icedyn_adv_pra.mod deleted file mode 100644 index e198d8eb09060e15dc1f2e080eb2bd3a8d5fcf07..0000000000000000000000000000000000000000 Binary files a/V4.0/nemo_sources/src/ICE/icedyn_adv_pra.mod and /dev/null differ 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 Binary files a/V4.0/nemo_sources/src/ICE/icedyn_adv_umx.mod and /dev/null differ 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 Binary files a/V4.0/nemo_sources/src/ICE/icedyn_rdgrft.mod and /dev/null differ diff --git a/V4.0/nemo_sources/src/ICE/icedyn_rhg.F90 b/V4.0/nemo_sources/src/ICE/icedyn_rhg.F90 index 6f2141d487f55ebd0cc0528e0d12e74b98df701d..4864df443b11df37bb4e6750e3c078f1a8b5e790 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/ICE/icedyn_rhg.mod b/V4.0/nemo_sources/src/ICE/icedyn_rhg.mod deleted file mode 100644 index 1f9fe7979e2bb6a8652c90171dd84162f0ae8147..0000000000000000000000000000000000000000 Binary files a/V4.0/nemo_sources/src/ICE/icedyn_rhg.mod and /dev/null differ 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 a8c0136c0656b7dbd5accffd42c35a0bb3783439..9e3687662682ae8e581e1841224a78d7c4ed95c1 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/icedyn_rhg_evp.mod b/V4.0/nemo_sources/src/ICE/icedyn_rhg_evp.mod deleted file mode 100644 index fa8d57a22910c98096acff871566648b0b3e5070..0000000000000000000000000000000000000000 Binary files a/V4.0/nemo_sources/src/ICE/icedyn_rhg_evp.mod and /dev/null differ 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 Binary files a/V4.0/nemo_sources/src/ICE/iceistate.mod and /dev/null differ diff --git a/V4.0/nemo_sources/src/ICE/iceitd.mod b/V4.0/nemo_sources/src/ICE/iceitd.mod deleted file mode 100644 index cf4161aed2a1def37d763c06c5e5c64fff9fa5ae..0000000000000000000000000000000000000000 Binary files a/V4.0/nemo_sources/src/ICE/iceitd.mod and /dev/null differ 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 Binary files a/V4.0/nemo_sources/src/ICE/icerst.mod and /dev/null differ diff --git a/V4.0/nemo_sources/src/ICE/icesbc.mod b/V4.0/nemo_sources/src/ICE/icesbc.mod deleted file mode 100644 index fb8a501716372090d233ab4dd9cf18b20ba00549..0000000000000000000000000000000000000000 Binary files a/V4.0/nemo_sources/src/ICE/icesbc.mod and /dev/null differ diff --git a/V4.0/nemo_sources/src/ICE/icestp.mod b/V4.0/nemo_sources/src/ICE/icestp.mod deleted file mode 100644 index 6169a359e51e360e66f5857fb2e1a36696183507..0000000000000000000000000000000000000000 Binary files a/V4.0/nemo_sources/src/ICE/icestp.mod and /dev/null differ 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 Binary files a/V4.0/nemo_sources/src/ICE/icethd.mod and /dev/null differ 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 Binary files a/V4.0/nemo_sources/src/ICE/icethd_da.mod and /dev/null differ diff --git a/V4.0/nemo_sources/src/ICE/icethd_dh.mod b/V4.0/nemo_sources/src/ICE/icethd_dh.mod deleted file mode 100644 index e3d693d7e22bcf98dec595a9df5316b25bcbe58b..0000000000000000000000000000000000000000 Binary files a/V4.0/nemo_sources/src/ICE/icethd_dh.mod and /dev/null differ diff --git a/V4.0/nemo_sources/src/ICE/icethd_do.mod b/V4.0/nemo_sources/src/ICE/icethd_do.mod deleted file mode 100644 index 46bc87b80cc6e3866efd76b932e237d030bd6453..0000000000000000000000000000000000000000 Binary files a/V4.0/nemo_sources/src/ICE/icethd_do.mod and /dev/null differ diff --git a/V4.0/nemo_sources/src/ICE/icethd_pnd.mod b/V4.0/nemo_sources/src/ICE/icethd_pnd.mod deleted file mode 100644 index 4777650e9bcd3189c75d8390289ba00ff9130439..0000000000000000000000000000000000000000 Binary files a/V4.0/nemo_sources/src/ICE/icethd_pnd.mod and /dev/null differ 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 Binary files a/V4.0/nemo_sources/src/ICE/icethd_sal.mod and /dev/null differ 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 Binary files a/V4.0/nemo_sources/src/ICE/icethd_zdf.mod and /dev/null differ 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 Binary files a/V4.0/nemo_sources/src/ICE/icethd_zdf_bl99.mod and /dev/null differ 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 Binary files a/V4.0/nemo_sources/src/ICE/iceupdate.mod and /dev/null differ diff --git a/V4.0/nemo_sources/src/ICE/icevar.F90 b/V4.0/nemo_sources/src/ICE/icevar.F90 index 3d6a3610285882a3f35025ae5905087394e9fed2..cf5a76724290d8345ba2fa5da40eb18a6ff0ccd5 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/ICE/icevar.mod b/V4.0/nemo_sources/src/ICE/icevar.mod deleted file mode 100644 index d58a04d57551cd41aadf5d12b93eccdda8a703ae..0000000000000000000000000000000000000000 Binary files a/V4.0/nemo_sources/src/ICE/icevar.mod and /dev/null differ 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 Binary files a/V4.0/nemo_sources/src/ICE/icewri.mod and /dev/null differ diff --git a/V4.0/nemo_sources/src/OCE/ASM/bias.F90 b/V4.0/nemo_sources/src/OCE/ASM/bias.F90 index 3ac2a17d475a7d3a7f054e0fa1374010bee9b95b..5e63e100206663ed44c81ca4b35dc25ff03b4b7c 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 99d58ae0f1abc0dc840c111fcfafaaa9843203f6..fd115dbf6ed8f093c29a1c73879665f8ae345a72 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 870813d870770af2c60f4f005e6cf95532817195..c48bec8a89738fe5be31e52e374ae204619b5996 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 d2305ac3b8f46db21076857ffa9553dc4ed36c7b..be8600b9c43371af7516be5eb3408408b01fe33e 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 230836cc4233302e66d22e5f83413ddc7a1cdd4d..7dd2de21a8a0a5d31ee7ef783749ba2025b07834 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 6c0d2c5a22f321c1f3a2fb14d256bb753a1ce1c0..5854508f96a21ee384a86d00a52b6ebeb3af68aa 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 aef933d8567877e89c4d907b4349ba63cb7a5c3c..f2e169358aa99cdd975783d1fb3fcb6d0d3de511 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 ed6b138751847b5d953744c7e2c797d81dbe418e..e859c366c76e051af18180a1341cc7cebbe6a81e 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 9f6080d50a511ba055b454218375526b8fa781c0..5cf82e0783621f2e758c60de7cebe5adebcbc54d 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 7cd9c7c9661e23c03c61cf0298ceb470264d9e2c..84753948d3ff28fd19e58eba112e32b417d8a686 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 bae5f77aa13d630f3b323aa7c0a5a0c58ab90075..307601e2884b9088988c7def58b6861c9503683c 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/icbrst.F90 b/V4.0/nemo_sources/src/OCE/ICB/icbrst.F90 index 838d94b59a0c5eab331b2491b6fdcae3e71ca0d7..1dbb3aca8ef501dfbdca40af54a47679d000bf3b 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/ICB/icbutl.F90 b/V4.0/nemo_sources/src/OCE/ICB/icbutl.F90 index ad8c157df18dfc4573fdee797d92429f9910ca13..15fce7ac741154614685ea6dc1e7f9716d750b66 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 23ff1eaa1f26eee012b01711894129956f46d415..fb565ffec8b4983d76fe4f0697d210cabc698349 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 0f25c787016706cbc3fcb2f19ab05bf93b0da165..40e64e0a166eebdc17a60462021827993fc06362 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 ==! + !== 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 091a2d6f47983a11b15ffd6ba2dd0bf17d57cb68..c55761a90082b84ab398e5673612e3095cc9ee3a 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 + !!====================================================================== !! *** 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 77de08123015bd35da45f88f3ee8a579cc210e07..cf16f5a8101b18f0e32ecbc7203095d59752f038 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 ae385bd5dc7105096f6ce0452f548b1ebd452216..e9a7c21024228b6e815b131ea974fd9d739f4fa9 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) @@ -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 84e48629d2af6139c18bc01e7afa6893e656230a..dd6fa7cc04989b766d36a9d5a135c02605ae022c 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 ) !!----------------------------------------------------------------------- !! @@ -90,4 +90,4 @@ SUBROUTINE greg2jul( ksec, kmin, khour, kday, kmonth, kyear, pjulian, & 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 c8e7f8c21a37b12bd468f9ac43b55ec11a01468e..a7221a086f4d462608f9b2351c313a29ff1eed9c 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) @@ -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 c76484a0a7c0ca91ff6b5bcdc89d2c2f3c6023ef..7e0906b1d4a4e0bd0eba1eb67513e8a88300e1f2 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) @@ -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 56c5b8ee428f6219f958feca6ab453d436028dd5..79a299cff1b983ad313a13111f80ca2d5b62ad5a 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 ) !!----------------------------------------------------------------------- !! @@ -118,4 +118,4 @@ RECURSIVE SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, & 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 b6d1e1730fdb7a99686f8834bd3afdc7e2b057ab..343e3e88cd75b7adaf4412a2c6d95eb2e205473e 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) @@ -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 48bfdbe245ac370b7575d7c8daa93d617d1a190c..a7417d5d7c643dd7d2adbc601f2f7c7635144d9b 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) @@ -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 6c95b31cfdff54b6965a60f02a3592038fcf38a7..fa333d6723423337fcd024fff8bb33cb4bba4ac9 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 @@ -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_conv_functions.h90 b/V4.0/nemo_sources/src/OCE/OBS/obs_conv_functions.h90 index 521575266085260a36f268f1060f3cc57e125c96..b3f7639a2c863509a536c790123697d8820375eb 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 e15bbbe419ebba5164f98d06e711c0e76cfcf469..5a41fa312c864dc2245e8f3a519f6a6de84fa55e 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, & @@ -346,4 +346,4 @@ SUBROUTINE obs_grd_bruteforce( kpi, kpj, kpiglo, kpjglo, & & 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 91ccdcd34d39eb21b94770574a96af8431e52389..f93a70023b0cad4a74585b0866b83b37663adaaa 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 @@ -1180,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 6e503bc5b2cfcd93444fb28babd2e0cf9ba08e58..426149695758f7ff1e28226bbfb1d8667c007b73 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 fcecffbe298989812a42f188c09cfb483d1882d1..153b6ba2e28017811749d84a0d03f49bdc6a736b 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 1ef84613b41e9920e62246cf4654c333ca28d6c6..c0e4cb52e282ffdaa0c50c994180ff71b3393a0b 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 @@ -278,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 @@ -1147,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=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=dp), DIMENSION(kpi,kpj,kpk), INTENT(IN) :: pmask - - + REAL(KIND=dp), DIMENSION(kpi,kpj,kpk), INTENT(IN) :: & + & pmask ! Land mask array INTEGER, DIMENSION(kprofno), INTENT(INOUT) :: & & kpobsqc ! Profile quality control INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: & @@ -1455,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/obs_rot_vel.F90 b/V4.0/nemo_sources/src/OCE/OBS/obs_rot_vel.F90 index c1312e3ffa5c0e3ca793dcec07f54a9a4fb209e3..2178d73f57f01a8a48fe9885a915d7e35969f560 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 6f6408c5b7b1c31e89f495e557fba63d6c482e8a..ad961c111fa188439d26d01be6a0ac86294469f4 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 009774f90f564fe7b71241c59b9d97b3b5f71b07..a76ae00eae0f3f5995ace0019ebd07038841ece3 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/OBS/str_c_to_for.h90 b/V4.0/nemo_sources/src/OCE/OBS/str_c_to_for.h90 index 97f8ef1f17e4b340aefa7a9995de95b2f553e901..6c575f95c7131515bc610a55a4c88863f645fa5d 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 8978479e6130c08a059e9caca34246af6f9f628a..8f3bb54d8c70211ce161d397447d75af9678586e 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/sbc_phy.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbc_phy.F90 index 5a97bdf157dc281afb9bc1df5a808f65f5f8245c..fd6bff676b4b4dcc2a50997882111c33235e6ff0 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/sbcblk_algo_coare.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbcblk_algo_coare.F90 index bc6b657ce89f55d6873b549f34478199d480bc87..b886585319caabc81f5a074ed5012d81dc7fb27d 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 d8f690a0382da1d1a54b45961f3397def44e4eb8..49b645e7c87de03addae73d24143c6d52f24551a 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 11758fc4fc2e0f3cab3468ae02fae3504dc6b6fd..5e2c5c2cf5f2676d9c82cb96c5549ecbc3ed86ef 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/sbcdcy.F90 b/V4.0/nemo_sources/src/OCE/SBC/sbcdcy.F90 index 62c4b436678f859e4d3196367df4f888da414922..9e1f7979f1158548991cc126a84069bf467d34e1 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 39f9e3aef58e80ccf1bcb6116b032086b084e77a..fa52bef60a9b307f1f161d74a9643677ff407a22 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 3503033860ce3b482ad168a93db9019a82081796..1fe9dc13d9027d8c52a7ac37c9af03ab2ed34f4f 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 4053ca47bb06bc8c2fab548b22bb4a6b0e28544d..045a1743ea45ae0d36bbcdf664e909e99b75d843 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 4d620f71ed2de45b5b525c81538f3a5a626b95a4..1c9469f786c5a6eca0da6f490c16d60d32fc427c 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/SBC/tide.h90 b/V4.0/nemo_sources/src/OCE/SBC/tide.h90 index f59ff289ceeb369d0abf098611bdd6c481529def..35efe61ca9fa5ddc6552980704d770b9b0a0ada3 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/STO/stopar.F90 b/V4.0/nemo_sources/src/OCE/STO/stopar.F90 index 5c4a4a206a66dca3d964c326d26d21695bf3a9b1..37201b4ace76cd74945ae53aa7e22e7cae93bf6d 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/eosbn2.F90 b/V4.0/nemo_sources/src/OCE/TRA/eosbn2.F90 index acd5b2ed4451831f4d43a4d7cbb219daae94c4c4..b36749bc399fc4b8ae83dc0008b46834645f5b2c 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 f45aa25a9e416b1d77bac6cfba749d597daf8583..35b14e3d91601e802b9af0dcfe348e8192fec043 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,14 +87,14 @@ 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_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), 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 +478,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 @@ -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 2eec1289f2f64ecd20695a856a52f417fa654080..a8a917dedfb6091404431d7b4a748747d5c42ceb 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 d7ca539912fdd949798132bb33f8d2cf512b46ce..1fad9760b3caff357e897226f95ae45a545f0396 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 25611d3b431c8f1659ed6b423db8acc477422bdc..acf128e5aa9a3c7f7525d50edefdeb29d4840cf9 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 195f52cc8b4875fdbc55f34a320ccd119a876d42..ec56bf1c26d892ec652a90d6cdb086720411d3ca 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 17adf2f5a81e03eb07465a00b5cb476fb54bb913..d150015af8422e32e9c72f495fec58819574f069 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/tranpc.F90 b/V4.0/nemo_sources/src/OCE/TRA/tranpc.F90 index 677a053eaecffffb849422bc8326693a97699810..40d08aa4187f4211d6821ed79c68b2c53d3dd936 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/TRA/tranxt.F90 b/V4.0/nemo_sources/src/OCE/TRA/tranxt.F90 index aae313b15716a8dcb5a2d3dcb93e3344eb7b4b58..0945c3f9b84ab7df579d40c97d4a28b429077b5d 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 ac52fdc537273222055bf7db87d95c89557a02f6..69a6f5f721e37e512e9f2027ee458464684509bc 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 da5b0d4f77271a8bc3e11e4be381a46ccdb048e4..f7fbbab71128451ad622e41041003258adcd6554 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 9d97d65ceead437e01c994c2c6dcfb95d9e12b3c..11bd60e2c108db4a1cfbbfec5cf32882e621e6cf 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 51c9c84e6950acf33ead4b8c31a4dfaf85f0ec49..df17827469bfd2b1c4cb860ff86146a71c79356d 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/TRD/trdvor.F90 b/V4.0/nemo_sources/src/OCE/TRD/trdvor.F90 index f1fd337cc3bce7135283816855c60b956a7762ad..b897d52bd4c88b4ee4d697f6cc9062973b0658d8 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/USR/usrdef_hgr.F90 b/V4.0/nemo_sources/src/OCE/USR/usrdef_hgr.F90 index 5be606a8bbe3761b6df38acaf907923c1a9a504b..766aeaa44d14b17b834a1d3cae8d10d79886dbf4 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 6f34bcba954f6f35c1d696fdadf0fc4333152709..6b135c690eb4c868b7dc360511945a81087b0815 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/zdfddm.F90 b/V4.0/nemo_sources/src/OCE/ZDF/zdfddm.F90 index 68bfa112d809c7dff15bee53cf9d9ceaa64c3184..25c38388dcd46a4ca8def02042fa2333278383aa 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/ZDF/zdfgls.F90 b/V4.0/nemo_sources/src/OCE/ZDF/zdfgls.F90 index 2c049f4086b64471fd87adc9b1e1bc7a531c2c4d..a4385e839e3b82a0ebf56b93fb8732893f3a6cfd 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 45d2f6f6faea5d0b57be0f869919c5edc9223052..5244d0b09f75ab8595df459dd1f014f70f5dab3c 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 4f699d10068173c7604a1fea2a65339d7ae590bd..77b9e51ddccd27c3180336ff8579319d3be0eb28 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 8380b8494e69b51dc59287dc02e500316c4cdbcb..0849480d5b2d8aab77c01420f44ae8ec856909e6 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 03153d190f69d2c2ae86cf66fc18ccde0ddbbc3f..b9bee7ce7f89b17d249bc51084682b1bd593ef66 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/stpctl.F90 b/V4.0/nemo_sources/src/OCE/stpctl.F90 index bacb91811abb90913fbf4e67eb6af4a0ab282aea..92be4186ccf6be217e52345f79d128cf0fbe00fd 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. 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 2884f75579c06b69f548d0785d17ab36a9d61c1b..131e8f8529bb46b6f1e625c600153e706b104429 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 a3eb565505d309a93ea86ce708a91ce592c57178..88808735e71e90175c89a5b63de91cc125abe57e 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 195690015d12b268bf81678481b4cf62dd2d2927..367bb36da2edfe97bcf412ff8084cc05413ca4cb 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 a57595c62f2203af7e7922baf691037dfb456ad6..0000000000000000000000000000000000000000 --- 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