Skip to content
Snippets Groups Projects

Compare revisions

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

Source

Select target project
No results found

Target

Select target project
No results found
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 165 additions and 145 deletions
src/OCE/STO/stopar.F90
View file @ 672ff863
......@@ -915,4 +915,3 @@ CONTAINS
END MODULE stopar
src/OCE/STO/stopts.F90
View file @ 672ff863
......@@ -43,7 +43,7 @@ CONTAINS
!! around every model grid point
!!
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: pts ! 1 : potential temperature [Celsius]
REAL(dp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: pts ! 1 : potential temperature [Celsius]
! ! 2 : salinity [psu]
INTEGER :: ji, jj, jk, jts, jdof ! dummy loop indices
INTEGER :: jim1, jjm1, jkm1 ! incremented indices
......@@ -53,7 +53,7 @@ CONTAINS
!!----------------------------------------------------------------------
DO jts = 1, jpts
CALL lbc_lnk( 'stopts', pts(:,:,:,jts), 'T' , 1._wp )
CALL lbc_lnk( 'stopts', pts(:,:,:,jts), 'T' , 1._dp )
ENDDO
DO jdof = 1, nn_sto_eos
......
src/OCE/TDE/tide.h90
View file @ 672ff863
!!=====================================================================
!!=====================================================================
!! *** Include file tide.h90 ***
!!======================================================================
!! History : 3.2 ! 2007 (O. Le Galloudec) Original code
......
src/OCE/TRA/eosbn2.F90
View file @ 672ff863
......@@ -45,6 +45,7 @@ MODULE eosbn2
!
USE in_out_manager ! I/O manager
USE lib_mpp ! for ctl_stop
USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
USE prtctl ! Print control
USE timing ! Timing
......@@ -178,6 +179,7 @@ MODULE eosbn2
!! * Substitutions
# include "do_loop_substitute.h90"
# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
......@@ -188,7 +190,7 @@ CONTAINS
SUBROUTINE eos_insitu( pts, prd, pdep )
!!
REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
REAL(dp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
! ! 2 : salinity [psu]
REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-]
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m]
......@@ -231,14 +233,16 @@ CONTAINS
!! TEOS-10 Manual, 2010
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: ktts, ktrd, ktdep
REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
REAL(dp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
! ! 2 : salinity [psu]
REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-]
REAL(wp), DIMENSION(A2D_T(ktdep),JPK ), INTENT(in ) :: pdep ! depth [m]
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zt , zh , zs , ztm ! local scalars
REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
REAL(wp) :: zt, zh, ztm! local scalars
REAL(dp) :: zs! local scalars
REAL(wp) :: zn1, zn2! - -
REAL(dp) :: zn, zn0, zn3! - -
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('eos-insitu')
......@@ -298,7 +302,7 @@ CONTAINS
!
END SELECT
!
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu : ' )
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=CASTDP(prd), clinfo1=' eos-insitu : ' )
!
IF( ln_timing ) CALL timing_stop('eos-insitu')
!
......@@ -307,10 +311,10 @@ CONTAINS
SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep )
!!
REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
REAL(dp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
! ! 2 : salinity [psu]
REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-]
REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prhop ! potential density (surface referenced)
REAL(dp), DIMENSION(:,:,:) , INTENT( out) :: prhop ! potential density (surface referenced)
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m]
!!
CALL eos_insitu_pot_t( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) )
......@@ -331,16 +335,18 @@ CONTAINS
!!
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: ktts, ktrd, ktrhop, ktdep
REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
REAL(dp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius]
! ! 2 : salinity [psu]
REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-]
REAL(wp), DIMENSION(A2D_T(ktrhop),JPK ), INTENT( out) :: prhop ! potential density (surface referenced)
REAL(dp), DIMENSION(A2D_T(ktrhop),JPK ), INTENT( out) :: prhop ! potential density (surface referenced)
REAL(wp), DIMENSION(A2D_T(ktdep) ,JPK ), INTENT(in ) :: pdep ! depth [m]
!
INTEGER :: ji, jj, jk, jsmp ! dummy loop indices
INTEGER :: jdof
REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars
REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - -
REAL(wp) :: zt, zh, zstemp, ztm! local scalars
REAL(dp) :: zs! local scalars
REAL(wp) :: zn1, zn2, zn3! - -
REAL(dp) :: zn, zn0! - -
REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors
!!----------------------------------------------------------------------
!
......@@ -466,7 +472,7 @@ CONTAINS
!
END SELECT
!
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ' )
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=CASTDP(prd), clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ' )
!
IF( ln_timing ) CALL timing_stop('eos-pot')
!
......@@ -565,7 +571,7 @@ CONTAINS
!
END SELECT
!
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=CASTDP(prd), clinfo1=' eos2d: ' )
!
IF( ln_timing ) CALL timing_stop('eos2d')
!
......@@ -647,9 +653,9 @@ CONTAINS
END_2D
!
END SELECT
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prhop, clinfo1=' pot: ', kdim=1 )
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=CASTDP(prhop), clinfo1=' pot: ', kdim=1 )
!
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prhop, clinfo1=' eos-pot: ' )
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=CASTDP(prhop), clinfo1=' eos-pot: ' )
!
IF( ln_timing ) CALL timing_stop('eos-pot')
!
......@@ -659,7 +665,7 @@ CONTAINS
SUBROUTINE rab_3d( pts, pab, Kmm )
!!
INTEGER , INTENT(in ) :: Kmm ! time level index
REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity
REAL(dp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity
REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio
!!
CALL rab_3d_t( pts, is_tile(pts), pab, is_tile(pab), Kmm )
......@@ -678,7 +684,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: Kmm ! time level index
INTEGER , INTENT(in ) :: ktts, ktab
REAL(wp), DIMENSION(A2D_T(ktts),JPK,JPTS), INTENT(in ) :: pts ! pot. temperature & salinity
REAL(dp), DIMENSION(A2D_T(ktts),JPK,JPTS), INTENT(in ) :: pts ! pot. temperature & salinity
REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio
!
INTEGER :: ji, jj, jk ! dummy loop indices
......@@ -765,8 +771,8 @@ CONTAINS
!
END SELECT
!
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', &
& tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ' )
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=CASTDP(pab(:,:,:,jp_tem)), clinfo1=' rab_3d_t: ', &
& tab3d_2=CASTDP(pab(:,:,:,jp_sal)), clinfo2=' rab_3d_s : ' )
!
IF( ln_timing ) CALL timing_stop('rab_3d')
!
......@@ -884,8 +890,8 @@ CONTAINS
!
END SELECT
!
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', &
& tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' )
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=CASTDP(pab(:,:,jp_tem)), clinfo1=' rab_2d_t: ', &
& tab2d_2=CASTDP(pab(:,:,jp_sal)), clinfo2=' rab_2d_s : ' )
!
IF( ln_timing ) CALL timing_stop('rab_2d')
!
......@@ -992,7 +998,7 @@ CONTAINS
SUBROUTINE bn2( pts, pab, pn2, Kmm )
!!
INTEGER , INTENT(in ) :: Kmm ! time level index
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu]
REAL(dp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu]
REAL(wp), DIMENSION(:,:,:,:) , INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1]
REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2]
!!
......@@ -1016,7 +1022,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: Kmm ! time level index
INTEGER , INTENT(in ) :: ktab, ktn2
REAL(wp), DIMENSION(jpi,jpj, jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu]
REAL(dp), DIMENSION(jpi,jpj, jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu]
REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1]
REAL(wp), DIMENSION(A2D_T(ktn2),JPK ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2]
!
......@@ -1038,7 +1044,7 @@ CONTAINS
& / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)
END_3D
!
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2 : ' )
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=CASTDP(pn2), clinfo1=' bn2 : ' )
!
IF( ln_timing ) CALL timing_stop('bn2')
!
......@@ -1105,7 +1111,7 @@ CONTAINS
SUBROUTINE eos_fzp_2d( psal, ptf, pdep )
!!
REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu]
REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m]
REAL(dp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m]
REAL(wp), DIMENSION(:,:) , INTENT(out ) :: ptf ! freezing temperature [Celsius]
!!
CALL eos_fzp_2d_t( psal, ptf, is_tile(ptf), pdep )
......@@ -1126,7 +1132,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kttf
REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: psal ! salinity [psu]
REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ), OPTIONAL :: pdep ! depth [m]
REAL(dp), DIMENSION(jpi,jpj) , INTENT(in ), OPTIONAL :: pdep ! depth [m]
REAL(wp), DIMENSION(A2D_T(kttf)), INTENT(out ) :: ptf ! freezing temperature [Celsius]
!
INTEGER :: ji, jj ! dummy loop indices
......@@ -1230,7 +1236,7 @@ CONTAINS
!! pab_pe(:,:,:,jp_sal) is beta_pe
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: Kmm ! time level index
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity
REAL(dp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab_pe ! alpha_pe and beta_pe
REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: ppen ! potential energy anomaly
!
......
src/OCE/TRA/traadv.F90
View file @ 672ff863
......@@ -69,6 +69,7 @@ MODULE traadv
!! * Substitutions
# include "do_loop_substitute.h90"
# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
......@@ -87,11 +88,12 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in) :: kt ! ocean time-step index
INTEGER , INTENT(in) :: Kbb, Kmm, Krhs ! time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk ! dummy loop index
! TEMP: [tiling] This change not necessary and can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zuu, zvv, zww ! 3D workspace
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zuu, zww ! 3D workspace
REAL(dp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zvv
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds
! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
LOGICAL :: lskip
......@@ -143,7 +145,7 @@ CONTAINS
!
DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
zuu(ji,jj,jpk) = 0._wp ! no transport trough the bottom
zvv(ji,jj,jpk) = 0._wp
zvv(ji,jj,jpk) = 0._dp
zww(ji,jj,jpk) = 0._wp
END_2D
!
......@@ -161,7 +163,7 @@ CONTAINS
!
!!gm ???
! TEMP: [tiling] This copy-in not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
CALL dia_ptr( kt, Kmm, zvv(A2D(nn_hls),:) ) ! diagnose the effective MSF
CALL dia_ptr( kt, Kmm, CASTSP(zvv(A2D(nn_hls),:)) ) ! diagnose the effective MSF
!!gm ???
!
......@@ -174,15 +176,15 @@ CONTAINS
SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==!
!
CASE ( np_CEN ) ! Centered scheme : 2nd / 4th order
CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v )
CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, CASTSP(zvv), zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v )
CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order
CALL tra_adv_fct ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v )
CALL tra_adv_fct ( kt, nit000, 'TRA', rDt, zuu, CASTSP(zvv), zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v )
CASE ( np_MUS ) ! MUSCL
CALL tra_adv_mus( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )
CALL tra_adv_mus( kt, nit000, 'TRA', rDt, zuu, CASTSP(zvv), zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )
CASE ( np_UBS ) ! UBS
CALL tra_adv_ubs ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v )
CALL tra_adv_ubs ( kt, nit000, 'TRA', rDt, zuu, CASTSP(zvv), zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v )
CASE ( np_QCK ) ! QUICKEST
CALL tra_adv_qck ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs )
CALL tra_adv_qck ( kt, nit000, 'TRA', rDt, zuu, CASTSP(zvv), zww, Kbb, Kmm, pts, jpts, Krhs )
!
END SELECT
!
......
src/OCE/TRA/traadv_cen.F90
View file @ 672ff863
......@@ -75,7 +75,7 @@ CONTAINS
INTEGER , INTENT(in ) :: kn_cen_v ! =2/4 (2nd or 4th order scheme)
! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
INTEGER :: ierr ! local integer
......@@ -136,7 +136,7 @@ CONTAINS
zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * zC4t_u
zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * zC4t_v
END_3D
IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. )
IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', zwx, 'U', -1._wp , zwy, 'V', -1._wp )
!
CASE DEFAULT
CALL ctl_stop( 'traadv_cen: wrong value for nn_cen' )
......
src/OCE/TRA/traadv_cen_lf.F90
View file @ 672ff863
......@@ -36,6 +36,7 @@ MODULE traadv_cen_lf
!! * Substitutions
# include "do_loop_substitute.h90"
# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
......@@ -142,7 +143,7 @@ CONTAINS
END_3D
!
CASE( 4 ) !* 4th order compact
CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! ztw = interpolated value of T at w-point
CALL interp_4th_cpt( CASTDP(pt(:,:,:,jn,Kmm)) , ztw ) ! ztw = interpolated value of T at w-point
DO_3D( 0, 0, 0, 0, 2, jpkm1 )
zwz(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
END_3D
......@@ -170,9 +171,9 @@ CONTAINS
END_3D
! ! trend diagnostics
IF( l_trd ) THEN
CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) )
CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) )
CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) )
CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, CASTDP(pt(:,:,:,jn,Kmm)) )
CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, CASTDP(pt(:,:,:,jn,Kmm)) )
CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, CASTDP(pt(:,:,:,jn,Kmm)) )
ENDIF
! ! "Poleward" heat and salt transports
IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
......
src/OCE/TRA/traadv_fct.F90
View file @ 672ff863
......@@ -80,13 +80,15 @@ CONTAINS
REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step
! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case
REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
REAL(wp) :: ztra ! local scalar
REAL(wp) :: zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u ! - -
REAL(wp) :: zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v ! - -
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwi, zwz, ztu, ztv, zltu, zltv, ztw
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwi_in, ztw_in !temp arrays to avoid intent conflicts
REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zwx, zwy
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdx, ztrdy, ztrdz, zptry
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zwinf, zwdia, zwsup
LOGICAL :: ll_zAimp ! flag to apply adaptive implicit vertical advection
......@@ -193,7 +195,9 @@ CONTAINS
END_3D
IF ( ll_zAimp ) THEN
CALL tridia_solver( zwdia, zwsup, zwinf, zwi, zwi , 0 )
! We need to use separate copies of zwi to avoid intent conflicts!
zwi_in(:,:,:) = zwi(:,:,:)
CALL tridia_solver( zwdia, zwsup, zwinf, zwi_in, zwi , 0 )
!
ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ;
DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Interior value ( multiplied by wmask)
......@@ -274,7 +278,7 @@ CONTAINS
zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk)
zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk)
END_3D
IF (nn_hls==2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn)
IF (nn_hls==2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_dp , zwy, 'V', -1.0_dp ) ! Lateral boundary cond. (unchanged sgn)
!
END SELECT
!
......@@ -298,7 +302,8 @@ CONTAINS
ENDIF
!
IF (nn_hls==1) THEN
CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp )
CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_dp , zwy, 'V', -1.0_dp)
CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp , zwz, 'T', 1.0_wp )
ELSE
CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp)
END IF
......@@ -312,7 +317,10 @@ CONTAINS
ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
END_3D
!
CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 )
! We need to use separate copies of ztw to avoid intent conflicts!
ztw_in(:,:,:) = ztw(:,:,:)
CALL tridia_solver( zwdia, zwsup, zwinf, ztw_in, ztw , 0 )
!
DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Interior value ( multiplied by wmask)
zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
......@@ -323,7 +331,7 @@ CONTAINS
!
! !== monotonicity algorithm ==!
!
CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx, zwy, zwz, zwi, p2dt )
CALL nonosc( Krhs, pt(:,:,:,jn,Kbb), zwx, zwy, zwz, zwi, p2dt )
!
! !== final trend with corrected fluxes ==!
!
......@@ -399,29 +407,32 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: Kmm ! time level index
REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pbef ! before field
REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pbef ! before field
REAL(wp), DIMENSION(A2D(nn_hls) ,jpk), INTENT(in ) :: paft ! after field
REAL(wp), DIMENSION(A2D(nn_hls) ,jpk), INTENT(inout) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions
REAL(wp), DIMENSION(A2D(nn_hls) ,jpk), INTENT(inout) :: pcc! monotonic fluxes in the 3 directions
REAL(dp), DIMENSION(A2D(nn_hls) ,jpk), INTENT(inout) :: paa, pbb! monotonic fluxes in the 3 directions
!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ikm1 ! local integer
REAL(dp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars
REAL(dp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - -
REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zbetup, zbetdo, zbup, zbdo
REAL(wp) :: zpos, zneg, zbt, zbig ! local scalars
REAL(wp) :: zup, zdo ! - -
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zbetup, zbetdo, zbup, zbdo
!!----------------------------------------------------------------------
!
zbig = 1.e+40_dp
zrtrn = 1.e-15_dp
zbetup(:,:,:) = 0._dp ; zbetdo(:,:,:) = 0._dp
zbig = HUGE(1._wp)
zbetup(:,:,jpk) = zbig ; zbetdo(:,:,jpk) = zbig
! Search local extrema
! --------------------
! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
zbup(ji,jj,jk) = MAX( pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ), &
& paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ) )
zbdo(ji,jj,jk) = MIN( pbef(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) ), &
& paft(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) ) )
IF( tmask(ji,jj,jk) == 1._wp ) THEN
zbup(ji,jj,jk) = MAX( pbef(ji,jj,jk), paft(ji,jj,jk) )
zbdo(ji,jj,jk) = MIN( pbef(ji,jj,jk), paft(ji,jj,jk) )
ELSE
zbup(ji,jj,jk) = -zbig
zbdo(ji,jj,jk) = zbig
ENDIF
END_3D
DO jk = 1, jpkm1
......@@ -441,42 +452,39 @@ CONTAINS
& zbdo(ji ,jj ,ikm1), zbdo(ji ,jj ,jk+1) )
! positive part of the flux
zpos = MAX( 0., paa(ji-1,jj ,jk ) ) - MIN( 0., paa(ji ,jj ,jk ) ) &
& + MAX( 0., pbb(ji ,jj-1,jk ) ) - MIN( 0., pbb(ji ,jj ,jk ) ) &
& + MAX( 0., pcc(ji ,jj ,jk+1) ) - MIN( 0., pcc(ji ,jj ,jk ) )
zpos = MAX( 0._wp, paa(ji-1,jj ,jk ) ) - MIN( 0._wp, paa(ji ,jj ,jk ) ) &
& + MAX( 0._wp, pbb(ji ,jj-1,jk ) ) - MIN( 0._wp, pbb(ji ,jj ,jk ) ) &
& + MAX( 0._wp, pcc(ji ,jj ,jk+1) ) - MIN( 0._wp, pcc(ji ,jj ,jk ) )
! negative part of the flux
zneg = MAX( 0., paa(ji ,jj ,jk ) ) - MIN( 0., paa(ji-1,jj ,jk ) ) &
& + MAX( 0., pbb(ji ,jj ,jk ) ) - MIN( 0., pbb(ji ,jj-1,jk ) ) &
& + MAX( 0., pcc(ji ,jj ,jk ) ) - MIN( 0., pcc(ji ,jj ,jk+1) )
zneg = MAX( 0._wp, paa(ji ,jj ,jk ) ) - MIN( 0._wp, paa(ji-1,jj ,jk ) ) &
& + MAX( 0._wp, pbb(ji ,jj ,jk ) ) - MIN( 0._wp, pbb(ji ,jj-1,jk ) ) &
& + MAX( 0._wp, pcc(ji ,jj ,jk ) ) - MIN( 0._wp, pcc(ji ,jj ,jk+1) )
! up & down beta terms
zbt = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt
zbetup(ji,jj,jk) = ( zup - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt
zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo ) / ( zneg + zrtrn ) * zbt
IF( zup /= -zbig .AND. zpos /= 0._wp ) THEN ; zbetup(ji,jj,jk) = ( zup - paft(ji,jj,jk) ) / zpos * zbt
ELSE ; zbetup(ji,jj,jk) = zbig
ENDIF
IF( zdo /= zbig .AND. zneg /= 0._wp ) THEN ; zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo ) / zneg * zbt
ELSE ; zbetdo(ji,jj,jk) = zbig
ENDIF
END_2D
END DO
IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp, ld4only= .TRUE. ) ! lateral boundary cond. (unchanged sign)
! 3. monotonic flux in the i & j direction (paa & pbb)
! ----------------------------------------
! 3. monotonic flux in the i, j and k direction (paa, pbb and pcc)
! ----------------------------------------------------------------
DO_3D( 1, 0, 1, 0, 1, jpkm1 )
zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
zcu = ( 0.5 + SIGN( 0.5_wp , paa(ji,jj,jk) ) )
paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu )
zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
zcv = ( 0.5 + SIGN( 0.5_wp , pbb(ji,jj,jk) ) )
pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv )
! monotonic flux in the k direction, i.e. pcc
! -------------------------------------------
za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) )
zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) )
zc = ( 0.5 + SIGN( 0.5_wp , pcc(ji,jj,jk+1) ) )
pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb )
IF( paa(ji,jj,jk) > 0._wp ) THEN ; paa(ji,jj,jk) = paa(ji,jj,jk) * MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
ELSE ; paa(ji,jj,jk) = paa(ji,jj,jk) * MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
ENDIF
IF( pbb(ji,jj,jk) > 0._wp ) THEN ; pbb(ji,jj,jk) = pbb(ji,jj,jk) * MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
ELSE ; pbb(ji,jj,jk) = pbb(ji,jj,jk) * MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
ENDIF
IF( pcc(ji,jj,jk+1) > 0._wp ) THEN ; pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * MIN( 1._wp, zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) )
ELSE ; pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * MIN( 1._wp, zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) )
ENDIF
END_3D
!
END SUBROUTINE nonosc
......@@ -552,7 +560,7 @@ CONTAINS
!!
!! ** Method : 4th order compact interpolation
!!----------------------------------------------------------------------
REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt_in ! field at t-point
REAL(dp),DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt_in ! field at t-point
REAL(wp),DIMENSION(A2D(nn_hls) ,jpk), INTENT( out) :: pt_out ! field interpolated at w-point
!
INTEGER :: ji, jj, jk ! dummy loop integers
......@@ -642,7 +650,7 @@ CONTAINS
!! The solution is pta.
!! The 3d array zwt is used as a work space array.
!!----------------------------------------------------------------------
REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(in ) :: pD, pU, PL ! 3-diagonal matrix
REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(in ) :: pD, pU, pL ! 3-diagonal matrix
REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(in ) :: pRHS ! Right-Hand-Side
REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT( out) :: pt_out !!gm field at level=F(klev)
INTEGER , INTENT(in ) :: klev ! =1 pt_out at w-level
......@@ -722,6 +730,8 @@ CONTAINS
REAL(wp) :: zwy_jm1, zfm_ui, zfm_ui_m1, zfm_vj, zfm_vj_m1, zfm_wk, zC2t_v, zC4t_v ! - -
REAL(wp) :: ztu, ztv, ztu_im1, ztu_ip1, ztv_jm1, ztv_jp1
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwx_3d, zwy_3d, zwz, ztw, zltu_3d, zltv_3d
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi_in, ztw_in ! Read-only copies to avoid INTENT conflicts
! in calls to tridia_solver
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdx, ztrdy, ztrdz, zptry
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zwinf, zwdia, zwsup
LOGICAL :: ll_zAimp ! flag to apply adaptive implicit vertical advection
......@@ -737,6 +747,8 @@ CONTAINS
zwy_3d(:,:,:) = 0._wp
zwz(:,:,:) = 0._wp
zwi(:,:,:) = 0._wp
zwt(:,:,:) = 0._wp
!
l_trd = .FALSE. ! set local switches
l_hst = .FALSE.
......@@ -818,7 +830,10 @@ CONTAINS
END DO
IF ( ll_zAimp ) THEN
CALL tridia_solver( zwdia, zwsup, zwinf, zwi, zwi , 0 )
! We need to use separate copies of zwi to avoid intent conflicts!
zwi_in(:,:,:) = zwi(:,:,:)
CALL tridia_solver( zwdia, zwsup, zwinf, zwi_in, zwi , 0 )
!
ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ;
DO_3D( 1, 1, 1, 1, 2, jpkm1 ) ! Interior value ( multiplied by wmask)
......@@ -932,7 +947,9 @@ CONTAINS
ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
END_3D
!
CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 )
! We need to use separate copies of ztw to avoid intent conflicts!
ztw_in(:,:,:) = ztw(:,:,:)
CALL tridia_solver( zwdia, zwsup, zwinf, ztw_in, ztw , 0 )
!
DO_3D( 1, 1, 1, 1, 2, jpkm1 ) ! Interior value ( multiplied by wmask)
zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
......@@ -943,7 +960,7 @@ CONTAINS
!
! !== monotonicity algorithm ==!
!
CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx_3d, zwy_3d, zwz, zwi, p2dt )
CALL nonosc( Krhs, pt(:,:,:,jn,Kbb), zwx_3d, zwy_3d, zwz, zwi, p2dt )
!
! !== final trend with corrected fluxes ==!
!
......
src/OCE/TRA/traadv_mus.F90
View file @ 672ff863
......@@ -82,7 +82,7 @@ CONTAINS
REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step
! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
INTEGER :: ierr ! local integer
......
src/OCE/TRA/traadv_qck.F90
View file @ 672ff863
......@@ -95,7 +95,7 @@ CONTAINS
REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step
! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume transport components
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
!!----------------------------------------------------------------------
!
#if defined key_loop_fusion
......@@ -137,7 +137,7 @@ CONTAINS
REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step
! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU ! i-velocity components
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation
!!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk ! local scalars
......@@ -222,7 +222,7 @@ CONTAINS
REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step
! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pV ! j-velocity components
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation
!!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk ! local scalars
......@@ -318,7 +318,7 @@ CONTAINS
INTEGER , INTENT(in ) :: kjpt ! number of tracers
! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pW ! vertical velocity
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwz ! 3D workspace
......
src/OCE/TRA/traadv_qck_lf.F90
View file @ 672ff863
......@@ -40,6 +40,7 @@ MODULE traadv_qck_lf
!! * Substitutions
# include "do_loop_substitute.h90"
# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
......@@ -188,7 +189,7 @@ CONTAINS
pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra
END_3D
! ! trend diagnostics
IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) )
IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, CASTDP(pt(:,:,:,jn,Kmm)) )
!
END DO
!
......@@ -266,7 +267,7 @@ CONTAINS
pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra
END_3D
! ! trend diagnostics
IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) )
IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, CASTDP(pt(:,:,:,jn,Kmm)) )
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
!
......@@ -318,7 +319,7 @@ CONTAINS
& * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
END_3D
! ! Send trends for diagnostic
IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) )
IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, CASTDP(pt(:,:,:,jn,Kmm)) )
!
END DO
!
......
src/OCE/TRA/traadv_ubs.F90
View file @ 672ff863
......@@ -96,7 +96,7 @@ CONTAINS
REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step
! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume transport components
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
REAL(wp) :: ztra, zbtr, zcoef ! local scalars
......@@ -284,7 +284,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: Kmm ! time level index
REAL(wp), INTENT(in ) :: p2dt ! tracer time-step
REAL(wp), DIMENSION(jpi,jpj,jpk) :: pbef ! before field
REAL(dp), DIMENSION(jpi,jpj,jpk) :: pbef ! before field
REAL(wp), INTENT(inout), DIMENSION(A2D(nn_hls) ,jpk) :: paft ! after field
REAL(wp), INTENT(inout), DIMENSION(A2D(nn_hls) ,jpk) :: pcc ! monotonic flux in the k direction
!
......@@ -294,7 +294,7 @@ CONTAINS
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zbetup, zbetdo ! 3D workspace
!!----------------------------------------------------------------------
!
zbig = 1.e+38_wp
zbig = 1.e+20_wp ! works ok with simple/double precison
zrtrn = 1.e-15_wp
zbetup(:,:,:) = 0._wp ; zbetdo(:,:,:) = 0._wp
!
......
src/OCE/TRA/traadv_ubs_lf.F90
View file @ 672ff863
......@@ -38,6 +38,7 @@ MODULE traadv_ubs_lf
!! * Substitutions
# include "do_loop_substitute.h90"
# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
......@@ -185,8 +186,8 @@ CONTAINS
END_3D ! and/or in trend diagnostic (l_trd=T)
!
IF( l_trd ) THEN ! trend diagnostics
CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztu, pU, pt(:,:,:,jn,Kmm) )
CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztv, pV, pt(:,:,:,jn,Kmm) )
CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztu, pU, CASTDP(pt(:,:,:,jn,Kmm)) )
CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztv, pV, CASTDP(pt(:,:,:,jn,Kmm)) )
END IF
!
! ! "Poleward" heat and salt transports (contribution of upstream fluxes)
......@@ -243,7 +244,7 @@ CONTAINS
CALL nonosc_z( Kmm, pt(:,:,:,jn,Kbb), ztw, zti, p2dt ) ! monotonicity algorithm
!
CASE( 4 ) ! 4th order COMPACT
CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! 4th order compact interpolation of T at w-point
CALL interp_4th_cpt( CASTDP(pt(:,:,:,jn,Kmm)) , ztw ) ! 4th order compact interpolation of T at w-point
DO_3D( 0, 0, 0, 0, 2, jpkm1 )
ztw(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
END_3D
......@@ -299,7 +300,7 @@ CONTAINS
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zbetup, zbetdo ! 3D workspace
!!----------------------------------------------------------------------
!
zbig = 1.e+38_wp
zbig = 1.e+20_wp ! works ok with simple/double precison
zrtrn = 1.e-15_wp
zbetup(:,:,:) = 0._wp ; zbetdo(:,:,:) = 0._wp
!
......
src/OCE/TRA/traatf.F90
View file @ 672ff863
......@@ -88,7 +88,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers
REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers
!!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
REAL(wp) :: zfact ! local scalars
......@@ -109,7 +109,7 @@ CONTAINS
CALL Agrif_tra ! AGRIF zoom boundaries
#endif
! ! local domain boundaries (T-point, unchanged sign)
CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp )
CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_dp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_dp )
!
IF( ln_bdy ) CALL bdy_tra( kt, Kbb, pts, Kaa ) ! BDY open boundaries
......@@ -155,7 +155,7 @@ CONTAINS
ELSE ; CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nit000, rn_Dt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts ) ! non-linear free surface
ENDIF
!
CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp )
CALL lbc_lnk( 'traatf', pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_dp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_dp )
ENDIF
!
......@@ -193,7 +193,7 @@ CONTAINS
INTEGER , INTENT(in ) :: kit000 ! first time step index
CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
INTEGER , INTENT(in ) :: kjpt ! number of tracers
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracer fields
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracer fields
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
REAL(wp) :: ztn, ztd ! local scalars
......@@ -237,7 +237,7 @@ CONTAINS
REAL(wp) , INTENT(in ) :: p2dt ! time-step
CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
INTEGER , INTENT(in ) :: kjpt ! number of tracers
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracer fields
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracer fields
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
!
......
src/OCE/TRA/traatf_qco.F90
View file @ 672ff863
......@@ -85,10 +85,10 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers
REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers
!!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
REAL(wp) :: zfact ! local scalars
REAL(dp) :: zfact ! local scalars
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds
!!----------------------------------------------------------------------
!
......@@ -145,7 +145,7 @@ CONTAINS
ELSE ; CALL tra_atf_qco_lf( kt, Kbb, Kmm, Kaa, nit000, rn_Dt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts ) ! non-linear free surface
ENDIF
!
CALL lbc_lnk( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp )
CALL lbc_lnk( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._dp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._dp )
!
ENDIF
!
......@@ -183,7 +183,7 @@ CONTAINS
INTEGER , INTENT(in ) :: kit000 ! first time step index
CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
INTEGER , INTENT(in ) :: kjpt ! number of tracers
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracer fields
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracer fields
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
REAL(wp) :: ztn, ztd ! local scalars
......@@ -227,14 +227,14 @@ CONTAINS
REAL(wp) , INTENT(in ) :: p2dt ! time-step
CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
INTEGER , INTENT(in ) :: kjpt ! number of tracers
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracer fields
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracer fields
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_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar
REAL(wp) :: zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f ! - -
REAL(dp) :: zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar
REAL(dp) :: zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f ! - -
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrd_atf
!!----------------------------------------------------------------------
!
......
src/OCE/TRA/trabbc.F90
View file @ 672ff863
......@@ -77,7 +77,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER, INTENT(in ) :: kt ! ocean time-step index
INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt ! 3D workspace
......@@ -104,7 +104,7 @@ CONTAINS
CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) )
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc - Ta: ', mask1=tmask, clinfo3='tra-ta' )
!
IF( ln_timing ) CALL timing_stop('tra_bbc')
!
END SUBROUTINE tra_bbc
......
src/OCE/TRA/trabbl.F90
View file @ 672ff863
......@@ -55,8 +55,6 @@ MODULE trabbl
REAL(wp), PUBLIC :: rn_ahtbbl !: along slope bbl diffusive coefficient [m2/s]
REAL(wp), PUBLIC :: rn_gambbl !: lateral coeff. for bottom boundary layer scheme [s]
LOGICAL , PUBLIC :: l_bbl !: flag to compute bbl diffu. flux coef and transport
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: utr_bbl , vtr_bbl ! u- (v-) transport in the bottom boundary layer
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: ahu_bbl , ahv_bbl ! masked diffusive bbl coeff. at u & v-pts
......@@ -103,7 +101,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER, INTENT(in ) :: kt ! ocean time-step
INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk ! Dummy loop indices
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds
......@@ -117,8 +115,6 @@ CONTAINS
ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
ENDIF
IF( l_bbl ) CALL bbl( kt, nit000, 'TRA', Kbb, Kmm ) !* bbl coef. and transport (only if not already done in trcbbl)
IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl
!
CALL tra_bbl_dif( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm )
......@@ -176,8 +172,8 @@ CONTAINS
!! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kjpt ! number of tracers
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend
INTEGER , INTENT(in ) :: Kmm ! time level indices
!
INTEGER :: ji, jj, jn ! dummy loop indices
......@@ -225,8 +221,8 @@ CONTAINS
!! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kjpt ! number of tracers
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields
REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields
REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend
INTEGER , INTENT(in ) :: Kmm ! time level indices
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
......@@ -289,7 +285,7 @@ CONTAINS
END SUBROUTINE tra_bbl_adv
SUBROUTINE bbl( kt, kit000, cdtype, Kbb, Kmm )
SUBROUTINE bbl( kt, kit000, Kbb, Kmm )
!!----------------------------------------------------------------------
!! *** ROUTINE bbl ***
!!
......@@ -317,7 +313,6 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: kit000 ! first time step index
CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level index
!
INTEGER :: ji, jj ! dummy loop indices
......@@ -333,7 +328,7 @@ CONTAINS
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
IF( kt == kit000 ) THEN
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype
IF(lwp) WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
ENDIF
ENDIF
......@@ -479,8 +474,6 @@ CONTAINS
902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambbl in configuration namelist' )
IF(lwm) WRITE ( numond, nambbl )
!
l_bbl = .TRUE. !* flag to compute bbl coef and transport
!
IF(lwp) THEN !* Parameter control and print
WRITE(numout,*)
WRITE(numout,*) 'tra_bbl_init : bottom boundary layer initialisation'
......
src/OCE/TRA/tradmp.F90
View file @ 672ff863
......@@ -91,10 +91,10 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER, INTENT(in ) :: kt ! ocean time-step index
INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts) :: zts_dta
REAL(dp), DIMENSION(A2D(nn_hls),jpk,jpts) :: zts_dta
REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: zwrk
REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrdts
!!----------------------------------------------------------------------
......
src/OCE/TRA/traisf.F90
View file @ 672ff863
......@@ -41,7 +41,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time step
INTEGER , INTENT(in ) :: Kmm, Krhs ! ocean time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('tra_isf')
......@@ -97,7 +97,7 @@ CONTAINS
!! *** Action :: Update pts(:,:,:,:,Krhs) with the surface boundary condition trend
!!
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: pts
REAL(dp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: pts
!!----------------------------------------------------------------------
INTEGER , DIMENSION(jpi,jpj) , INTENT(in ) :: ktop , kbot
REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: phtbl, pfrac
......@@ -138,7 +138,7 @@ CONTAINS
!! *** Action :: Update pts(:,:,:,:,Krhs) with the ice shelf coupling trend
!!
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: ptsa
REAL(dp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(inout) :: ptsa
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: Kmm ! ocean time level index
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: ptsc
......
src/OCE/TRA/traldf.F90
View file @ 672ff863
......@@ -52,7 +52,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER, INTENT(in ) :: kt ! ocean time-step index
INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation
!!
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds
!!----------------------------------------------------------------------
......