diff --git a/src/OCE/ASM/asminc.F90 b/src/OCE/ASM/asminc.F90
index 54371a62c3b73a6d626d97937dbbf52d20a565b8..850dfb0999d2e0eae94e34023068916aad36e46a 100644
--- a/src/OCE/ASM/asminc.F90
+++ b/src/OCE/ASM/asminc.F90
@@ -94,6 +94,7 @@ MODULE asminc
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -119,11 +120,11 @@ CONTAINS
INTEGER :: ios ! Local integer output status for namelist read
INTEGER :: iiauper ! Number of time steps in the IAU period
INTEGER :: icycper ! Number of time steps in the cycle
- REAL(KIND=dp) :: ditend_date ! Date YYYYMMDD.HHMMSS of final time step
- REAL(KIND=dp) :: ditbkg_date ! Date YYYYMMDD.HHMMSS of background time step for Jb term
- REAL(KIND=dp) :: ditdin_date ! Date YYYYMMDD.HHMMSS of background time step for DI
- REAL(KIND=dp) :: ditiaustr_date ! Date YYYYMMDD.HHMMSS of IAU interval start time step
- REAL(KIND=dp) :: ditiaufin_date ! Date YYYYMMDD.HHMMSS of IAU interval final time step
+ REAL(KIND=wp) :: ditend_date ! Date YYYYMMDD.HHMMSS of final time step
+ REAL(KIND=wp) :: ditbkg_date ! Date YYYYMMDD.HHMMSS of background time step for Jb term
+ REAL(KIND=wp) :: ditdin_date ! Date YYYYMMDD.HHMMSS of background time step for DI
+ REAL(KIND=wp) :: ditiaustr_date ! Date YYYYMMDD.HHMMSS of IAU interval start time step
+ REAL(KIND=wp) :: ditiaufin_date ! Date YYYYMMDD.HHMMSS of IAU interval final time step
REAL(wp) :: znorm ! Normalization factor for IAU weights
REAL(wp) :: ztotwgt ! Value of time-integrated IAU weights (should be equal to one)
@@ -514,7 +515,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! Current 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
INTEGER :: it
@@ -526,7 +527,7 @@ CONTAINS
! used to prevent the applied increments taking the temperature below the local freezing point
IF( ln_temnofreeze ) THEN
DO jk = 1, jpkm1
- CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) )
+ CALL eos_fzp( CASTSP(pts(:,:,jk,jp_sal,Kmm)), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) )
END DO
ENDIF
!
@@ -648,7 +649,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,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!
INTEGER :: ji, jj, jk
INTEGER :: it
diff --git a/src/OCE/BDY/bdy_oce.F90 b/src/OCE/BDY/bdy_oce.F90
index d42f6a429ef0e5ad13aece5d8b910afc8e71f00e..177026bfee3ab5441d152404722b3aa33ee20b04 100644
--- a/src/OCE/BDY/bdy_oce.F90
+++ b/src/OCE/BDY/bdy_oce.F90
@@ -173,4 +173,3 @@ CONTAINS
!!======================================================================
END MODULE bdy_oce
-
diff --git a/src/OCE/BDY/bdydyn.F90 b/src/OCE/BDY/bdydyn.F90
index 61e4d378d12667ffb19f81dd40b40612c89c9e84..2a30046a26250e85c98175193f76b8412b927ab0 100644
--- a/src/OCE/BDY/bdydyn.F90
+++ b/src/OCE/BDY/bdydyn.F90
@@ -47,7 +47,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in) :: kt ! Main time step counter
INTEGER , INTENT(in) :: Kbb, Kaa ! Ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
LOGICAL, OPTIONAL , INTENT(in) :: dyn3d_only ! T => only update baroclinic velocities
!
INTEGER :: jk, ii, ij, ib_bdy, ib, igrd ! Loop counter
diff --git a/src/OCE/BDY/bdydyn2d.F90 b/src/OCE/BDY/bdydyn2d.F90
index f3971aea4d74d612d59d3acb0dd7906fa99cc860..1872bd06e343713df89b3af8ce5dde5617d398ba 100644
--- a/src/OCE/BDY/bdydyn2d.F90
+++ b/src/OCE/BDY/bdydyn2d.F90
@@ -46,7 +46,7 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d
REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pub2d, pvb2d
REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: phur, phvr
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pssh
+ REAL(dp), DIMENSION(jpi,jpj), INTENT(in ) :: pssh
!!
INTEGER :: ib_bdy, ir ! BDY set index, rim index
INTEGER, DIMENSION(3) :: idir3
@@ -183,7 +183,8 @@ CONTAINS
TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data
INTEGER, INTENT(in) :: ib_bdy ! BDY set index
REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssh, phur, phvr
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phur, phvr
+ REAL(dp), DIMENSION(jpi,jpj), INTENT(in) :: pssh
LOGICAL , INTENT(in) :: llrim0 ! indicate if rim 0 is treated
INTEGER :: ibeg, iend ! length of rim to be treated (rim 0 or rim 1)
INTEGER :: jb, igrd ! dummy loop indices
@@ -312,7 +313,7 @@ CONTAINS
!! ** Purpose : Duplicate sea level across open boundaries
!!
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(jpi,jpj,1), INTENT(inout) :: zssh ! Sea level, need 3 dimensions to be used by bdy_nmn
+ REAL(dp), DIMENSION(jpi,jpj,1), INTENT(inout) :: zssh ! Sea level, need 3 dimensions to be used by bdy_nmn
!!
INTEGER :: ib_bdy, ir ! bdy index, rim index
INTEGER :: ibeg, iend ! length of rim to be treated (rim 0 or rim 1)
@@ -332,7 +333,7 @@ CONTAINS
END DO
IF( nn_hls > 1 .AND. ir == 1 ) CYCLE ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0
IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN ! if need to send/recv in at least one direction
- CALL lbc_lnk( 'bdydyn2d', zssh(:,:,1), 'T', 1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
+ CALL lbc_lnk( 'bdydyn2d', zssh(:,:,1), 'T', 1.0_dp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
END IF
END DO
!
@@ -340,4 +341,3 @@ CONTAINS
!!======================================================================
END MODULE bdydyn2d
-
diff --git a/src/OCE/BDY/bdydyn3d.F90 b/src/OCE/BDY/bdydyn3d.F90
index 8b4bd77d39a793a058f71f28bc797589b66d90eb..db3d30485ad6badcf36bd01d5beb7ec5f41c715b 100644
--- a/src/OCE/BDY/bdydyn3d.F90
+++ b/src/OCE/BDY/bdydyn3d.F90
@@ -41,7 +41,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! Main time step counter
INTEGER , INTENT( in ) :: Kbb, Kaa ! Time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
!
INTEGER :: ib_bdy, ir ! BDY set index, rim index
INTEGER, DIMENSION(6) :: idir6
@@ -101,10 +101,10 @@ CONTAINS
END DO
!
IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN ! if need to send/recv in at least one direction
- CALL lbc_lnk( 'bdydyn2d', puu(:,:,:,Kaa), 'U', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 )
+ CALL lbc_lnk( 'bdydyn2d', puu(:,:,:,Kaa), 'U', -1.0_dp, kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 )
END IF
IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN ! if need to send/recv in at least one direction
- CALL lbc_lnk( 'bdydyn2d', pvv(:,:,:,Kaa), 'V', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 )
+ CALL lbc_lnk( 'bdydyn2d', pvv(:,:,:,Kaa), 'V', -1.0_dp, kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 )
END IF
END DO ! ir
!
@@ -120,7 +120,7 @@ CONTAINS
!!
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: Kaa ! Time level index
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
TYPE(OBC_INDEX) , INTENT( in ) :: idx ! OBC indices
TYPE(OBC_DATA) , INTENT( in ) :: dta ! OBC external data
INTEGER , INTENT( in ) :: kt ! Time step
@@ -159,7 +159,7 @@ CONTAINS
!!
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: Kaa ! Time level index
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
TYPE(OBC_INDEX) , INTENT( in ) :: idx ! OBC indices
TYPE(OBC_DATA) , INTENT( in ) :: dta ! OBC external data
INTEGER , INTENT( in ) :: kt
@@ -224,7 +224,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! time step index
INTEGER , INTENT( in ) :: Kaa ! Time level index
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
TYPE(OBC_INDEX) , INTENT( in ) :: idx ! OBC indices
TYPE(OBC_DATA) , INTENT( in ) :: dta ! OBC external data
INTEGER , INTENT( in ) :: ib_bdy ! BDY set index
@@ -267,7 +267,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! time step index
INTEGER , INTENT( in ) :: Kaa ! Time level index
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
TYPE(OBC_INDEX) , INTENT( in ) :: idx ! OBC indices
TYPE(OBC_DATA) , INTENT( in ) :: dta ! OBC external data
INTEGER , INTENT( in ) :: ib_bdy ! BDY set index
@@ -311,7 +311,7 @@ CONTAINS
!! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: Kbb, Kaa ! Time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
TYPE(OBC_INDEX) , INTENT( in ) :: idx ! OBC indices
TYPE(OBC_DATA) , INTENT( in ) :: dta ! OBC external data
INTEGER , INTENT( in ) :: ib_bdy ! BDY set index
@@ -343,7 +343,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! time step
INTEGER , INTENT( in ) :: Kbb, Krhs ! Time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities and trends (to be updated at open boundaries)
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities and trends (to be updated at open boundaries)
!
INTEGER :: jb, jk ! dummy loop indices
INTEGER :: ib_bdy ! loop index
@@ -395,7 +395,7 @@ CONTAINS
!!
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: Kaa ! Time level index
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries)
TYPE(OBC_INDEX) , INTENT( in ) :: idx ! OBC indices
INTEGER , INTENT( in ) :: ib_bdy ! BDY set index
LOGICAL , INTENT( in ) :: llrim0 ! indicate if rim 0 is treated
diff --git a/src/OCE/BDY/bdylib.F90 b/src/OCE/BDY/bdylib.F90
index e73eb3c4902b01580d3bd8b5223d8a826478112b..0cecd3850b81d432099c3f4249c01fe3991d35ee 100644
--- a/src/OCE/BDY/bdylib.F90
+++ b/src/OCE/BDY/bdylib.F90
@@ -44,7 +44,7 @@ CONTAINS
!!----------------------------------------------------------------------
TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices
REAL(wp), DIMENSION(:,:), POINTER, INTENT(in) :: dta ! OBC external data
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend
!!
REAL(wp) :: zwgt ! boundary weight
INTEGER :: ib, ik, igrd ! dummy loop indices
@@ -73,7 +73,7 @@ CONTAINS
!!----------------------------------------------------------------------
TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices
REAL(wp), DIMENSION(:,:), POINTER, INTENT(in) :: dta ! OBC external data
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend
!!
INTEGER :: ib, ik, igrd ! dummy loop indices
INTEGER :: ii, ij ! 2D addresses
@@ -101,8 +101,8 @@ CONTAINS
!!----------------------------------------------------------------------
TYPE(OBC_INDEX), INTENT(in ) :: idx ! OBC indices
REAL(wp), DIMENSION(:,:), POINTER, INTENT(in ) :: dta ! OBC external data
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phib ! before tracer field
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phib ! before tracer field
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend
LOGICAL , INTENT(in ) :: lrim0 ! indicate if rim 0 is treated
LOGICAL , INTENT(in ) :: ll_npo ! switch for NPO version
!!
@@ -145,14 +145,14 @@ CONTAINS
REAL(wp) :: zmask_x, zmask_y1, zmask_y2
REAL(wp) :: zex1, zex2, zey, zey1, zey2
REAL(wp) :: zdt, zdx, zdy, znor2, zrx, zry ! intermediate calculations
- REAL(wp) :: zout, zwgt, zdy_centred
+ REAL(dp) :: zout, zwgt, zdy_centred
REAL(wp) :: zdy_1, zdy_2, zsign_ups
REAL(wp), PARAMETER :: zepsilon = 1.e-30 ! local small value
REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! land/sea mask for field
REAL(wp), POINTER, DIMENSION(:,:) :: zmask_xdif ! land/sea mask for x-derivatives
REAL(wp), POINTER, DIMENSION(:,:) :: zmask_ydif ! land/sea mask for y-derivatives
- REAL(wp), POINTER, DIMENSION(:,:) :: pe_xdif ! scale factors for x-derivatives
- REAL(wp), POINTER, DIMENSION(:,:) :: pe_ydif ! scale factors for y-derivatives
+ REAL(dp), POINTER, DIMENSION(:,:) :: pe_xdif ! scale factors for x-derivatives
+ REAL(dp), POINTER, DIMENSION(:,:) :: pe_ydif ! scale factors for y-derivatives
!!----------------------------------------------------------------------
!
! ----------------------------------!
@@ -291,8 +291,8 @@ CONTAINS
!!----------------------------------------------------------------------
TYPE(OBC_INDEX), INTENT(in ) :: idx ! BDY indices
INTEGER , INTENT(in ) :: igrd ! grid index
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: phib ! model before 3D field
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phia ! model after 3D field (to be updated)
+ REAL(dp), DIMENSION(:,:,:), INTENT(in ) :: phib ! model before 3D field
+ REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: phia ! model after 3D field (to be updated)
REAL(wp), DIMENSION(:,: ), POINTER, INTENT(in ) :: phi_ext ! external forcing data
LOGICAL , INTENT(in ) :: lrim0 ! indicate if rim 0 is treated
LOGICAL , INTENT(in ) :: ll_npo ! switch for NPO version
@@ -307,14 +307,14 @@ CONTAINS
REAL(wp) :: zmask_x, zmask_y1, zmask_y2
REAL(wp) :: zex1, zex2, zey, zey1, zey2
REAL(wp) :: zdt, zdx, zdy, znor2, zrx, zry ! intermediate calculations
- REAL(wp) :: zout, zwgt, zdy_centred
+ REAL(dp) :: zout, zwgt, zdy_centred
REAL(wp) :: zdy_1, zdy_2, zsign_ups
REAL(wp), PARAMETER :: zepsilon = 1.e-30 ! local small value
REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask ! land/sea mask for field
REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask_xdif ! land/sea mask for x-derivatives
REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask_ydif ! land/sea mask for y-derivatives
- REAL(wp), POINTER, DIMENSION(:,:) :: pe_xdif ! scale factors for x-derivatives
- REAL(wp), POINTER, DIMENSION(:,:) :: pe_ydif ! scale factors for y-derivatives
+ REAL(dp), POINTER, DIMENSION(:,:) :: pe_xdif ! scale factors for x-derivatives
+ REAL(dp), POINTER, DIMENSION(:,:) :: pe_ydif ! scale factors for y-derivatives
!!----------------------------------------------------------------------
!
! ----------------------------------!
@@ -457,7 +457,7 @@ CONTAINS
!! ! o
!!----------------------------------------------------------------------
INTEGER, INTENT(in ) :: igrd ! grid index
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phia ! model after 3D field (to be updated), must be masked
+ REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: phia ! model after 3D field (to be updated), must be masked
TYPE(OBC_INDEX), INTENT(in ) :: idx ! OBC indices
LOGICAL , INTENT(in ) :: lrim0 ! indicate if rim 0 is treated
!!
diff --git a/src/OCE/BDY/bdytides.F90 b/src/OCE/BDY/bdytides.F90
index 731214e7f76a32f63f0e9e3296b512354761286e..0c14f5ba2dcef0e64e0ce5d8771194b8377a48ca 100644
--- a/src/OCE/BDY/bdytides.F90
+++ b/src/OCE/BDY/bdytides.F90
@@ -474,4 +474,3 @@ CONTAINS
!!======================================================================
END MODULE bdytides
-
diff --git a/src/OCE/BDY/bdytra.F90 b/src/OCE/BDY/bdytra.F90
index 333fdf7f3f21d73a24ff0642aef7d988020e46e1..a4cf4117beab1194b14813bdf20d3fa7eea8123e 100644
--- a/src/OCE/BDY/bdytra.F90
+++ b/src/OCE/BDY/bdytra.F90
@@ -49,7 +49,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in) :: kt ! Main time step counter
INTEGER , INTENT(in) :: Kbb, Kaa ! time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! tracer fields
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! tracer fields
!
INTEGER :: ib_bdy, jn, igrd, ir ! Loop indeces
TYPE(ztrabdy), DIMENSION(jpts) :: zdta ! Temporary data structure
@@ -100,7 +100,7 @@ CONTAINS
END SELECT
END DO
IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN ! if need to send/recv in at least one direction
- CALL lbc_lnk( 'bdytra', pts(:,:,:,jn,Kaa), 'T', 1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
+ CALL lbc_lnk( 'bdytra', pts(:,:,:,jn,Kaa), 'T', 1.0_dp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
ENDIF
!
END DO ! ir
@@ -118,7 +118,7 @@ CONTAINS
!!
!!----------------------------------------------------------------------
TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt ! tracer trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt ! tracer trend
INTEGER, INTENT(in) :: jpa ! TRA index
LOGICAL, INTENT(in) :: llrim0 ! indicate if rim 0 is treated
!
@@ -149,7 +149,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in) :: kt ! time step
INTEGER , INTENT(in) :: Kbb, 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
!
REAL(wp) :: zwgt ! boundary weight
REAL(wp) :: zta, zsa, ztime
diff --git a/src/OCE/C1D/dtauvd.F90 b/src/OCE/C1D/dtauvd.F90
index fc64c2583bd213ec5dd3747470854a7ab020d2cc..b91d1a9960a990bc171e046b3ac8c3e5f6248c81 100644
--- a/src/OCE/C1D/dtauvd.F90
+++ b/src/OCE/C1D/dtauvd.F90
@@ -134,8 +134,8 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time-step
INTEGER , INTENT(in ) :: Kmm ! time level index
- REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pud ! U & V current data
- REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pvd ! U & V current data
+ REAL(dp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pud ! U & V current data
+ REAL(dp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pvd ! U & V current data
!
INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies
INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers
diff --git a/src/OCE/C1D/dyndmp.F90 b/src/OCE/C1D/dyndmp.F90
index 5cfd953c9a7c36ab96d5847893a6c7ae151d5087..cc335dc780de2d0b7811d41ce7cb6f8c80767680 100644
--- a/src/OCE/C1D/dyndmp.F90
+++ b/src/OCE/C1D/dyndmp.F90
@@ -148,11 +148,11 @@ 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,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zua, zva ! local scalars
- REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: zuv_dta ! Read in data
+ REAL(dp), DIMENSION(jpi,jpj,jpk,2) :: zuv_dta ! Read in data
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start( 'dyn_dmp' )
diff --git a/src/OCE/CRS/crs.F90 b/src/OCE/CRS/crs.F90
index 652c9f12a02d93301f0c3d2c7f99c085d4c7dd7b..a81f4b342e7e8ecc76d7a490ee73b3127bdb2c95 100644
--- a/src/OCE/CRS/crs.F90
+++ b/src/OCE/CRS/crs.F90
@@ -316,4 +316,3 @@ CONTAINS
!!======================================================================
END MODULE crs
-
diff --git a/src/OCE/CRS/crsdom.F90 b/src/OCE/CRS/crsdom.F90
index bd2225b3bb60937e1174f2c7980bd7ee5300f1fe..3cf4192128f02ae13fd97a874fefd1a2f5bec067 100644
--- a/src/OCE/CRS/crsdom.F90
+++ b/src/OCE/CRS/crsdom.F90
@@ -245,8 +245,8 @@ CONTAINS
!!----------------------------------------------------------------
!!
!! Arguments
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: p_e1 ! Parent grid U,V scale factors (e1)
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: p_e2 ! Parent grid U,V scale factors (e2)
+ REAL(dp), DIMENSION(jpi,jpj) , INTENT(in) :: p_e1 ! Parent grid U,V scale factors (e1)
+ REAL(dp), DIMENSION(jpi,jpj) , INTENT(in) :: p_e2 ! Parent grid U,V scale factors (e2)
CHARACTER(len=1) , INTENT(in) :: cd_type ! grid type U,V
REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(out) :: p_e1_crs ! Coarse grid box 2D quantity
@@ -342,8 +342,8 @@ CONTAINS
!!----------------------------------------------------------------
CHARACTER(len=1), INTENT(in ) :: cd_type ! grid type U,V
REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: p_mask ! Parent grid U,V mask
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: p_e1 ! Parent grid U,V scale factors (e1)
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: p_e2 ! Parent grid U,V scale factors (e2)
+ REAL(dp), DIMENSION(jpi,jpj) , INTENT(in ) :: p_e1 ! Parent grid U,V scale factors (e1)
+ REAL(dp), DIMENSION(jpi,jpj) , INTENT(in ) :: p_e2 ! Parent grid U,V scale factors (e2)
REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: p_e3 ! Parent grid vertical level thickness (e3u, e3v)
REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT( out) :: p_fld1_crs ! Coarse grid box 3D quantity
REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT( out) :: p_fld2_crs ! Coarse grid box 3D quantity
@@ -473,7 +473,7 @@ CONTAINS
CHARACTER(len=3), INTENT(in) :: cd_op ! Operation SUM, MAX or MIN
CHARACTER(len=1), INTENT(in) :: cd_type ! grid type U,V
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask ! Parent grid T,U,V mask
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: p_e12 ! Parent grid T,U,V scale factors (e1 or e2)
+ REAL(dp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: p_e12 ! Parent grid T,U,V scale factors (e1 or e2)
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3 ! Parent grid vertical level thickness (e3u, e3v)
REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator
REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs ! Coarse grid T,U,V maska
@@ -1135,7 +1135,7 @@ CONTAINS
CHARACTER(len=3), INTENT(in) :: cd_op ! Operation SUM, MAX or MIN
CHARACTER(len=1), INTENT(in) :: cd_type ! grid type U,V
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask ! Parent grid T,U,V mask
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: p_e12 ! Parent grid T,U,V scale factors (e1 or e2)
+ REAL(dp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: p_e12 ! Parent grid T,U,V scale factors (e1 or e2)
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3 ! Parent grid vertical level thickness (e3u, e3v)
REAL(wp), DIMENSION(jpi_crs,jpj_crs) , INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator
REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs ! Coarse grid T,U,V mask
@@ -1630,7 +1630,7 @@ CONTAINS
!! Arguments
CHARACTER(len=1), INTENT(in) :: cd_type ! grid type T, W ( U, V, F)
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask ! Parent grid T mask
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: p_e1, p_e2 ! 2D tracer T or W on parent grid
+ REAL(dp), DIMENSION(jpi,jpj) , INTENT(in) :: p_e1, p_e2 ! 2D tracer T or W on parent grid
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_e3 ! 3D tracer T or W on parent grid
REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in) :: p_sfc_crs ! Coarse grid box east or north face quantity
REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: p_e3_crs ! Coarse grid box east or north face quantity
diff --git a/src/OCE/CRS/crsdomwri.F90 b/src/OCE/CRS/crsdomwri.F90
index 18be27381814986bc867e0c4191fd1ccc23d76e7..333e23b9e4af9feaa66657abda9b5e4db99886a6 100644
--- a/src/OCE/CRS/crsdomwri.F90
+++ b/src/OCE/CRS/crsdomwri.F90
@@ -201,5 +201,3 @@ CONTAINS
!!======================================================================
END MODULE crsdomwri
-
-
diff --git a/src/OCE/CRS/crsfld.F90 b/src/OCE/CRS/crsfld.F90
index b8115048d68e1faff79a13d65c186ca77fb2a250..b2cb6e734d6688c1f8421a50e7caa8e7ca9dc11f 100644
--- a/src/OCE/CRS/crsfld.F90
+++ b/src/OCE/CRS/crsfld.F90
@@ -32,6 +32,7 @@ MODULE crsfld
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -116,30 +117,30 @@ CONTAINS
CALL iom_put( "sss" , tsn_crs(:,:,1,jp_sal) ) ! sss
! U-velocity
- CALL crs_dom_ope( uu(:,:,:,Kmm), 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
+ CALL crs_dom_ope( CASTSP(uu(:,:,:,Kmm)), 'SUM', 'U', umask, un_crs, p_e12=CASTDP(e2u), p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
!
zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zt(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) )
zs(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) )
END_3D
- CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
- CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
+ CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=CASTDP(e2u), p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
+ CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=CASTDP(e2u), p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
CALL iom_put( "uoce" , un_crs ) ! i-current
CALL iom_put( "uocet" , zt_crs ) ! uT
CALL iom_put( "uoces" , zs_crs ) ! uS
! V-velocity
- CALL crs_dom_ope( vv(:,:,:,Kmm), 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
+ CALL crs_dom_ope( CASTSP(vv(:,:,:,Kmm)), 'SUM', 'V', vmask, vn_crs, p_e12=CASTDP(e1v), p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
!
zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zt(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) )
zs(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) )
END_3D
- CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
- CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
+ CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=CASTDP(e1v), p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
+ CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=CASTDP(e1v), p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
CALL iom_put( "voce" , vn_crs ) ! i-current
CALL iom_put( "vocet" , zt_crs ) ! vT
@@ -210,9 +211,9 @@ CONTAINS
CALL iom_put( "avs", avs_crs ) ! Kz on S
! sbc fields
- CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0_wp )
- CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0_wp )
- CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0_wp )
+ CALL crs_dom_ope( CASTSP(ssh(:,:,Kmm)) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0_wp )
+ CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=CASTDP(e2u) , p_surf_crs=e2u_crs , psgn=1.0_wp )
+ CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=CASTDP(e1v) , p_surf_crs=e1v_crs , psgn=1.0_wp )
CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp )
CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs , psgn=1.0_wp )
CALL crs_dom_ope( qsr , 'SUM', 'T', tmask, qsr_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp )
diff --git a/src/OCE/CRS/crsini.F90 b/src/OCE/CRS/crsini.F90
index f31fad263d538d1250f320ac6614b5d6429179a1..9f551b52ee71cce536e8cb96d2ecffab20e8f874 100644
--- a/src/OCE/CRS/crsini.F90
+++ b/src/OCE/CRS/crsini.F90
@@ -28,6 +28,7 @@ MODULE crsini
PUBLIC crs_init ! called by nemogcm.F90 module
!! * Substitutions
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -153,8 +154,8 @@ CONTAINS
! 3.c.1 Horizontal scale factors
CALL crs_dom_hgr( e1t, e2t, 'T', e1t_crs, e2t_crs )
- CALL crs_dom_hgr( e1u, e2u, 'U', e1u_crs, e2u_crs )
- CALL crs_dom_hgr( e1v, e2v, 'V', e1v_crs, e2v_crs )
+ CALL crs_dom_hgr( e1u, CASTDP(e2u), 'U', e1u_crs, e2u_crs )
+ CALL crs_dom_hgr( CASTDP(e1v), e2v, 'V', e1v_crs, e2v_crs )
CALL crs_dom_hgr( e1f, e2f, 'F', e1f_crs, e2f_crs )
e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:)
@@ -183,7 +184,7 @@ CONTAINS
END DO
! 3.d.2 Surfaces
- CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t )
+ CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=CASTSP(e1t), p_e2=CASTSP(e2t) )
CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=ze3u )
CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=ze3v )
@@ -193,8 +194,8 @@ CONTAINS
! 3.d.3 Vertical scale factors
!
CALL crs_dom_e3( e1t, e2t, ze3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs)
- CALL crs_dom_e3( e1u, e2u, ze3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs)
- CALL crs_dom_e3( e1v, e2v, ze3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)
+ CALL crs_dom_e3( e1u, CASTDP(e2u), ze3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs)
+ CALL crs_dom_e3( CASTDP(e1v), e2v, ze3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)
CALL crs_dom_e3( e1t, e2t, ze3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)
! Replace 0 by e3t_0 or e3w_0
diff --git a/src/OCE/DIA/dia25h.F90 b/src/OCE/DIA/dia25h.F90
index 418f54d16f9f13a50034b29ad5f07fc8dbd43e4b..8c3161eabb8b50f6526cb30502b56be55b23f4ee 100644
--- a/src/OCE/DIA/dia25h.F90
+++ b/src/OCE/DIA/dia25h.F90
@@ -140,7 +140,7 @@ CONTAINS
INTEGER :: ji, jj, jk
INTEGER :: iyear0, nimonth0,iday0 ! start year,imonth,day
LOGICAL :: ll_print = .FALSE. ! =T print and flush numout
- REAL(wp) :: zsto, zout, zmax, zjulian, zmdi ! local scalars
+ REAL(dp) :: zsto, zout, zmax, zjulian, zmdi ! local scalars
INTEGER :: i_steps ! no of timesteps per hour
REAL(wp), DIMENSION(A2D(0) ) :: zw2d, un_dm, vn_dm ! workspace
REAL(wp), DIMENSION(A2D(0),jpk) :: zw3d ! workspace
diff --git a/src/OCE/DIA/diaar5.F90 b/src/OCE/DIA/diaar5.F90
index d54e24b06874668d7b6a97ce09950718b529f6d2..38e70c73fef6886972f9b99e797e3d63eb3e4cb8 100644
--- a/src/OCE/DIA/diaar5.F90
+++ b/src/OCE/DIA/diaar5.F90
@@ -38,6 +38,7 @@ MODULE diaar5
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -117,7 +118,7 @@ CONTAINS
!
IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) ) THEN
! ! total volume of liquid seawater
- zvolssh = glob_sum( 'diaar5', zarea_ssh(:,:) )
+ zvolssh =glob_sum( 'diaar5', CASTDP(zarea_ssh(:,:)) )
zvol = vol0 + zvolssh
CALL iom_put( 'voltot', zvol )
@@ -134,7 +135,7 @@ CONTAINS
DO jk = 1, jpk
zgdept(:,:,jk) = gdept(:,:,jk,Kmm)
END DO
- CALL eos( ztsn, zrhd, zgdept) ! now in situ density using initial salinity
+ CALL eos( CASTDP(ztsn), zrhd, zgdept) ! now in situ density using initial salinity
!
zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice
DO jk = 1, jpkm1
@@ -212,8 +213,8 @@ CONTAINS
END IF
ENDIF
!
- ztemp = glob_sum( 'diaar5', ztsn(:,:,1,jp_tem) )
- zsal = glob_sum( 'diaar5', ztsn(:,:,1,jp_sal) )
+ ztemp =glob_sum( 'diaar5', CASTDP(ztsn(:,:,1,jp_tem)) )
+ zsal =glob_sum( 'diaar5', CASTDP(ztsn(:,:,1,jp_sal)) )
zmass = rho0 * ( zarho + zvol )
!
CALL iom_put( 'masstot', zmass )
@@ -229,7 +230,7 @@ CONTAINS
ALLOCATE( ztpot(jpi,jpj,jpk) )
ztpot(:,:,jpk) = 0._wp
DO jk = 1, jpkm1
- ztpot(:,:,jk) = eos_pt_from_ct( ts(:,:,jk,jp_tem,Kmm), ts(:,:,jk,jp_sal,Kmm) )
+ ztpot(:,:,jk) =eos_pt_from_ct( CASTSP(ts(:,:,jk,jp_tem,Kmm)), CASTSP(ts(:,:,jk,jp_sal,Kmm)) )
END DO
!
CALL iom_put( 'toce_pot', ztpot(:,:,:) ) ! potential temperature (TEOS-10 case)
@@ -240,7 +241,7 @@ CONTAINS
DO jk = 1, jpkm1
z2d(:,:) = z2d(:,:) + e1e2t(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk)
END DO
- ztemp = glob_sum( 'diaar5', z2d(:,:) )
+ ztemp =glob_sum( 'diaar5', CASTDP(z2d(:,:)) )
CALL iom_put( 'temptot_pot', ztemp / zvol )
ENDIF
!
@@ -388,7 +389,7 @@ CONTAINS
zvol0 (ji,jj) = zvol0 (ji,jj) + zztmp * e1e2t(ji,jj)
thick0(ji,jj) = thick0(ji,jj) + zztmp
END_3D
- vol0 = glob_sum( 'diaar5', zvol0 )
+ vol0 =glob_sum( 'diaar5', CASTDP(zvol0) )
DEALLOCATE( zvol0 )
IF( iom_use( 'sshthster' ) ) THEN
diff --git a/src/OCE/DIA/diacfl.F90 b/src/OCE/DIA/diacfl.F90
index e35764b3b7894d41c45d1d7098dc640d0b5b97f8..ce855a17eb5b9e3d166f9e5df099875dd8587d86 100644
--- a/src/OCE/DIA/diacfl.F90
+++ b/src/OCE/DIA/diacfl.F90
@@ -33,6 +33,7 @@ MODULE diacfl
!! * 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,11 @@ CONTAINS
! ! calculate maximum values and locations
llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain
- CALL mpp_maxloc( 'diacfl', zCu_cfl, llmsk, zCu_max, iloc_u )
+ CALL mpp_maxloc( 'diacfl', CASTDP(zCu_cfl), llmsk, zCu_max, iloc_u )
llmsk(Nis0:Nie0,Njs0:Nje0,:) = vmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain
- CALL mpp_maxloc( 'diacfl', zCv_cfl, llmsk, zCv_max, iloc_v )
+ CALL mpp_maxloc( 'diacfl', CASTDP(zCv_cfl), llmsk, zCv_max, iloc_v )
llmsk(Nis0:Nie0,Njs0:Nje0,:) = wmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain
- CALL mpp_maxloc( 'diacfl', zCw_cfl, llmsk, zCw_max, iloc_w )
+ CALL mpp_maxloc( 'diacfl', CASTDP(zCw_cfl), llmsk, zCw_max, iloc_w )
!
IF( lwp ) THEN ! write out to file
WRITE(numcfl,FMT='(2x,i6,3x,a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zCu_max, iloc_u(1), iloc_u(2), iloc_u(3)
diff --git a/src/OCE/DIA/diadct.F90 b/src/OCE/DIA/diadct.F90
index 4fa5479f4bd09776fc96de18b9919e0a569515f7..8b3d04026d3244e40b9b7a1a3c05234017c68a66 100644
--- a/src/OCE/DIA/diadct.F90
+++ b/src/OCE/DIA/diadct.F90
@@ -90,6 +90,7 @@ MODULE diadct
!! * Substitutions
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -678,13 +679,13 @@ CONTAINS
ztn = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_tem,Kmm) )
zsn = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) )
zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop)
- zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rho0+rho0)
+ zrhoi =interp(Kmm,k%I,k%J,jk,'V',CASTDP(rhd*rho0+rho0))
zsshn = 0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I,k%J+1,Kmm) ) * vmask(k%I,k%J,1)
CASE(2,3)
ztn = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_tem,Kmm) )
zsn = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) )
zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop)
- zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rho0+rho0)
+ zrhoi =interp(Kmm,k%I,k%J,jk,'U',CASTDP(rhd*rho0+rho0))
zsshn = 0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I+1,k%J,Kmm) ) * umask(k%I,k%J,1)
END SELECT
!
@@ -851,13 +852,13 @@ CONTAINS
ztn = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_tem,Kmm) )
zsn = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) )
zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop)
- zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rho0+rho0)
+ zrhoi =interp(Kmm,k%I,k%J,jk,'V',CASTDP(rhd*rho0+rho0))
CASE(2,3)
ztn = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_tem,Kmm) )
zsn = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) )
zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop)
- zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rho0+rho0)
+ zrhoi =interp(Kmm,k%I,k%J,jk,'U',CASTDP(rhd*rho0+rho0))
zsshn = 0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I+1,k%J,Kmm) ) * umask(k%I,k%J,1)
END SELECT
@@ -1168,7 +1169,7 @@ CONTAINS
INTEGER, INTENT(IN) :: Kmm ! time level index
INTEGER, INTENT(IN) :: ki, kj, kk ! coordinate of point
CHARACTER(len=1), INTENT(IN) :: cd_point ! type of point (U, V)
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: ptab ! variable to compute at (ki, kj, kk )
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: ptab ! variable to compute at (ki, kj, kk )
REAL(wp) :: interp ! interpolated variable
!*local declations
diff --git a/src/OCE/DIA/diadetide.F90 b/src/OCE/DIA/diadetide.F90
index 9d6760039a2f2443cab467c820fbe58863e3eac1..fffe40cd3080d3214421c8b2371d87a1e782d12c 100644
--- a/src/OCE/DIA/diadetide.F90
+++ b/src/OCE/DIA/diadetide.F90
@@ -5,6 +5,7 @@ MODULE diadetide
!!======================================================================
!! History : ! 2019 (S. Mueller)
!!----------------------------------------------------------------------
+ USE par_kind
USE par_oce , ONLY : wp, jpi, jpj
USE in_out_manager , ONLY : lwp, numout
USE iom , ONLY : iom_put
diff --git a/src/OCE/DIA/diahsb.F90 b/src/OCE/DIA/diahsb.F90
index f9307c0af070e90c518583828d0158fa46ea0a0f..b6e85fae76aa75300da1260234006ca85f8b089c 100644
--- a/src/OCE/DIA/diahsb.F90
+++ b/src/OCE/DIA/diahsb.F90
@@ -40,17 +40,21 @@ MODULE diahsb
LOGICAL, PUBLIC :: ln_diahsb !: check the heat and salt budgets
REAL(wp) :: surf_tot ! ocean surface
- REAL(wp) :: frc_t, frc_s, frc_v ! global forcing trends
+ REAL(wp) :: frc_s! global forcing trends
+ REAL(dp) :: frc_t, frc_v! global forcing trends
REAL(wp) :: frc_wn_t, frc_wn_s ! global forcing trends
!
- REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf
- REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf_ini , ssh_ini !
+ REAL(dp), DIMENSION(:,:) , ALLOCATABLE :: surf
+ REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_ini!
+ REAL(dp), DIMENSION(:,:) , ALLOCATABLE :: surf_ini!
REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini !
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini, sc_loc_ini, e3t_ini !
+ REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini!
+ REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: sc_loc_ini, e3t_ini!
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_ini
!! * Substitutions
# include "domzgr_substitute.h90"
+# include "single_precision_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: diahsb.F90 15062 2021-06-28 11:19:48Z jchanut $
@@ -75,16 +79,16 @@ CONTAINS
INTEGER :: ji, jj, jk ! dummy loop indice
REAL(wp) :: zdiff_hc , zdiff_sc ! heat and salt content variations
REAL(wp) :: zdiff_hc1 , zdiff_sc1 ! - - - -
- REAL(wp) :: zdiff_v1 , zdiff_v2 ! volume variation
+ REAL(dp) :: zdiff_v1 , zdiff_v2 ! volume variation
REAL(wp) :: zerr_hc1 , zerr_sc1 ! heat and salt content misfit
REAL(wp) :: zvol_tot ! volume
REAL(wp) :: z_frc_trd_t , z_frc_trd_s ! - -
- REAL(wp) :: z_frc_trd_v ! - -
+ REAL(dp) :: z_frc_trd_v ! - -
REAL(wp) :: z_wn_trd_t , z_wn_trd_s ! - -
REAL(wp) :: z_ssh_hc , z_ssh_sc ! - -
- REAL(wp), DIMENSION(jpi,jpj,13) :: ztmp
- REAL(wp), DIMENSION(jpi,jpj,jpkm1,4) :: ztmpk
- REAL(wp), DIMENSION(17) :: zbg
+ REAL(dp), DIMENSION(jpi,jpj,13) :: ztmp
+ REAL(dp), DIMENSION(jpi,jpj,jpkm1,4) :: ztmpk
+ REAL(dp), DIMENSION(17) :: zbg
!!---------------------------------------------------------------------------
IF( ln_timing ) CALL timing_start('dia_hsb')
!
diff --git a/src/OCE/DIA/diahth.F90 b/src/OCE/DIA/diahth.F90
index 0b8650acf6c31eacf0ef56eb870ebf898a7aee5f..26c97b7dff6b7fffa247c568d1fc887c811d6741 100644
--- a/src/OCE/DIA/diahth.F90
+++ b/src/OCE/DIA/diahth.F90
@@ -342,7 +342,7 @@ CONTAINS
!
INTEGER , INTENT(in) :: Kmm ! ocean time level index
REAL(wp), INTENT(in) :: pdep ! depth over the heat content
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pt
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pt
REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: phtc
!
INTEGER :: ji, jj, jk, ik
diff --git a/src/OCE/DIA/diamlr.F90 b/src/OCE/DIA/diamlr.F90
index edd8e19f99b0b6da90be9c07bc91a6aa73108144..0b3010d1b019d082cd33136d30fdf66c31d568fd 100644
--- a/src/OCE/DIA/diamlr.F90
+++ b/src/OCE/DIA/diamlr.F90
@@ -5,7 +5,7 @@ MODULE diamlr
!!======================================================================
!! History : 4.0 ! 2019 (S. Mueller) Original code
!!----------------------------------------------------------------------
-
+ USE par_kind
USE par_oce , ONLY : wp, jpi, jpj
USE phycst , ONLY : rpi
USE dom_oce , ONLY : adatrj
diff --git a/src/OCE/DIA/dianam.F90 b/src/OCE/DIA/dianam.F90
index a3b3bfb92cba961498bc3a18c534cbaf376775cd..2d0df4f4f147ac1d7a69d534f6782cac9bb0a881 100644
--- a/src/OCE/DIA/dianam.F90
+++ b/src/OCE/DIA/dianam.F90
@@ -60,8 +60,8 @@ CONTAINS
INTEGER :: inbday, inbmo, inbyr ! output frequency in days, months and years
INTEGER :: iyyss, iddss, ihhss, immss ! number of seconds in 1 year, 1 day, 1 hour and 1 minute
INTEGER :: iyymo ! number of months in 1 year
- REAL(wp) :: zsec1, zsec2 ! not used
- REAL(wp) :: zdrun, zjul ! temporary scalars
+ REAL(dp) :: zsec1, zsec2 ! not used
+ REAL(dp) :: zdrun, zjul ! temporary scalars
!!----------------------------------------------------------------------
! name for output frequency
diff --git a/src/OCE/DIA/diaptr.F90 b/src/OCE/DIA/diaptr.F90
index 501e54f637e7d9ea4b48e51f6cf080dfb3ac659a..6cbbd447d480a2541fbd6c8f29adee7f18e18253 100644
--- a/src/OCE/DIA/diaptr.F90
+++ b/src/OCE/DIA/diaptr.F90
@@ -87,13 +87,14 @@ CONTAINS
IF( l_diaptr ) THEN
! Calculate zonal integrals
IF( PRESENT( pvtr ) ) THEN
- CALL dia_ptr_zint( Kmm, pvtr )
+ CALL dia_ptr_zint( Kmm, pvtr)
ELSE
CALL dia_ptr_zint( Kmm )
ENDIF
! Calculate diagnostics only when zonal integrals have finished
IF( .NOT. l_istiled .OR. ntile == nijtile ) CALL dia_ptr_iom(kt, Kmm, pvtr)
+
ENDIF
IF( ln_timing ) CALL timing_stop('dia_ptr')
diff --git a/src/OCE/DIA/diawri.F90 b/src/OCE/DIA/diawri.F90
index db5da93a7cc7f9a1d61498a55c689bc90aa7c231..3d851bd220fbf446f8495c117e4d2d0149b9e6af 100644
--- a/src/OCE/DIA/diawri.F90
+++ b/src/OCE/DIA/diawri.F90
@@ -580,7 +580,7 @@ CONTAINS
INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers
INTEGER :: ipka ! ABL
INTEGER :: jn, ierror ! local integers
- REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars
+ REAL(dp) :: zsto, zout, zmax, zjulian ! local scalars
!
REAL(wp), DIMENSION(jpi,jpj ) :: z2d ! 2D workspace
REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace
diff --git a/src/OCE/DIU/diu_bulk.F90 b/src/OCE/DIU/diu_bulk.F90
index af1e5adfe07324c0879beae01aab78fab3d9ab9a..28e321f151f4b99fda3647084790af1d0c4756d1 100644
--- a/src/OCE/DIU/diu_bulk.F90
+++ b/src/OCE/DIU/diu_bulk.F90
@@ -96,9 +96,9 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: psolflux ! solar flux (Watts)
REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: pqflux ! heat (non-solar) flux (Watts)
REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: ptauflux ! wind stress (kg/ m s^2)
- REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: prho ! water density (kg/m^3)
+ REAL(dp), DIMENSION(jpi,jpj) , INTENT(in) :: prho ! water density (kg/m^3)
REAL(wp) , INTENT(in) :: p_rdt ! time-step
- REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pLa ! Langmuir number
+ REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pla ! Langmuir number
REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pthick ! warm layer thickness (m)
REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pcoolthick ! cool skin thickness (m)
REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pmu ! mu parameter
@@ -185,7 +185,7 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fla ! Langmuir number
REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pmu ! Structure parameter
REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pthick ! Layer thickness
- REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: prho ! Water density
+ REAL(dp), DIMENSION(jpi,jpj), INTENT(IN) :: prho ! Water density
! Local variables
REAL(wp) :: z_olength ! Obukhov length
diff --git a/src/OCE/DIU/diu_coolskin.F90 b/src/OCE/DIU/diu_coolskin.F90
index 594a8b13ade4ae1d7739574244cd3f5b547a1e73..2ba2c21b1a4487a7fa2e56e81d5ef7191d4b5b13 100644
--- a/src/OCE/DIU/diu_coolskin.F90
+++ b/src/OCE/DIU/diu_coolskin.F90
@@ -79,7 +79,7 @@ MODULE diu_coolskin
! Dummy variables
REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psqflux ! Heat (non-solar)(Watts)
REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pstauflux ! Wind stress (kg/ m s^2)
- REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho ! Water density (kg/m^3)
+ REAL(dp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho ! Water density (kg/m^3)
REAL(wp), INTENT(IN) :: pDt ! Time-step
! Local variables
diff --git a/src/OCE/DIU/solfrac_mod.F90 b/src/OCE/DIU/solfrac_mod.F90
index 4df5c6eca640461a07dc7bfe828a08f7f44e6a57..d5af825addc5cad16efd8e9042f71d87258cb2a8 100644
--- a/src/OCE/DIU/solfrac_mod.F90
+++ b/src/OCE/DIU/solfrac_mod.F90
@@ -51,6 +51,6 @@ CONTAINS
& - exp ( -pbottom / pp_len(jt) ) )
END DO
- END FUNCTION
+ END FUNCTION solfrac
END MODULE solfrac_mod
diff --git a/src/OCE/DOM/closea.F90 b/src/OCE/DOM/closea.F90
index eb523c63cc6067ec513a5d2cf23378fcc2b2d80f..98386a3597646fcd0e9829844575c6d94b3083ce 100644
--- a/src/OCE/DOM/closea.F90
+++ b/src/OCE/DOM/closea.F90
@@ -258,6 +258,6 @@ CONTAINS
ALLOCATE( kmask(jpi,jpj) , STAT=ierr )
IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'alloc_csmask: failed to allocate surf array')
!
- END SUBROUTINE
+ END SUBROUTINE alloc_csmask
END MODULE closea
diff --git a/src/OCE/DOM/daymod.F90 b/src/OCE/DOM/daymod.F90
index fd59353dcac70b753c241bc29f441f4826ac7147..39e2db30aac49b48c8b8235742d8451e0d909f5e 100644
--- a/src/OCE/DOM/daymod.F90
+++ b/src/OCE/DOM/daymod.F90
@@ -68,7 +68,7 @@ CONTAINS
!! - nmonth_len, nyear_len, nmonth_beg through day_mth
!!----------------------------------------------------------------------
INTEGER :: inbday, imonday, isecrst ! local integers
- REAL(wp) :: zjul ! local scalar
+ REAL(dp) :: zjul ! local scalar
!!----------------------------------------------------------------------
!
! max number of seconds between each restart
@@ -93,7 +93,7 @@ CONTAINS
nminute = ( nn_time0 - nhour * 100 )
isecrst = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss)
- CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,wp), fjulday )
+ CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,dp), fjulday )
IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error
IF( nhour*NINT(rhhmm*rmmss) + nminute*NINT(rmmss) - ndt05 .LT. 0 ) fjulday = fjulday+1. ! move back to the day at nit000 (and not at nit000 - 1)
@@ -115,7 +115,8 @@ CONTAINS
nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )
!compute number of days between last Monday and today
- CALL ymds2ju( 1900, 01, 01, 0.0_wp, zjul ) ! compute julian day value of 01.01.1900 (our reference that was a Monday)
+ CALL ymds2ju( 1900, 01, 01, 0.0_dp, zjul ) ! compute julian day value of 01.01.1900 (our reference that was a Monday)
+
inbday = FLOOR(fjulday - zjul) ! compute nb day between 01.01.1900 and start of current day
imonday = MOD(inbday, 7) ! compute nb day between last monday and current day
IF (imonday .LT. 0) imonday = imonday + 7 ! Avoid negative values for dates before 01.01.1900
@@ -198,7 +199,7 @@ CONTAINS
nmonth_beg(jm) = nmonth_beg(jm+1) - nsecd * nmonth_len(jm)
END DO
!
- END SUBROUTINE
+ END SUBROUTINE day_mth
SUBROUTINE day( kt )
@@ -220,7 +221,7 @@ CONTAINS
INTEGER, INTENT(in) :: kt ! ocean time-step indices
!
CHARACTER (len=25) :: charout
- REAL(wp) :: zprec ! fraction of day corresponding to 0.1 second
+ REAL(dp) :: zprec ! fraction of day corresponding to 0.1 second
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('day')
@@ -259,7 +260,7 @@ CONTAINS
ndastp = nyear * 10000 + nmonth * 100 + nday ! New date
!
!compute first day of the year in julian days
- CALL ymds2ju( nyear, 01, 01, 0.0_wp, fjulstartyear )
+ CALL ymds2ju( nyear, 01, 01, 0.0_dp, fjulstartyear )
!
IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt, &
& ' New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, ' nday_year = ', nday_year
@@ -310,7 +311,7 @@ CONTAINS
INTEGER , INTENT(in) :: kt ! ocean time-step
CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
!
- REAL(wp) :: zkt, zndastp, zdayfrac, ksecs, ktime
+ REAL(dp) :: zkt, zndastp, zdayfrac, ksecs, ktime
INTEGER :: ihour, iminute, isecond
!!----------------------------------------------------------------------
diff --git a/src/OCE/DOM/depth_e3.F90 b/src/OCE/DOM/depth_e3.F90
index d4fec2f420ed9c70eebe78cc5f0a5739f260a30f..6b2090dd3e564aa7e845220ffc97c08bb9b2279c 100644
--- a/src/OCE/DOM/depth_e3.F90
+++ b/src/OCE/DOM/depth_e3.F90
@@ -143,7 +143,8 @@ CONTAINS
!!
!! ** Action : - pe3t_1d, pe3w_1d : scale factor of t- and w-point (m)
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pe3t_3d , pe3w_3d ! vert. scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pe3w_3d! vert. scale factors [m]
+ REAL(dp), DIMENSION(:,:,:), INTENT(in ) :: pe3t_3d! vert. scale factors [m]
REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pdept_3d, pdepw_3d ! depth = SUM( e3 ) [m]
!
INTEGER :: jk ! dummy loop indices
diff --git a/src/OCE/DOM/dom_oce.F90 b/src/OCE/DOM/dom_oce.F90
index d61ac9bb059de44ef249a9b3c9318b473d7b6a7e..32379ee0df99ac027a04d23a12a7cb4ba51036f9 100644
--- a/src/OCE/DOM/dom_oce.F90
+++ b/src/OCE/DOM/dom_oce.F90
@@ -100,12 +100,16 @@ MODULE dom_oce
!! ---------------------------------------------------------------------
REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: glamt , glamu, glamv , glamf !: longitude at t, u, v, f-points [degree]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: gphit , gphiu, gphiv , gphif !: latitude at t, u, v, f-points [degree]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1t , e2t , r1_e1t, r1_e2t !: t-point horizontal scale factors [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1u , e2u , r1_e1u, r1_e2u !: horizontal scale factors at u-point [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1v , e2v , r1_e1v, r1_e2v !: horizontal scale factors at v-point [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1f , e2f , r1_e1f, r1_e2f !: horizontal scale factors at f-point [m]
+ 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, r1_e1u, r1_e2u!: horizontal scale factors at u-point [m]
+ REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1u!: horizontal scale factors at u-point [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1v, r1_e1v, r1_e2v!: horizontal scale factors at v-point [m]
+ REAL(dp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: 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(:,:) :: e1e2t , r1_e1e2t !: associated metrics at t-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(:,:) :: e1e2f , r1_e1e2f !: associated metrics at f-point
@@ -130,7 +134,7 @@ MODULE dom_oce
LOGICAL, PUBLIC :: ln_sco !: s-coordinate or hybrid z-s coordinate
LOGICAL, PUBLIC :: ln_isfcav !: presence of ISF
! ! reference scale factors
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_0 !: t- vert. scale factor [m]
+ REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_0 !: t- vert. scale factor [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3u_0 !: u- vert. scale factor [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v_0 !: v- vert. scale factor [m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f_0 !: f- vert. scale factor [m]
@@ -145,9 +149,11 @@ MODULE dom_oce
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f !: F-point vert. scale factor [m]
#endif
! ! time-dependent ratio ssh / h_0 (domqco)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: r3t, r3u, r3v !: time-dependent ratio at t-, u- and v-point [-]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: r3u, r3v!: time-dependent ratio at t-, u- and v-point [-]
+ REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: r3t!: time-dependent ratio at t-, u- and v-point [-]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3f !: mid-time-level ratio at f-point [-]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3t_f, r3u_f, r3v_f !: now time-filtered ratio at t-, u- and v-point [-]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3u_f, r3v_f!: now time-filtered ratio at t-, u- and v-point [-]
+ REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3t_f!: now time-filtered ratio at t-, u- and v-point [-]
! ! reference depths of cells
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_0 !: t- depth [m]
@@ -161,7 +167,7 @@ MODULE dom_oce
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w
#endif
! ! reference heights of ocean water column and its inverse
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0, r1_ht_0 !: t-depth [m] and [1/m]
+ REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0, r1_ht_0 !: t-depth [m] and [1/m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0, r1_hu_0 !: u-depth [m] and [1/m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hv_0, r1_hv_0 !: v-depth [m] and [1/m]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hf_0, r1_hf_0 !: f-depth [m] and [1/m]
@@ -216,8 +222,8 @@ MODULE dom_oce
INTEGER , PUBLIC :: nsec_month !: seconds between 00h 1st day of the current month and half of the current time step
INTEGER , PUBLIC :: nsec_monday !: seconds between 00h of the last Monday and half of the current time step
INTEGER , PUBLIC :: nsec_day !: seconds between 00h of the current day and half of the current time step
- REAL(wp), PUBLIC :: fjulday !: current julian day
- REAL(wp), PUBLIC :: fjulstartyear !: first day of the current year in julian days
+ REAL(dp), PUBLIC :: fjulday !: current julian day
+ REAL(dp), PUBLIC :: fjulstartyear !: first day of the current year in julian days
REAL(wp), PUBLIC :: adatrj !: number of elapsed days since the begining of the whole simulation
! !: (cumulative duration of previous runs that may have used different time-step size)
INTEGER , PUBLIC, DIMENSION( 0: 2) :: nyear_len !: length in days of the previous/current/next year
diff --git a/src/OCE/DOM/domain.F90 b/src/OCE/DOM/domain.F90
index a0982afaeee311ddeb7ec3ac2aa6b5bd0e982cf0..a7f4b6fbda945abff27ae884f78afcb18be3da59 100644
--- a/src/OCE/DOM/domain.F90
+++ b/src/OCE/DOM/domain.F90
@@ -64,6 +64,7 @@ MODULE domain
PUBLIC domain_cfg ! called by nemogcm.F90
!! * Substitutions
+# include "single_precision_substitute.h90"
# include "do_loop_substitute.h90"
!!-------------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -545,12 +546,12 @@ CONTAINS
!
llmsk = tmask_i(:,:) == 1._wp
!
- CALL mpp_minloc( 'domain', glamt(:,:), llmsk, zglmin, imil )
- CALL mpp_minloc( 'domain', gphit(:,:), llmsk, zgpmin, imip )
- CALL mpp_minloc( 'domain', e1t(:,:), llmsk, ze1min, imi1 )
- CALL mpp_minloc( 'domain', e2t(:,:), llmsk, ze2min, imi2 )
- CALL mpp_maxloc( 'domain', glamt(:,:), llmsk, zglmax, imal )
- CALL mpp_maxloc( 'domain', gphit(:,:), llmsk, zgpmax, imap )
+ CALL mpp_minloc( 'domain', CASTDP(glamt(:,:)), llmsk, zglmin, imil )
+ CALL mpp_minloc( 'domain', CASTDP(gphit(:,:)), llmsk, zgpmin, imip )
+ CALL mpp_minloc( 'domain', CASTDP(e1t(:,:)), llmsk, ze1min, imi1 )
+ CALL mpp_minloc( 'domain', CASTDP(e2t(:,:)), llmsk, ze2min, imi2 )
+ CALL mpp_maxloc( 'domain', CASTDP(glamt(:,:)), llmsk, zglmax, imal )
+ CALL mpp_maxloc( 'domain', CASTDP(gphit(:,:)), llmsk, zgpmax, imap )
CALL mpp_maxloc( 'domain', e1t(:,:), llmsk, ze1max, ima1 )
CALL mpp_maxloc( 'domain', e2t(:,:), llmsk, ze2max, ima2 )
!
diff --git a/src/OCE/DOM/domhgr.F90 b/src/OCE/DOM/domhgr.F90
index 4f07a01f8c81be0f55d8d5864072b2744b8df3eb..e6f9ddaba785150ce278d7112951b414bd1cab00 100644
--- a/src/OCE/DOM/domhgr.F90
+++ b/src/OCE/DOM/domhgr.F90
@@ -114,9 +114,9 @@ CONTAINS
! make sure that periodicities are properly applied
CALL lbc_lnk( 'dom_hgr', glamt, 'T', 1._wp, glamu, 'U', 1._wp, glamv, 'V', 1._wp, glamf, 'F', 1._wp, &
& gphit, 'T', 1._wp, gphiu, 'U', 1._wp, gphiv, 'V', 1._wp, gphif, 'F', 1._wp, &
- & e1t, 'T', 1._wp, e1u, 'U', 1._wp, e1v, 'V', 1._wp, e1f, 'F', 1._wp, &
- & e2t, 'T', 1._wp, e2u, 'U', 1._wp, e2v, 'V', 1._wp, e2f, 'F', 1._wp, &
- & kfillmode = jpfillcopy ) ! do not put 0 over closed boundaries
+ & e2u, 'U', 1._wp, e1v, 'V', 1._wp, kfillmode = jpfillcopy ) ! do not put 0 over closed boundaries
+ CALL lbc_lnk( 'dom_hgr', e1t, 'T', 1._dp, e2t, 'T', 1._dp, e1u, 'U', 1._dp, e2v, 'V', 1._dp, &
+ & e1f, 'F', 1._dp, e2f, 'F', 1._dp, kfillmode = jpfillcopy)
!
ENDIF
!
@@ -184,8 +184,10 @@ CONTAINS
REAL(wp), DIMENSION(:,:), INTENT(out) :: pphit, pphiu, pphiv, pphif ! latitude outputs
INTEGER , INTENT(out) :: kff ! =1 Coriolis parameter read here, =0 otherwise
REAL(wp), DIMENSION(:,:), INTENT(out) :: pff_f, pff_t ! Coriolis factor at f-point (if found in file)
- REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1t, pe1u, pe1v, pe1f ! i-scale factors
- REAL(wp), DIMENSION(:,:), INTENT(out) :: pe2t, pe2u, pe2v, pe2f ! j-scale factors
+ REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1v! i-scale factors
+ REAL(dp), DIMENSION(:,:), INTENT(out) :: pe1t, pe1u, pe1f! i-scale factors
+ REAL(wp), DIMENSION(:,:), INTENT(out) :: pe2u! j-scale factors
+ REAL(dp), DIMENSION(:,:), INTENT(out) :: pe2t, pe2v, pe2f! j-scale factors
INTEGER , INTENT(out) :: ke1e2u_v ! =1 u- & v-surfaces read here, =0 otherwise
REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1e2u, pe1e2v ! u- & v-surfaces (if found in file)
!
@@ -210,15 +212,15 @@ CONTAINS
CALL iom_get( inum, jpdom_global, 'gphiv', pphiv, cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy )
CALL iom_get( inum, jpdom_global, 'gphif', pphif, cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy )
!
- CALL iom_get( inum, jpdom_global, 'e1t' , pe1t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy )
- CALL iom_get( inum, jpdom_global, 'e1u' , pe1u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy )
+ CALL iom_get( inum, jpdom_global, 'e1t' , pe1t , cd_type = 'T', psgn = 1._dp, kfill = jpfillcopy )
+ CALL iom_get( inum, jpdom_global, 'e1u' , pe1u , cd_type = 'U', psgn = 1._dp, kfill = jpfillcopy )
CALL iom_get( inum, jpdom_global, 'e1v' , pe1v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy )
- CALL iom_get( inum, jpdom_global, 'e1f' , pe1f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy )
+ CALL iom_get( inum, jpdom_global, 'e1f' , pe1f , cd_type = 'F', psgn = 1._dp, kfill = jpfillcopy )
!
- CALL iom_get( inum, jpdom_global, 'e2t' , pe2t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy )
+ CALL iom_get( inum, jpdom_global, 'e2t' , pe2t , cd_type = 'T', psgn = 1._dp, kfill = jpfillcopy )
CALL iom_get( inum, jpdom_global, 'e2u' , pe2u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy )
- CALL iom_get( inum, jpdom_global, 'e2v' , pe2v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy )
- CALL iom_get( inum, jpdom_global, 'e2f' , pe2f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy )
+ CALL iom_get( inum, jpdom_global, 'e2v' , pe2v , cd_type = 'V', psgn = 1._dp, kfill = jpfillcopy )
+ CALL iom_get( inum, jpdom_global, 'e2f' , pe2f , cd_type = 'F', psgn = 1._dp, kfill = jpfillcopy )
!
IF( iom_varid( inum, 'ff_f', ldstop = .FALSE. ) > 0 .AND. &
& iom_varid( inum, 'ff_t', ldstop = .FALSE. ) > 0 ) THEN
diff --git a/src/OCE/DOM/domqco.F90 b/src/OCE/DOM/domqco.F90
index 82a94386aab4cace92a074e03acedbdb1e1c76e1..92f5ae0bd7bdc72abc55cda6adb18cfb3a1868ca 100644
--- a/src/OCE/DOM/domqco.F90
+++ b/src/OCE/DOM/domqco.F90
@@ -146,8 +146,9 @@ CONTAINS
!! Flux Form : simple averaging
!! - compute the ratio ssh/h_0 at t-,u-,v-pts, (f-pt optional)
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pssh ! sea surface height [m]
- REAL(wp), DIMENSION(:,:) , INTENT( out) :: pr3t, pr3u, pr3v ! ssh/h0 ratio at t-, u-, v-,points [-]
+ REAL(dp), DIMENSION(:,:) , INTENT(in ) :: pssh ! sea surface height [m]
+ REAL(wp), DIMENSION(:,:) , INTENT( out) :: pr3u, pr3v! ssh/h0 ratio at t-, u-, v-,points [-]
+ REAL(dp), DIMENSION(:,:) , INTENT( out) :: pr3t! ssh/h0 ratio at t-, u-, v-,points [-]
REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT( out) :: pr3f ! ssh/h0 ratio at f-point [-]
!
INTEGER :: ji, jj ! dummy loop indices
diff --git a/src/OCE/DOM/domutl.F90 b/src/OCE/DOM/domutl.F90
index 0c56f8f1f62c20228376775406b3d356d5529d0b..7b3095952da73453736338a3d798906ca0c34643 100644
--- a/src/OCE/DOM/domutl.F90
+++ b/src/OCE/DOM/domutl.F90
@@ -28,6 +28,8 @@ MODULE domutl
PUBLIC dom_uniq ! Called by dommsk and domwri
PUBLIC is_tile
+ !! * Substitutions
+# include "single_precision_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.2 , NEMO Consortium (2020)
!! $Id: domutl.F90 14834 2021-05-11 09:24:44Z hadcv $
@@ -75,7 +77,7 @@ CONTAINS
zgphi(:,:) = zgphi(:,:) - plat
zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:)
!
- CALL mpp_minloc( 'domngb', zdist(:,:), llmsk, zmini, iloc, ldhalo = .TRUE. )
+ CALL mpp_minloc( 'domngb', CASTDP(zdist(:,:)), llmsk, zmini, iloc, ldhalo = .TRUE. )
kii = iloc(1)
kjj = iloc(2)
!
@@ -107,7 +109,7 @@ CONTAINS
ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) )
!
puniq(:,:) = ztstref(:,:) ! default definition
- CALL lbc_lnk( 'domwri', puniq, cdgrd, 1. ) ! apply boundary conditions
+ CALL lbc_lnk( 'domwri', puniq, cdgrd, 1._wp ) ! apply boundary conditions
lluniq(:,:,1) = puniq(:,:) == ztstref(:,:) ! check which values have not been changed
!
puniq(:,:) = REAL( COUNT( lluniq(:,:,:), dim = 3 ), wp )
diff --git a/src/OCE/DOM/domzgr.F90 b/src/OCE/DOM/domzgr.F90
index 0d63bbb168b69d9059e9691181e5c13e49b7da69..e6036a5c5315c000c8a271cc607c17bd1959b9e5 100644
--- a/src/OCE/DOM/domzgr.F90
+++ b/src/OCE/DOM/domzgr.F90
@@ -113,10 +113,11 @@ CONTAINS
& k_top , k_bot ) ! 1st & last ocean level
!
! make sure that periodicities are properly applied
- CALL lbc_lnk( 'dom_zgr', gdept_0, 'T', 1._wp, gdepw_0, 'W', 1._wp, &
- & e3t_0, 'T', 1._wp, e3u_0, 'U', 1._wp, e3v_0, 'V', 1._wp, e3f_0, 'F', 1._wp, &
+ CALL lbc_lnk( 'dom_zgr', gdept_0, 'T', 1._wp, gdepw_0, 'W', 1._wp, &
+ & e3u_0, 'U', 1._wp, e3v_0, 'V', 1._wp, e3f_0, 'F', 1._wp, &
& e3w_0, 'W', 1._wp, e3uw_0, 'U', 1._wp, e3vw_0, 'V', 1._wp, &
& kfillmode = jpfillcopy ) ! do not put 0 over closed boundaries
+ CALL lbc_lnk( 'dom_zgr', e3t_0, 'T', 1._dp, kfillmode = jpfillcopy )
ztopbot(:,:,1) = REAL(k_top, wp)
ztopbot(:,:,2) = REAL(k_bot, wp)
CALL lbc_lnk( 'dom_zgr', ztopbot, 'T', 1._wp, kfillmode = jpfillcopy ) ! do not put 0 over closed boundaries
@@ -235,7 +236,8 @@ CONTAINS
REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D vertical scale factors [m]
REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pdept, pdepw ! grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3u, pe3v, pe3f! vertical scale factors [m]
+ REAL(dp), DIMENSION(:,:,:), INTENT(out) :: pe3t! vertical scale factors [m]
REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3w , pe3uw, pe3vw ! - - -
INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top , k_bot ! first & last ocean level
INTEGER , INTENT(out) :: k_mbkuvf ! ==1 if mbku, mbkv, mbkf are in file
@@ -286,7 +288,7 @@ CONTAINS
CALL iom_get( inum, jpdom_unknown, 'e3t_1d' , pe3t_1d ) ! 1D reference coordinate
CALL iom_get( inum, jpdom_unknown, 'e3w_1d' , pe3w_1d )
!
- CALL iom_get( inum, jpdom_global, 'e3t_0' , pe3t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy ) ! 3D coordinate
+ CALL iom_get( inum, jpdom_global, 'e3t_0' , pe3t , cd_type = 'T', psgn = 1._dp, kfill = jpfillcopy ) ! 3D coordinate
CALL iom_get( inum, jpdom_global, 'e3u_0' , pe3u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy )
CALL iom_get( inum, jpdom_global, 'e3v_0' , pe3v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy )
CALL iom_get( inum, jpdom_global, 'e3f_0' , pe3f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy )
diff --git a/src/OCE/DOM/domzgr_substitute.h90 b/src/OCE/DOM/domzgr_substitute.h90
index 35e60fa876232325883d5c7bc5cd2fb49effd4d3..35173ccb8d24651892c617e16bedbf25ad59a67f 100644
--- a/src/OCE/DOM/domzgr_substitute.h90
+++ b/src/OCE/DOM/domzgr_substitute.h90
@@ -51,4 +51,3 @@
# define gde3w(i,j,k) gdept_0(i,j,k)
#endif
!!----------------------------------------------------------------------
-
diff --git a/src/OCE/DOM/dtatsd.F90 b/src/OCE/DOM/dtatsd.F90
index 5863789cc4d8e4c1f09657a00610197ef9c7c599..8e35fdef591c803b7db509e035cfdb877fd93e0f 100644
--- a/src/OCE/DOM/dtatsd.F90
+++ b/src/OCE/DOM/dtatsd.F90
@@ -135,13 +135,13 @@ CONTAINS
!! ** Action : ptsd T-S data on medl mesh and interpolated at time-step kt
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time-step
- REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT( out) :: ptsd ! T & S data
+ REAL(dp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT( out) :: ptsd ! T & S data
!
INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies
INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers
INTEGER, DIMENSION(jpts), SAVE :: irec_b, irec_n
- REAL(wp):: zl, zi ! local scalars
- REAL(wp), DIMENSION(jpk) :: ztp, zsp ! 1D workspace
+ REAL(dp):: zl, zi ! local scalars
+ REAL(dp), DIMENSION(jpk) :: ztp, zsp ! 1D workspace
!!----------------------------------------------------------------------
!
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only for the full domain
diff --git a/src/OCE/DOM/istate.F90 b/src/OCE/DOM/istate.F90
index 9d708a3c7e3a421bc04901d8ac9a5c4bcab60b39..f9d2163393334da683bad84dab1d2f9cab841976 100644
--- a/src/OCE/DOM/istate.F90
+++ b/src/OCE/DOM/istate.F90
@@ -132,8 +132,8 @@ CONTAINS
END DO
CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb) )
! make sure that periodicities are properly applied
- CALL lbc_lnk( 'istate', ts(:,:,:,jp_tem,Kbb), 'T', 1._wp, ts(:,:,:,jp_sal,Kbb), 'T', 1._wp, &
- & uu(:,:,:, Kbb), 'U', -1._wp, vv(:,:,:, Kbb), 'V', -1._wp )
+ CALL lbc_lnk( 'istate', ts(:,:,:,jp_tem,Kbb), 'T', 1._dp, ts(:,:,:,jp_sal,Kbb), 'T', 1._dp, &
+ & uu(:,:,:, Kbb), 'U', -1._dp, vv(:,:,:, Kbb), 'V', -1._dp )
ENDIF
ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones
uu (:,:,:,Kmm) = uu (:,:,:,Kbb)
diff --git a/src/OCE/DYN/dynadv.F90 b/src/OCE/DYN/dynadv.F90
index 1df6b9522caeb9cd86a7523adb125ee7565fd55e..c1500fd412e4a6040f54850d7fb4bf2fa72dd306 100644
--- a/src/OCE/DYN/dynadv.F90
+++ b/src/OCE/DYN/dynadv.F90
@@ -65,7 +65,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,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start( 'dyn_adv' )
diff --git a/src/OCE/DYN/dynadv_cen2.F90 b/src/OCE/DYN/dynadv_cen2.F90
index c3cd13226e9bffae79ae0aaad6beb43f8480cb12..3016f129b39bfda34405af3135169cac9d3f5173 100644
--- a/src/OCE/DYN/dynadv_cen2.F90
+++ b/src/OCE/DYN/dynadv_cen2.F90
@@ -48,11 +48,13 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!
INTEGER :: ji, jj, jk ! dummy loop indices
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfu_t, zfu_f, zfu_uw, zfu
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfv_t, zfv_f, zfv_vw, zfv, zfw
+ REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfu_f, zfu
+ REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zfu_t, zfu_uw
+ REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfv_f, zfv, zfw
+ REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zfv_t, zfv_vw
!!----------------------------------------------------------------------
!
IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile
diff --git a/src/OCE/DYN/dynadv_ubs.F90 b/src/OCE/DYN/dynadv_ubs.F90
index 50f73f6d4b899a22e15c51d165f205b7f7329b69..302f95a0055b19a164bb7512518cca5be5901d36 100644
--- a/src/OCE/DYN/dynadv_ubs.F90
+++ b/src/OCE/DYN/dynadv_ubs.F90
@@ -70,12 +70,14 @@ 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,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zui, zvj, zfuj, zfvi, zl_u, zl_v ! local scalars
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfu_t, zfu_f, zfu_uw, zfu
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfv_t, zfv_f, zfv_vw, zfv, zfw
+ REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfu_f, zfu
+ REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zfu_t, zfu_uw
+ REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zfv_f, zfv, zfw
+ REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zfv_t, zfv_vw
REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) :: zlu_uu, zlu_uv
REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) :: zlv_vv, zlv_vu
!!----------------------------------------------------------------------
diff --git a/src/OCE/DYN/dynatf.F90 b/src/OCE/DYN/dynatf.F90
index 997692694ddf1bf7dd1fa04a5c50e96759b4e3c2..f95e33ac2f03c562427d2836cc4b80a1fa584579 100644
--- a/src/OCE/DYN/dynatf.F90
+++ b/src/OCE/DYN/dynatf.F90
@@ -80,6 +80,7 @@ CONTAINS
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: dynatf.F90 14834 2021-05-11 09:24:44Z hadcv $
@@ -354,8 +355,8 @@ CONTAINS
ENDIF
ENDIF
!
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Kaa), clinfo1=' nxt - puu(:,:,:,Kaa): ', mask1=umask, &
- & tab3d_2=pvv(:,:,:,Kaa), clinfo2=' pvv(:,:,:,Kaa): ' , mask2=vmask )
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=CASTDP(puu(:,:,:,Kaa)), clinfo1=' nxt - puu(:,:,:,Kaa): ', mask1=umask, &
+ & tab3d_2=CASTDP(pvv(:,:,:,Kaa)), clinfo2=' pvv(:,:,:,Kaa): ' , mask2=vmask )
!
IF( ln_dynspg_ts ) DEALLOCATE( zue, zve )
IF( l_trddyn ) DEALLOCATE( zua, zva )
diff --git a/src/OCE/DYN/dynatf_qco.F90 b/src/OCE/DYN/dynatf_qco.F90
index f9ed9f4644d525d233b884f53ad0e7f37760253c..fd858f2d5a39dbb1eb7a5255faa8fe65dbefad15 100644
--- a/src/OCE/DYN/dynatf_qco.F90
+++ b/src/OCE/DYN/dynatf_qco.F90
@@ -94,13 +94,13 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! before and after time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocities to be time filtered
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocities to be time filtered
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zue3a, zue3n, zue3b, zcoef ! local scalars
REAL(wp) :: zve3a, zve3n, zve3b ! - -
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zue, zve
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zua, zva
+ REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: zua, zva
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zutau, zvtau
!!----------------------------------------------------------------------
!
@@ -195,7 +195,7 @@ CONTAINS
ENDIF ! .NOT. l_1st_euler
!
! This is needed for dyn_ldf_blp to be restartable
- IF( nn_hls == 2 ) CALL lbc_lnk( 'dynatfqco', puu(:,:,:,Kmm), 'U', -1.0_wp, pvv(:,:,:,Kmm), 'V', -1.0_wp )
+ IF( nn_hls == 2 ) CALL lbc_lnk( 'dynatfqco', puu(:,:,:,Kmm), 'U', -1.0_dp, pvv(:,:,:,Kmm), 'V', -1.0_dp )
! Set "now" and "before" barotropic velocities for next time step:
! JC: Would be more clever to swap variables than to make a full vertical
diff --git a/src/OCE/DYN/dynhpg.F90 b/src/OCE/DYN/dynhpg.F90
index b64bc83c7903ba68a67d276b6a808b95e1c0323a..7a4b35c9affc5c99da865d3aed6dc52cbe0dc52f 100644
--- a/src/OCE/DYN/dynhpg.F90
+++ b/src/OCE/DYN/dynhpg.F90
@@ -100,9 +100,9 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv
+ REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('dyn_hpg')
@@ -256,7 +256,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zcoef0, zcoef1 ! temporary scalars
@@ -309,7 +309,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: iku, ikv ! temporary integers
@@ -403,7 +403,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!!
INTEGER :: ji, jj, jk, jii, jjj ! dummy loop indices
REAL(wp) :: zcoef0, zuap, zvap, ztmp ! local scalars
@@ -541,7 +541,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ikt , ikti1, iktj1 ! local integer
@@ -629,7 +629,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: iktb, iktt ! jk indices at tracer points for top and bottom points
@@ -953,7 +953,7 @@ CONTAINS
INTEGER, PARAMETER :: polynomial_type = 1 ! 1: cubic spline, 2: linear
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!!
INTEGER :: ji, jj, jk, jkk ! dummy loop indices
REAL(wp) :: zcoef0, znad ! local scalars
@@ -1270,7 +1270,7 @@ CONTAINS
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zdf1, zdf2, zddf1, zddf2, ztmp1, ztmp2, zdxtmp
REAL(wp) :: zdxtmp1, zdxtmp2, zalpha
- REAL(wp) :: zdf(jpk)
+ REAL(wp), DIMENSION(jpk) :: zdf
!!----------------------------------------------------------------------
!
IF (polynomial_type == 1) THEN ! Constrained Cubic Spline
@@ -1355,7 +1355,8 @@ CONTAINS
!! ** Method : interpolation is straight forward
!! extrapolation is also permitted (no value limit)
!!----------------------------------------------------------------------
- REAL(wp), INTENT(in) :: x, xl, xr, fl, fr
+ REAL(wp), INTENT(in) :: fl, fr
+ REAL(dp), INTENT(in) :: x, xl, xr
REAL(wp) :: f ! result of the interpolation (extrapolation)
REAL(wp) :: zdeltx
!!----------------------------------------------------------------------
diff --git a/src/OCE/DYN/dynkeg.F90 b/src/OCE/DYN/dynkeg.F90
index d751899d0de9266477ed7f9ecc26941906cba84d..e34c02ef9e42d2dcf9f4834d3b27134c98c99575 100644
--- a/src/OCE/DYN/dynkeg.F90
+++ b/src/OCE/DYN/dynkeg.F90
@@ -73,12 +73,12 @@ CONTAINS
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: kscheme ! =0/1 type of KEG scheme
INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zu, zv ! local scalars
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zhke
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv
+ REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('dyn_keg')
diff --git a/src/OCE/DYN/dynldf.F90 b/src/OCE/DYN/dynldf.F90
index da8705afa39587639c9f56495ccfbe9956300fb1..bb67d21c70c97bb3a6fd9be93c2a0cb8b982d171 100644
--- a/src/OCE/DYN/dynldf.F90
+++ b/src/OCE/DYN/dynldf.F90
@@ -33,6 +33,8 @@ MODULE dynldf
PUBLIC dyn_ldf ! called by step module
PUBLIC dyn_ldf_init ! called by opa module
+ !! * Substitutions
+# include "single_precision_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: dynldf.F90 12377 2020-02-12 14:39:06Z acc $
@@ -48,9 +50,9 @@ 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,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv
+ REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('dyn_ldf')
diff --git a/src/OCE/DYN/dynldf_iso.F90 b/src/OCE/DYN/dynldf_iso.F90
index 891d8842cc5955dd9f3ea41c56aaf819a160d321..0936ddfb19956ac90a38e15b2dd901c0cf32cace 100644
--- a/src/OCE/DYN/dynldf_iso.F90
+++ b/src/OCE/DYN/dynldf_iso.F90
@@ -107,7 +107,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,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zabe1, zmskt, zmkt, zuav, zuwslpi, zuwslpj ! local scalars
diff --git a/src/OCE/DYN/dynldf_iso_lf.F90 b/src/OCE/DYN/dynldf_iso_lf.F90
index 07b38792080db5a019c312c40b9fbf989a43b710..5448515fbb96473989b2a79e0886faa898d9bdbb 100644
--- a/src/OCE/DYN/dynldf_iso_lf.F90
+++ b/src/OCE/DYN/dynldf_iso_lf.F90
@@ -38,6 +38,7 @@ MODULE dynldf_iso_lf
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -286,8 +287,8 @@ CONTAINS
! ! ===============
! print sum trends (used for debugging)
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ldfh - Ua: ', mask1=umask, &
- & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=CASTDP(puu(:,:,:,Krhs)), clinfo1=' ldfh - Ua: ', mask1=umask, &
+ & tab3d_2=CASTDP(pvv(:,:,:,Krhs)), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
! ! ===============
diff --git a/src/OCE/DYN/dynldf_lap_blp.F90 b/src/OCE/DYN/dynldf_lap_blp.F90
index 09ae6fe78b107e89def6af8016a01409dffc6dea..b67f70cae5c6ed3f2efabf46b41f689fe1ddab9c 100644
--- a/src/OCE/DYN/dynldf_lap_blp.F90
+++ b/src/OCE/DYN/dynldf_lap_blp.F90
@@ -46,8 +46,8 @@ CONTAINS
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices
INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage
- REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pu, pv ! before velocity [m/s]
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pu_rhs, pv_rhs ! velocity trend [m/s2]
+ REAL(dp), DIMENSION(:,:,:), INTENT(in ) :: pu, pv ! before velocity [m/s]
+ REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: pu_rhs, pv_rhs ! velocity trend [m/s2]
!!
#if defined key_loop_fusion
CALL dyn_ldf_lap_lf( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs, kpass )
@@ -76,8 +76,8 @@ CONTAINS
INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices
INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage
INTEGER , INTENT(in ) :: ktuv, ktuv_rhs
- REAL(wp), DIMENSION(A2D_T(ktuv) ,JPK), INTENT(in ) :: pu, pv ! before velocity [m/s]
- REAL(wp), DIMENSION(A2D_T(ktuv_rhs),JPK), INTENT(inout) :: pu_rhs, pv_rhs ! velocity trend [m/s2]
+ REAL(dp), DIMENSION(A2D_T(ktuv) ,JPK), INTENT(in ) :: pu, pv ! before velocity [m/s]
+ REAL(dp), DIMENSION(A2D_T(ktuv_rhs),JPK), INTENT(inout) :: pu_rhs, pv_rhs ! velocity trend [m/s2]
!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: iij
@@ -197,10 +197,10 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu, pv ! before velocity fields
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! momentum trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu, pv ! before velocity fields
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! momentum trend
!
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zulap, zvlap ! laplacian at u- and v-point
+ REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zulap, zvlap ! laplacian at u- and v-point
!!----------------------------------------------------------------------
!
#if defined key_loop_fusion
@@ -219,7 +219,7 @@ CONTAINS
!
CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 ) ! rotated laplacian applied to pt (output in zlap,Kbb)
!
- IF (nn_hls==1) CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp ) ! Lateral boundary conditions
+ IF (nn_hls==1) CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_dp, zvlap, 'V', -1.0_dp ) ! Lateral boundary conditions
!
CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 ) ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs))
!
diff --git a/src/OCE/DYN/dynspg.F90 b/src/OCE/DYN/dynspg.F90
index 24cd9455acb11a63ad9f8a46392e210eb1f9864d..2c46cf101a44c4f42d4776240f80676f84fd5066 100644
--- a/src/OCE/DYN/dynspg.F90
+++ b/src/OCE/DYN/dynspg.F90
@@ -76,15 +76,16 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
- REAL(wp), DIMENSION(jpi,jpj,jpt) , INTENT(inout) :: pssh, puu_b, pvv_b ! SSH and barotropic velocities at main time levels
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(wp), DIMENSION(jpi,jpj,jpt) , INTENT(inout) :: puu_b, pvv_b! SSH and barotropic velocities at main time levels
+ REAL(dp), DIMENSION(jpi,jpj,jpt) , INTENT(inout) :: pssh! SSH and barotropic velocities at main time levels
INTEGER , OPTIONAL , INTENT( in ) :: k_only_ADV ! only Advection in the RHS
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: z2dt, zg_2, zintp, zgrho0r, zld ! local scalars
REAL(wp) , DIMENSION(jpi,jpj) :: zpgu, zpgv ! 2D workspace
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpice
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv
+ REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('dyn_spg')
diff --git a/src/OCE/DYN/dynspg_exp.F90 b/src/OCE/DYN/dynspg_exp.F90
index 8d59e3f977cf444b6fd504813b296c0aa2d1f547..89c1c14c4768d0e675f2c9d26f5301722e0e5525 100644
--- a/src/OCE/DYN/dynspg_exp.F90
+++ b/src/OCE/DYN/dynspg_exp.F90
@@ -56,7 +56,7 @@ CONTAINS
!!---------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp), DIMENSION(jpi,jpj) :: zpgu, zpgv ! 2D workspace
diff --git a/src/OCE/DYN/dynspg_ts.F90 b/src/OCE/DYN/dynspg_ts.F90
index c41e6f167c04cc45edd7ce6c2ea69b5be256b7e3..2168a9bb16ed327620a8fdc615414819ebc61199 100644
--- a/src/OCE/DYN/dynspg_ts.F90
+++ b/src/OCE/DYN/dynspg_ts.F90
@@ -72,9 +72,10 @@ MODULE dynspg_ts
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv , vn_adv !: Advection vel. at "now" barocl. step
!
INTEGER, SAVE :: icycle ! Number of barotropic sub-steps for each internal step nn_e <= 2.5 nn_e
- REAL(wp),SAVE :: rDt_e ! Barotropic time step
+ REAL(dp),SAVE :: rDt_e ! Barotropic time step
!
- REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: wgtbtp1, wgtbtp2 ! 1st & 2nd weights used in time filtering of barotropic fields
+ REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: wgtbtp2! 1st & 2nd weights used in time filtering of barotropic fields
+ REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:) :: wgtbtp1! 1st & 2nd weights used in time filtering of barotropic fields
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zwz ! ff_f/h at F points
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftnw, ftne ! triad of coriolis parameter
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftsw, ftse ! (only used with een vorticity scheme)
@@ -86,6 +87,7 @@ MODULE dynspg_ts
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -143,8 +145,9 @@ CONTAINS
!!---------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
- REAL(wp), DIMENSION(jpi,jpj,jpt) , INTENT(inout) :: pssh, puu_b, pvv_b ! SSH and barotropic velocities at main time levels
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(wp), DIMENSION(jpi,jpj,jpt) , INTENT(inout) :: puu_b, pvv_b! SSH and barotropic velocities at main time levels
+ REAL(dp), DIMENSION(jpi,jpj,jpt) , INTENT(inout) :: pssh! SSH and barotropic velocities at main time levels
INTEGER , OPTIONAL , INTENT( in ) :: k_only_ADV ! only Advection in the RHS
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
@@ -152,16 +155,19 @@ CONTAINS
LOGICAL :: ll_init ! =T : special startup of 2d equations
INTEGER :: noffset ! local integers : time offset for bdy update
REAL(wp) :: r1_Dt_b, z1_hu, z1_hv ! local scalars
- REAL(wp) :: za0, za1, za2, za3 ! - -
+ REAL(wp) :: za0, za2, za3! - -
+ REAL(dp) :: za1! - -
REAL(wp) :: zztmp, zldg ! - -
- REAL(wp) :: zhu_bck, zhv_bck, zhdiv ! - -
+ REAL(wp) :: zhu_bck, zhv_bck! - -
+ REAL(dp) :: zhdiv! - -
REAL(wp) :: zun_save, zvn_save ! - -
REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zu_frc, zu_spg
REAL(wp), DIMENSION(jpi,jpj) :: zv_trd, zv_frc, zv_spg
REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zhup2_e, zhtp2_e
REAL(wp), DIMENSION(jpi,jpj) :: zsshv_a, zhvp2_e, zsshp2_e
REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v ! top/bottom stress at u- & v-points
- REAL(wp), DIMENSION(jpi,jpj) :: zhU, zhV ! fluxes
+ REAL(wp), DIMENSION(jpi,jpj) :: zhV! fluxes
+ REAL(dp), DIMENSION(jpi,jpj) :: zhU! fluxes
!!st#if defined key_qco
!!st REAL(wp), DIMENSION(jpi, jpj, jpk) :: ze3u, ze3v
!!st#endif
@@ -259,7 +265,7 @@ CONTAINS
zhU(:,:) = puu_b(:,:,Kmm) * hu(:,:,Kmm) * e2u(:,:) ! now fluxes
zhV(:,:) = pvv_b(:,:,Kmm) * hv(:,:,Kmm) * e1v(:,:) ! NB: FULL domain : put a value in last row and column
!
- CALL dyn_cor_2d( ht(:,:), hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV, & ! <<== in
+ CALL dyn_cor_2d( CASTSP(ht(:,:)), hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV, & ! <<== in
& zu_trd, zv_trd ) ! ==>> out
!
DO_2D( 0, 0, 0, 0 ) ! Remove coriolis term (and possibly spg) from barotropic trend
@@ -527,7 +533,8 @@ CONTAINS
ssha_e(ji,jj) = ( sshn_e(ji,jj) - rDt_e * ( ssh_frc(ji,jj) + zhdiv ) ) * ssmask(ji,jj)
END_2D
!
- CALL lbc_lnk( 'dynspg_ts', ssha_e, 'T', 1._wp, zhU, 'U', -1._wp, zhV, 'V', -1._wp )
+ CALL lbc_lnk( 'dynspg_ts', ssha_e, 'T', 1._dp, zhU, 'U', -1._dp)
+ CALL lbc_lnk( 'dynspg_ts', zhV, 'V', -1._wp )
!
! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T)
IF( ln_bdy ) CALL bdy_ssh( ssha_e )
@@ -855,11 +862,13 @@ CONTAINS
LOGICAL, INTENT(in) :: ll_av ! temporal averaging=.true.
LOGICAL, INTENT(in) :: ll_fw ! forward time splitting =.true.
INTEGER, INTENT(inout) :: jpit ! cycle length
- REAL(wp), DIMENSION(3*nn_e), INTENT(inout) :: zwgt1, & ! Primary weights
- zwgt2 ! Secondary weights
+ REAL(wp), DIMENSION(3*nn_e), INTENT(inout) :: zwgt2
+ REAL(dp), DIMENSION(3*nn_e), INTENT(inout) :: zwgt1
+
INTEGER :: jic, jn, ji ! temporary integers
- REAL(wp) :: za1, za2
+ REAL(wp) :: za2
+ REAL(dp) :: za1
!!----------------------------------------------------------------------
zwgt1(:) = 0._wp
@@ -1028,7 +1037,7 @@ CONTAINS
! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax
IF( ln_bt_auto ) nn_e = CEILING( rn_Dt / rn_bt_cmax * zcmax)
- rDt_e = rn_Dt / REAL( nn_e , wp )
+ rDt_e = rn_Dt / REAL( nn_e , dp )
zcmax = zcmax * rDt_e
! Print results
IF(lwp) WRITE(numout,*)
@@ -1167,7 +1176,8 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER :: ji ,jj ! dummy loop indices
REAL(wp) :: zx1, zx2, zy1, zy2, z1_hu, z1_hv ! - -
- REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pht, phu, phv, punb, pvnb, zhU, zhV
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pht, phu, phv, punb, pvnb, zhV
+ REAL(dp), DIMENSION(jpi,jpj), INTENT(in ) :: zhU
REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: zu_trd, zv_trd
!!----------------------------------------------------------------------
SELECT CASE( nvor_scheme )
@@ -1273,7 +1283,8 @@ CONTAINS
!! ** Action : ptmsk : wetting & drying t-mask
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pTmsk ! W & D t-mask
- REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: phU, phV, pu, pv ! ocean velocities and transports
+ REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: phV, pu, pv! ocean velocities and transports
+ REAL(dp), DIMENSION(jpi,jpj), INTENT(inout) :: phU! ocean velocities and transports
REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pUmsk, pVmsk ! W & D u- and v-mask
!
INTEGER :: ji, jj ! dummy loop indices
@@ -1362,7 +1373,7 @@ CONTAINS
!! ** Method : computation done over the INNER domain only
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(in ) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(in ) :: puu, pvv ! ocean velocities and RHS of momentum equation
REAL(wp), DIMENSION(jpi,jpj,jpt) , INTENT(in ) :: puu_b, pvv_b ! barotropic velocities at main time levels
REAL(wp), DIMENSION(jpi,jpj) , INTENT(inout) :: pu_RHSi, pv_RHSi ! baroclinic part of the barotropic RHS
REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pCdU_u , pCdU_v ! barotropic drag coefficients
@@ -1462,7 +1473,8 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER ,INTENT(in ) :: jn ! index of sub time step
LOGICAL ,INTENT(in ) :: ll_init !
- REAL(wp),INTENT( out) :: za0, za1, za2, za3 ! Half-step back interpolation coefficient
+ REAL(wp),INTENT( out) :: za0, za2, za3! Half-step back interpolation coefficient
+ REAL(dp),INTENT( out) :: za1! Half-step back interpolation coefficient
!
REAL(wp) :: zepsilon, zgamma ! - -
!!----------------------------------------------------------------------
diff --git a/src/OCE/DYN/dynvor.F90 b/src/OCE/DYN/dynvor.F90
index 36f2d4b3fc6b8ed9ea570a7ba598a2234ed9785c..bf350a0fdc60bbe9a40586083c8e4414d9ef6e00 100644
--- a/src/OCE/DYN/dynvor.F90
+++ b/src/OCE/DYN/dynvor.F90
@@ -115,9 +115,9 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocity field and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocity field and RHS of momentum equation
!
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv
+ REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('dyn_vor')
@@ -234,8 +234,8 @@ CONTAINS
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kmm ! ocean time level index
INTEGER , INTENT(in ) :: kvor ! total, planetary, relative, or metric
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! total v-trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! total v-trend
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zx1, zy1, zx2, zy2 ! local scalars
@@ -354,8 +354,8 @@ CONTAINS
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kmm ! ocean time level index
INTEGER , INTENT(in ) :: kvor ! total, planetary, relative, or metric
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! total v-trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! total v-trend
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zx1, zy1, zx2, zy2, ze3f, zmsk ! local scalars
@@ -487,8 +487,8 @@ CONTAINS
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kmm ! ocean time level index
INTEGER , INTENT(in ) :: kvor ! total, planetary, relative, or metric
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! total v-trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! total v-trend
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zuav, zvau, ze3f, zmsk ! local scalars
@@ -617,8 +617,8 @@ CONTAINS
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kmm ! ocean time level index
INTEGER , INTENT(in ) :: kvor ! total, planetary, relative, or metric
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! total v-trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! total v-trend
!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ierr ! local integer
@@ -816,8 +816,8 @@ CONTAINS
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kmm ! ocean time level index
INTEGER , INTENT(in ) :: kvor ! total, planetary, relative, or metric
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! total v-trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! total v-trend
!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ierr ! local integer
diff --git a/src/OCE/DYN/dynzad.F90 b/src/OCE/DYN/dynzad.F90
index 5e6a59ded6271c882b86ff87436de51dc1052ecf..85a81aeb7b17cc5b8a0afcd87d38411de0368e42 100644
--- a/src/OCE/DYN/dynzad.F90
+++ b/src/OCE/DYN/dynzad.F90
@@ -55,13 +55,13 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! ocean time-step inedx
INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zua, zva ! local scalars
REAL(wp), DIMENSION(A2D(nn_hls)) :: zww
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwuw, zwvw
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv
+ REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('dyn_zad')
diff --git a/src/OCE/DYN/dynzdf.F90 b/src/OCE/DYN/dynzdf.F90
index d8046188ca9c2c03852b65fde2d32af36ea8f997..7207759e673ebfd5dc61be7e58293dcf13cef035 100644
--- a/src/OCE/DYN/dynzdf.F90
+++ b/src/OCE/DYN/dynzdf.F90
@@ -71,7 +71,7 @@ CONTAINS
!!---------------------------------------------------------------------
INTEGER , INTENT( in ) :: kt ! ocean time-step index
INTEGER , INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation
!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: iku, ikv ! local integers
@@ -82,7 +82,7 @@ CONTAINS
REAL(wp) :: zWui, zWvi ! - -
REAL(wp) :: zWus, zWvs ! - -
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwi, zwd, zws ! 3D workspace
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv ! - -
+ REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv ! - -
!!---------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('dyn_zdf')
diff --git a/src/OCE/DYN/sshwzv.F90 b/src/OCE/DYN/sshwzv.F90
index bbe83c8c29241917583873e6c73b783e54c75362..82219d8e4f69008b640d0700075a452d4af5bb3f 100644
--- a/src/OCE/DYN/sshwzv.F90
+++ b/src/OCE/DYN/sshwzv.F90
@@ -75,7 +75,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! time step
INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! time level index
- REAL(wp), DIMENSION(jpi,jpj,jpt), INTENT(inout) :: pssh ! sea-surface height
+ REAL(dp), DIMENSION(jpi,jpj,jpt), INTENT(inout) :: pssh ! sea-surface height
!
INTEGER :: ji, jj, jk ! dummy loop index
REAL(wp) :: zcoef ! local scalar
@@ -113,7 +113,7 @@ CONTAINS
pssh(ji,jj,Kaa) = ( pssh(ji,jj,Kbb) - rDt * ( zcoef * ( emp_b(ji,jj) + emp(ji,jj) ) + zhdiv(ji,jj) ) ) * ssmask(ji,jj)
END_2D
! pssh must be defined everywhere (true for dyn_spg_ts, not for dyn_spg_exp)
- IF ( .NOT. ln_dynspg_ts .AND. nn_hls == 2 ) CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp )
+ IF ( .NOT. ln_dynspg_ts .AND. nn_hls == 2 ) CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_dp )
!
#if defined key_agrif
Kbb_a = Kbb ; Kmm_a = Kmm ; Krhs_a = Kaa
@@ -122,7 +122,7 @@ CONTAINS
!
IF ( .NOT.ln_dynspg_ts ) THEN
IF( ln_bdy ) THEN
- IF (nn_hls==1) CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp ) ! Not sure that's necessary
+ IF (nn_hls==1) CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_dp ) ! Not sure that's necessary
CALL bdy_ssh( pssh(:,:,Kaa) ) ! Duplicate sea level across open boundaries
ENDIF
ENDIF
@@ -285,7 +285,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpt), INTENT(inout) :: pssh ! SSH field
+ REAL(dp), DIMENSION(jpi,jpj,jpt), INTENT(inout) :: pssh ! SSH field
!
REAL(wp) :: zcoef ! local scalar
!!----------------------------------------------------------------------
diff --git a/src/OCE/DYN/wet_dry.F90 b/src/OCE/DYN/wet_dry.F90
index 465134503a2995b5d1544e27f1ee7727011e42ea..b21148a86cfda7225419e3f6316c09e5835124d3 100644
--- a/src/OCE/DYN/wet_dry.F90
+++ b/src/OCE/DYN/wet_dry.F90
@@ -132,11 +132,11 @@ CONTAINS
!!
!! ** Action : - calculate flux limiter and W/D flag
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:) , INTENT(inout) :: psshb1
+ REAL(dp), DIMENSION(:,:) , INTENT(inout) :: psshb1
REAL(wp), DIMENSION(:,:) , INTENT(in ) :: psshemp
REAL(wp) , INTENT(in ) :: z2dt
INTEGER , INTENT(in ) :: Kmm ! time level index
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocity arrays
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocity arrays
!
INTEGER :: ji, jj, jk, jk1 ! dummy loop indices
INTEGER :: jflag ! local scalar
@@ -258,7 +258,7 @@ CONTAINS
vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * zwdlmtv(:, :)
!
!!gm TO BE SUPPRESSED ? these lbc_lnk are useless since zwdlmtu and zwdlmtv are defined everywhere !
- CALL lbc_lnk( 'wet_dry', puu(:,:,:,Kmm) , 'U', -1.0_wp, pvv(:,:,:,Kmm) , 'V', -1.0_wp )
+ CALL lbc_lnk( 'wet_dry', puu(:,:,:,Kmm) , 'U', -1.0_dp, pvv(:,:,:,Kmm) , 'V', -1.0_dp )
CALL lbc_lnk( 'wet_dry', uu_b(:,:,Kmm), 'U', -1.0_wp, vv_b(:,:,Kmm), 'V', -1.0_wp )
!!gm
!
@@ -281,8 +281,9 @@ CONTAINS
!!
!! ** Action : - calculate flux limiter and W/D flag
!!----------------------------------------------------------------------
- REAL(wp) , INTENT(in ) :: rDt_e ! ocean time-step index
- REAL(wp), DIMENSION(:,:), INTENT(inout) :: zflxu, zflxv, sshn_e, zssh_frc
+ REAL(dp) , INTENT(in ) :: rDt_e ! ocean time-step index
+ REAL(wp), DIMENSION(:,:), INTENT(inout) :: zflxv
+ REAL(dp), DIMENSION(:,:), INTENT(inout) :: zflxu, sshn_e, zssh_frc
!
INTEGER :: ji, jj, jk, jk1 ! dummy loop indices
INTEGER :: jflag ! local integer
@@ -379,7 +380,8 @@ CONTAINS
zflxv(:,:) = zflxv(:,:) * zwdlmtv(:, :)
!
!!gm THIS lbc_lnk is useless since it is already done at the end of the jk1-loop
- CALL lbc_lnk( 'wet_dry', zflxu, 'U', -1.0_wp, zflxv, 'V', -1.0_wp )
+ CALL lbc_lnk( 'wet_dry', zflxu, 'U', -1.0_dp)
+ CALL lbc_lnk( 'wet_dry', zflxv, 'V', -1.0_wp)
!!gm end
!
IF( jflag == 1 .AND. lwp ) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!'
diff --git a/src/OCE/FLO/floblk.F90 b/src/OCE/FLO/floblk.F90
index 4d7450719ab228425db24064880ac5da1d0ec18a..c49320b7372e991655f3e3410491699afb5e4bfb 100644
--- a/src/OCE/FLO/floblk.F90
+++ b/src/OCE/FLO/floblk.F90
@@ -383,4 +383,4 @@ CONTAINS
END SUBROUTINE flo_blk
!!======================================================================
-END MODULE floblk
+END MODULE floblk
diff --git a/src/OCE/ICB/icbtrj.F90 b/src/OCE/ICB/icbtrj.F90
index 7991cfa8724704abf74853071db1383656f9d309..170a9d6f8b1815565a2d135775d87ab46d1a7bb0 100644
--- a/src/OCE/ICB/icbtrj.F90
+++ b/src/OCE/ICB/icbtrj.F90
@@ -62,7 +62,7 @@ CONTAINS
!
INTEGER :: iret, iyear, imonth, iday
INTEGER :: idg ! number of digits
- REAL(wp) :: zfjulday, zsec
+ REAL(dp) :: zfjulday, zsec
CHARACTER(len=80) :: cl_filename
CHARACTER(LEN=12) :: clfmt ! writing format
CHARACTER(LEN=8 ) :: cldate_ini, cldate_end
diff --git a/src/OCE/ICB/icbutl.F90 b/src/OCE/ICB/icbutl.F90
index 873245fcd6b19d8f83119228191153f9cf2b3198..9c14ba654361552cc78bfa4e59bc74be3eee8b4c 100644
--- a/src/OCE/ICB/icbutl.F90
+++ b/src/OCE/ICB/icbutl.F90
@@ -57,6 +57,7 @@ MODULE icbutl
PUBLIC icb_utl_heat ! routine called in icbdia module
!! * Substitutions
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -181,8 +182,8 @@ CONTAINS
CALL icb_utl_pos( pi, pj, 'F', iiF, ijF, zwF, zmskF )
!
! metrics and coordinates
- IF ( PRESENT(pe1 ) ) pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj ) ! scale factors
- IF ( PRESENT(pe2 ) ) pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj )
+ IF ( PRESENT(pe1 ) ) pe1 = icb_utl_bilin_e( e1t, CASTSP(e1u), e1v, e1f, pi, pj ) ! scale factors
+ IF ( PRESENT(pe2 ) ) pe2 = icb_utl_bilin_e( e2t, e2u, CASTSP(e2v), e2f, pi, pj )
IF ( PRESENT(plon) ) plon= icb_utl_bilin_h( rlon_e, iiT, ijT, zwT, .true. )
IF ( PRESENT(plat) ) plat= icb_utl_bilin_h( rlat_e, iiT, ijT, zwT, .false. )
!
@@ -214,17 +215,17 @@ CONTAINS
!
! Estimate SSH gradient in i- and j-direction (centred evaluation)
IF ( PRESENT(pssh_i) .AND. PRESENT(pssh_j) ) THEN
- CALL icb_utl_pos( pi+0.1, pj , 'T', iiTp, ijTp, zwTp, zmskTp )
- CALL icb_utl_pos( pi-0.1, pj , 'T', iiTm, ijTm, zwTm, zmskTm )
+ CALL icb_utl_pos( pi+0.1_wp, pj , 'T', iiTp, ijTp, zwTp, zmskTp )
+ CALL icb_utl_pos( pi-0.1_wp, pj , 'T', iiTm, ijTm, zwTm, zmskTm )
!
- IF ( .NOT. PRESENT(pe1) ) pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj )
+ IF ( .NOT. PRESENT(pe1) ) pe1 = icb_utl_bilin_e( e1t, CASTSP(e1u), e1v, e1f, pi, pj )
pssh_i = ( icb_utl_bilin_h( ssh_e, iiTp, ijTp, zwTp*zmskTp, .false. ) - &
& icb_utl_bilin_h( ssh_e, iiTm, ijTm, zwTm*zmskTm, .false. ) ) / ( 0.2_wp * pe1 )
!
- CALL icb_utl_pos( pi , pj+0.1, 'T', iiTp, ijTp, zwTp, zmskTp )
- CALL icb_utl_pos( pi , pj-0.1, 'T', iiTm, ijTm, zwTm, zmskTm )
+ CALL icb_utl_pos( pi , pj+0.1_wp, 'T', iiTp, ijTp, zwTp, zmskTp )
+ CALL icb_utl_pos( pi , pj-0.1_wp, 'T', iiTm, ijTm, zwTm, zmskTm )
!
- IF ( .NOT. PRESENT(pe2) ) pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj )
+ IF ( .NOT. PRESENT(pe2) ) pe2 = icb_utl_bilin_e( e2t, e2u, CASTSP(e2v), e2f, pi, pj )
pssh_j = ( icb_utl_bilin_h( ssh_e, iiTp, ijTp, zwTp*zmskTp, .false. ) - &
& icb_utl_bilin_h( ssh_e, iiTm, ijTm, zwTm*zmskTm, .false. ) ) / ( 0.2_wp * pe2 )
END IF
@@ -437,7 +438,8 @@ CONTAINS
!! ** Method : interpolation done using the 4 nearest grid points among
!! t-, u-, v-, and f-points.
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:), INTENT(in) :: pet, peu, pev, pef ! horizontal scale factor to be interpolated at t-,u-,v- & f-pts
+ REAL(wp), DIMENSION(:,:), INTENT(in) :: peu, pev! horizontal scale factor to be interpolated at t-,u-,v- & f-pts
+ REAL(dp), DIMENSION(:,:), INTENT(in) :: pet, pef! horizontal scale factor to be interpolated at t-,u-,v- & f-pts
REAL(wp) , INTENT(IN) :: pi , pj ! iceberg position
!
! weights corresponding to corner points of a T cell quadrant
@@ -521,7 +523,7 @@ CONTAINS
kb = kb + 1
END DO
kb = MIN(kb - 1,jpk)
- END SUBROUTINE
+ END SUBROUTINE icb_utl_getkb
SUBROUTINE icb_utl_zavg(pzavg, pdat, pe3, pD, kb )
!!----------------------------------------------------------------------
@@ -546,7 +548,7 @@ CONTAINS
! if kb is limited by mbkt => bottom value is used between bathy and icb tail
! if kb not limited by mbkt => ocean value over mask is used (ie 0.0 for u, v)
pzavg = ( pzavg + (pD - zdep)*pdat(kb)) / pD
- END SUBROUTINE
+ END SUBROUTINE icb_utl_zavg
SUBROUTINE icb_utl_add( bergvals, ptvals )
!!----------------------------------------------------------------------
@@ -750,7 +752,7 @@ CONTAINS
!!
!!----------------------------------------------------------------------
CHARACTER(len=*) :: cd_label
- INTEGER :: kt ! timestep number
+ INTEGER, INTENT(IN) :: kt ! timestep number
!
INTEGER :: ibergs, inbergs
TYPE(iceberg), POINTER :: this
@@ -916,7 +918,8 @@ CONTAINS
!! ** Comments : not called, if needed a CALL test_icb_utl_getkb need to be added in icb_step
!!----------------------------------------------------------------------
INTEGER :: ikb
- REAL(wp) :: zD, zout
+ REAL(wp) :: zout
+ REAL(wp) :: zD
REAL(wp), DIMENSION(jpk) :: ze3, zin
WRITE(numout,*) 'Test icb_utl_getkb : '
zD = 0.0 ; ze3= 20.0
diff --git a/src/OCE/IOM/iom.F90 b/src/OCE/IOM/iom.F90
index 1c78c9021fea692a2d1e337a2b70666483190543..bfbad0845e30eb04b138c5a447d7157bba3fbc51 100644
--- a/src/OCE/IOM/iom.F90
+++ b/src/OCE/IOM/iom.F90
@@ -2568,7 +2568,7 @@ CONTAINS
INTEGER :: jn, iln
INTEGER :: itrlen
INTEGER :: iyear, imonth, iday, isec
- REAL(wp) :: zsec
+ REAL(dp) :: zsec
LOGICAL :: llexist
TYPE(xios_duration) :: output_freq
!!----------------------------------------------------------------------
@@ -2668,14 +2668,14 @@ CONTAINS
!!
!! ** Purpose : send back the date corresponding to the given julian day
!!----------------------------------------------------------------------
- REAL(wp), INTENT(in ) :: pjday ! julian day
+ REAL(dp), INTENT(in ) :: pjday ! julian day
LOGICAL , INTENT(in ), OPTIONAL :: ld24 ! true to force 24:00 instead of 00:00
LOGICAL , INTENT(in ), OPTIONAL :: ldfull ! true to get the compleate date: yyyymmdd_hh:mm:ss
!
CHARACTER(LEN=20) :: iom_sdate
CHARACTER(LEN=50) :: clfmt ! format used to write the date
INTEGER :: iyear, imonth, iday, ihour, iminute, isec
- REAL(wp) :: zsec
+ REAL(dp) :: zsec
LOGICAL :: ll24, llfull
!!----------------------------------------------------------------------
!
diff --git a/src/OCE/IOM/prtctl.F90 b/src/OCE/IOM/prtctl.F90
index fae7c0d8041cfef5ebb1e57b6e1b6e3026ae14f2..26e330872224a2223b93a21945ba3ecd13f254e7 100644
--- a/src/OCE/IOM/prtctl.F90
+++ b/src/OCE/IOM/prtctl.F90
@@ -38,11 +38,11 @@ CONTAINS
SUBROUTINE prt_ctl (tab2d_1, tab3d_1, tab4d_1, tab2d_2, tab3d_2, mask1, mask2, &
& clinfo, clinfo1, clinfo2, clinfo3, kdim )
!!
- REAL(wp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_1
- REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: tab3d_1
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in), OPTIONAL :: tab4d_1
- REAL(wp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_2
- REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: tab3d_2
+ REAL(dp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_1
+ REAL(dp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: tab3d_1
+ REAL(dp), DIMENSION(:,:,:,:), INTENT(in), OPTIONAL :: tab4d_1
+ REAL(dp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_2
+ REAL(dp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: tab3d_2
REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: mask1
REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: mask2
CHARACTER(len=*), DIMENSION(:) , INTENT(in), OPTIONAL :: clinfo ! information about the tab3d array
@@ -53,29 +53,29 @@ CONTAINS
!
IF( PRESENT(tab2d_2) ) THEN
CALL prt_ctl_t(ktab2d_1 = is_tile(tab2d_1), ktab3d_1 = 0, ktab4d_1 = 0, ktab2d_2 = is_tile(tab2d_2), ktab3d_2 = 0, &
- & tab2d_1 = REAL(tab2d_1, 2*wp), tab2d_2 = REAL(tab2d_2, 2*wp), &
+ & tab2d_1 = REAL(tab2d_1, dp), tab2d_2 = REAL(tab2d_2, dp), &
& mask1 = mask1, mask2 = mask2, &
& clinfo = clinfo, clinfo1 = clinfo1, clinfo2 = clinfo2, clinfo3 = clinfo3 )
ELSEIF( PRESENT(tab3d_2) ) THEN
CALL prt_ctl_t(ktab2d_1 = 0, ktab3d_1 = is_tile(tab3d_1), ktab4d_1 = 0, ktab2d_2 = 0, ktab3d_2 = is_tile(tab3d_2), &
- & tab3d_1 = REAL(tab3d_1, 2*wp), tab3d_2 = REAL(tab3d_2, 2*wp), &
+ & tab3d_1 = REAL(tab3d_1, dp), tab3d_2 = REAL(tab3d_2, dp), &
& mask1 = mask1, mask2 = mask2, &
& clinfo = clinfo, clinfo1 = clinfo1, clinfo2 = clinfo2, clinfo3 = clinfo3, kdim = kdim )
ELSEIF( PRESENT(tab2d_1) ) THEN
CALL prt_ctl_t(ktab2d_1 = is_tile(tab2d_1), ktab3d_1 = 0, ktab4d_1 = 0, ktab2d_2 = 0, ktab3d_2 = 0, &
- & tab2d_1 = REAL(tab2d_1,2*wp), &
+ & tab2d_1 = REAL(tab2d_1,dp), &
& mask1 = mask1, &
& clinfo = clinfo, clinfo1 = clinfo1, clinfo3 = clinfo3 )
ELSEIF( PRESENT(tab3d_1) ) THEN
CALL prt_ctl_t(ktab2d_1 = 0, ktab3d_1 = is_tile(tab3d_1), ktab4d_1 = 0, ktab2d_2 = 0, ktab3d_2 = 0, &
- & tab3d_1 = REAL(tab3d_1, 2*wp), &
+ & tab3d_1 = REAL(tab3d_1, dp), &
& mask1 = mask1, &
& clinfo = clinfo, clinfo1 = clinfo1, clinfo3 = clinfo3, kdim = kdim )
ELSEIF( PRESENT(tab4d_1) ) THEN
CALL prt_ctl_t(ktab2d_1 = 0, ktab3d_1 = 0, ktab4d_1 = is_tile(tab4d_1), ktab2d_2 = 0, ktab3d_2 = 0, &
- & tab4d_1 = REAL(tab4d_1, 2*wp), &
+ & tab4d_1 = REAL(tab4d_1, dp), &
& mask1 = mask1, &
- & clinfo = clinfo, clinfo1 = clinfo1, clinfo3 = clinfo3, kdim = kdim )
+ & clinfo = clinfo, clinfo1 = clinfo1, clinfo3 = clinfo3, kdim = kdim )
ENDIF
END SUBROUTINE prt_ctl
@@ -119,11 +119,11 @@ CONTAINS
!! clinfo3 : additional information
!!----------------------------------------------------------------------
INTEGER , INTENT(in) :: ktab2d_1, ktab3d_1, ktab4d_1, ktab2d_2, ktab3d_2
- REAL(2*wp), DIMENSION(A2D_T(ktab2d_1)) , INTENT(in), OPTIONAL :: tab2d_1
- REAL(2*wp), DIMENSION(A2D_T(ktab3d_1),:) , INTENT(in), OPTIONAL :: tab3d_1
- REAL(2*wp), DIMENSION(A2D_T(ktab4d_1),:,:), INTENT(in), OPTIONAL :: tab4d_1
- REAL(2*wp), DIMENSION(A2D_T(ktab2d_2)) , INTENT(in), OPTIONAL :: tab2d_2
- REAL(2*wp), DIMENSION(A2D_T(ktab3d_2),:) , INTENT(in), OPTIONAL :: tab3d_2
+ REAL(dp), DIMENSION(A2D_T(ktab2d_1)) , INTENT(in), OPTIONAL :: tab2d_1
+ REAL(dp), DIMENSION(A2D_T(ktab3d_1),:) , INTENT(in), OPTIONAL :: tab3d_1
+ REAL(dp), DIMENSION(A2D_T(ktab4d_1),:,:), INTENT(in), OPTIONAL :: tab4d_1
+ REAL(dp), DIMENSION(A2D_T(ktab2d_2)) , INTENT(in), OPTIONAL :: tab2d_2
+ REAL(dp), DIMENSION(A2D_T(ktab3d_2),:) , INTENT(in), OPTIONAL :: tab3d_2
REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: mask1
REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: mask2
CHARACTER(len=*), DIMENSION(:) , INTENT(in), OPTIONAL :: clinfo ! information about the tab3d array
@@ -137,7 +137,7 @@ CONTAINS
INTEGER :: jn, jl, kdir
INTEGER :: iis, iie, jjs, jje
INTEGER :: itra, inum
- REAL(2*wp) :: zsum1, zsum2, zvctl1, zvctl2
+ REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2
!!----------------------------------------------------------------------
!
! Arrays, scalars initialization
diff --git a/src/OCE/IOM/restart.F90 b/src/OCE/IOM/restart.F90
index 7052cb16436354077a6fc4637e03a6dd1430eafe..9ae044782e6d0198c4c53e443c2ae30d3d939c53 100644
--- a/src/OCE/IOM/restart.F90
+++ b/src/OCE/IOM/restart.F90
@@ -294,8 +294,8 @@ CONTAINS
#else
! !* Read Kmm fields (MLF only)
IF(lwp) WRITE(numout,*) ' Kmm u, v and T-S fields read in the restart file'
- CALL iom_get( numror, jpdom_auto, 'un', uu(:,:,: ,Kmm), cd_type = 'U', psgn = -1._wp )
- CALL iom_get( numror, jpdom_auto, 'vn', vv(:,:,: ,Kmm), cd_type = 'V', psgn = -1._wp )
+ CALL iom_get( numror, jpdom_auto, 'un', uu(:,:,: ,Kmm), cd_type = 'U', psgn = -1._dp )
+ CALL iom_get( numror, jpdom_auto, 'vn', vv(:,:,: ,Kmm), cd_type = 'V', psgn = -1._dp )
CALL iom_get( numror, jpdom_auto, 'tn', ts(:,:,:,jp_tem,Kmm) )
CALL iom_get( numror, jpdom_auto, 'sn', ts(:,:,:,jp_sal,Kmm) )
!
@@ -307,8 +307,8 @@ CONTAINS
!
ELSE !* Leap frog restart (MLF only)
IF(lwp) WRITE(numout,*) ' Kbb u, v and T-S fields read in the restart file'
- CALL iom_get( numror, jpdom_auto, 'ub', uu(:,:,: ,Kbb), cd_type = 'U', psgn = -1._wp )
- CALL iom_get( numror, jpdom_auto, 'vb', vv(:,:,: ,Kbb), cd_type = 'V', psgn = -1._wp )
+ CALL iom_get( numror, jpdom_auto, 'ub', uu(:,:,: ,Kbb), cd_type = 'U', psgn = -1._dp )
+ CALL iom_get( numror, jpdom_auto, 'vb', vv(:,:,: ,Kbb), cd_type = 'V', psgn = -1._dp )
CALL iom_get( numror, jpdom_auto, 'tb', ts(:,:,:,jp_tem,Kbb) )
CALL iom_get( numror, jpdom_auto, 'sb', ts(:,:,:,jp_sal,Kbb) )
ENDIF
diff --git a/src/OCE/ISF/isf_oce.F90 b/src/OCE/ISF/isf_oce.F90
index 16ff46027734df283a16c60d2e0c74ecfba4646a..6ddd20daa29a6276c0accf3d77305054ce2cd099 100644
--- a/src/OCE/ISF/isf_oce.F90
+++ b/src/OCE/ISF/isf_oce.F90
@@ -12,7 +12,7 @@ MODULE isf_oce
!!----------------------------------------------------------------------
!! isf : define and allocate ice shelf variables
!!----------------------------------------------------------------------
-
+ USE par_kind
USE par_oce , ONLY: jpi, jpj, jpk
USE in_out_manager, ONLY: wp, jpts ! I/O manager
USE lib_mpp , ONLY: ctl_stop, mpp_sum ! MPP library
diff --git a/src/OCE/ISF/isfcavmlt.F90 b/src/OCE/ISF/isfcavmlt.F90
index 665d75bbc60ca44af283e8ee5f7ead3aa319ea3e..74ddbdfe8140c4046a0c4f2efae8d250b71349e8 100644
--- a/src/OCE/ISF/isfcavmlt.F90
+++ b/src/OCE/ISF/isfcavmlt.F90
@@ -32,6 +32,7 @@ MODULE isfcavmlt
PUBLIC isfcav_mlt
!! * Substitutions
+# include "single_precision_substitute.h90"
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -112,7 +113,7 @@ CONTAINS
!!--------------------------------------------------------------------
!
! Compute freezing temperature
- CALL eos_fzp( pstbl(:,:), ztfrz(:,:), risfdep(:,:) )
+ CALL eos_fzp( pstbl(:,:), ztfrz(:,:), CASTDP(risfdep(:,:)) )
!
! read input file of fwf (from isf to oce; ie melt)
CALL fld_read ( kt, 1, sf_isfcav_fwf )
@@ -157,7 +158,7 @@ CONTAINS
!!--------------------------------------------------------------------
!
! Calculate freezing temperature
- CALL eos_fzp( pstbl(:,:), ztfrz(:,:), risfdep(:,:) )
+ CALL eos_fzp( pstbl(:,:), ztfrz(:,:), CASTDP(risfdep(:,:)) )
!
! thermal driving
zthd (:,:) = ( pttbl(:,:) - ztfrz(:,:) ) * mskisf_cav(:,:)
@@ -281,7 +282,7 @@ CONTAINS
!!--------------------------------------------------------------------
!
! Calculate freezing temperature
- CALL eos_fzp( pstbl(:,:), ztfrz(:,:), risfdep(:,:) )
+ CALL eos_fzp( pstbl(:,:), ztfrz(:,:), CASTDP(risfdep(:,:)) )
!
! read input file of fwf from isf to oce
CALL fld_read ( kt, 1, sf_isfcav_fwf )
diff --git a/src/OCE/ISF/isfcpl.F90 b/src/OCE/ISF/isfcpl.F90
index b035cd5e6095a4206dedf0ccd81f612125a55e3c..5a70f9f9f1c82ee6efead92fd46c5c786ba195c5 100644
--- a/src/OCE/ISF/isfcpl.F90
+++ b/src/OCE/ISF/isfcpl.F90
@@ -48,6 +48,7 @@ MODULE isfcpl
!
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -200,7 +201,8 @@ CONTAINS
zssmask_b(ji,jj) = 1._wp
ENDIF
END_2D
- CALL lbc_lnk( 'isfcpl', ssh(:,:,Kmm), 'T', 1.0_wp, zssmask_b(:,:), 'T', 1.0_wp )
+ CALL lbc_lnk( 'isfcpl', ssh(:,:,Kmm), 'T', 1.0_dp)
+ CALL lbc_lnk( 'isfcpl', zssmask_b(:,:), 'T', 1.0_wp )
!
zssh(:,:) = ssh(:,:,Kmm)
zssmask0(:,:) = zssmask_b(:,:)
@@ -213,7 +215,7 @@ CONTAINS
!
ssh(:,:,Kbb) = ssh(:,:,Kmm)
!
- IF ( ln_isfdebug ) CALL debug('isfcpl_ssh: sshn',ssh(:,:,Kmm))
+ IF ( ln_isfdebug ) CALL debug('isfcpl_ssh: sshn',CASTSP(ssh(:,:,Kmm)))
!
! recompute the vertical scale factor, depth and water thickness
IF(lwp) write(numout,*) 'isfcpl_ssh : recompute scale factor from ssh (new wet cell,Kmm)'
@@ -358,7 +360,8 @@ CONTAINS
END_2D
END DO
!
- CALL lbc_lnk( 'isfcpl', ts(:,:,:,jp_tem,Kmm), 'T', 1.0_wp, ts(:,:,:,jp_sal,Kmm), 'T', 1.0_wp, ztmask1, 'T', 1.0_wp)
+ CALL lbc_lnk( 'isfcpl', ts(:,:,:,jp_tem,Kmm), 'T', 1.0_dp, ts(:,:,:,jp_sal,Kmm), 'T', 1.0_dp)
+ CALL lbc_lnk( 'isfcpl', ztmask1, 'T', 1.0_wp)
!
! update temperature and salinity and mask
zts0(:,:,:,:) = ts(:,:,:,:,Kmm)
diff --git a/src/OCE/ISF/isfdiags.F90 b/src/OCE/ISF/isfdiags.F90
index b9f97736462037f2497b7722ffe64a890895dddd..b6732bc6c11bde416ab4638c79e5a2207a28d767 100644
--- a/src/OCE/ISF/isfdiags.F90
+++ b/src/OCE/ISF/isfdiags.F90
@@ -72,7 +72,7 @@ CONTAINS
IF ( iom_use( TRIM(cvarqlat3d) ) ) CALL isf_diags_2dto3d( Kmm, ktop, kbot, phtbl, pfrac, TRIM(cvarqlat3d) , pqoce(:,:))
IF ( iom_use( TRIM(cvarqhc3d) ) ) CALL isf_diags_2dto3d( Kmm, ktop, kbot, phtbl, pfrac, TRIM(cvarqhc3d) , pqhc (:,:))
!
- END SUBROUTINE
+ END SUBROUTINE isf_diags_flx
SUBROUTINE isf_diags_2dto3d(Kmm, ktop, kbot, phtbl, pfrac, cdvar, pvar2d)
!!---------------------------------------------------------------------
diff --git a/src/OCE/ISF/isfload.F90 b/src/OCE/ISF/isfload.F90
index a069cdf5d126bb61db99c67ae358bca283062d9e..4278c55f19219f835795ecceadcfc85714325973 100644
--- a/src/OCE/ISF/isfload.F90
+++ b/src/OCE/ISF/isfload.F90
@@ -26,6 +26,7 @@ MODULE isfload
!
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -87,7 +88,7 @@ CONTAINS
#if defined key_qco && key_isf
CALL eos( zts_top(:,:,:), gdept_0(:,:,jk), zrhd(:,:,jk) )
#else
- CALL eos( zts_top(:,:,:), gdept(:,:,jk,Kmm), zrhd(:,:,jk) )
+ CALL eos( zts_top(:,:,:), CASTSP(gdept(:,:,jk,Kmm)), zrhd(:,:,jk) )
#endif
END DO
!
diff --git a/src/OCE/ISF/isfparmlt.F90 b/src/OCE/ISF/isfparmlt.F90
index 237e3bee3b9cf5ad4c03b0f10c48be235440d9ae..d36699100e7b35b6a15002c89cdf33f90b6b10d1 100644
--- a/src/OCE/ISF/isfparmlt.F90
+++ b/src/OCE/ISF/isfparmlt.F90
@@ -30,6 +30,7 @@ MODULE isfparmlt
!! * Substitutions
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -110,9 +111,9 @@ CONTAINS
! compute ptfrz
! 1. ------------Mean freezing point
DO jk = 1,jpk
- CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
+ CALL eos_fzp(CASTSP(ts(:,:,jk,jp_sal,Kmm)), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
END DO
- CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
+ CALL isf_tbl(Kmm, CASTDP(ztfrz3d), ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
!
pqfwf(:,:) = sf_isfpar_fwf(1)%fnow(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting) ( > 0 from isf to oce)
pqoce(:,:) = - pqfwf(:,:) * rLfusisf ! ocean/ice shelf flux assume to be equal to latent heat flux ( > 0 from isf to oce)
@@ -151,9 +152,9 @@ CONTAINS
!
! 0. ------------Mean freezing point
DO jk = 1,jpk
- CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
+ CALL eos_fzp(CASTSP(ts(:,:,jk,jp_sal,Kmm)), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
END DO
- CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
+ CALL isf_tbl(Kmm, CASTDP(ztfrz3d), ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
!
! 1. ------------Mean temperature
CALL isf_tbl(Kmm, ts(:,:,:,jp_tem,Kmm), ztavg, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
@@ -204,9 +205,9 @@ CONTAINS
!
! 1. ------------Mean freezing point (needed for heat content flux)
DO jk = 1,jpk
- CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
+ CALL eos_fzp(CASTSP(ts(:,:,jk,jp_sal,Kmm)), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
END DO
- CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
+ CALL isf_tbl(Kmm, CASTDP(ztfrz3d), ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
!
! 2. ------------Scale isf melt pattern with total amount from oasis
! ice shelf 2d map of fwf from isf to oce
diff --git a/src/OCE/ISF/isfstp.F90 b/src/OCE/ISF/isfstp.F90
index cef91bb94f49dc3e2d2fe816186adcea610f6294..e774910949c0c330a7c24373c4fc8e660c0199ee 100644
--- a/src/OCE/ISF/isfstp.F90
+++ b/src/OCE/ISF/isfstp.F90
@@ -35,6 +35,7 @@ MODULE isfstp
PUBLIC isf_stp, isf_init, isf_nam ! routine called in sbcmod and divhor
!! * Substitutions
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -86,7 +87,7 @@ CONTAINS
DO jk = 1, jpk
ze3t(:,:,jk) = e3t(:,:,jk,Kmm)
END DO
- CALL isf_tbl_lvl( ht(:,:), ze3t , misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav )
+ CALL isf_tbl_lvl( CASTSP(ht(:,:)), ze3t , misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav )
#else
CALL isf_tbl_lvl( ht(:,:), e3t(:,:,:,Kmm), misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav )
#endif
@@ -115,7 +116,7 @@ CONTAINS
DO jk = 1, jpk
ze3t(:,:,jk) = e3t(:,:,jk,Kmm)
END DO
- CALL isf_tbl_lvl( ht(:,:), ze3t , misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par )
+ CALL isf_tbl_lvl( CASTSP(ht(:,:)), ze3t , misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par )
#else
CALL isf_tbl_lvl( ht(:,:), e3t(:,:,:,Kmm), misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par )
#endif
diff --git a/src/OCE/ISF/isftbl.F90 b/src/OCE/ISF/isftbl.F90
index c6b3adc3bea892cb74f29764f47d0e6c65f2d9a6..efa2ed79b5afadafed9e074becf1bfe69196c038 100644
--- a/src/OCE/ISF/isftbl.F90
+++ b/src/OCE/ISF/isftbl.F90
@@ -44,7 +44,7 @@ CONTAINS
!!-------------------------- IN -------------------------------------
INTEGER , INTENT(in ) :: Kmm ! ocean time level index
CHARACTER(len=1) , INTENT(in ) :: cd_ptin ! point of variable in/out
- REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pvarin ! 3d variable to average over the tbl
+ REAL(dp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pvarin ! 3d variable to average over the tbl
INTEGER, DIMENSION(jpi,jpj) , INTENT(in ) :: ktop ! top level
REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: phtbl ! tbl thickness
!!-------------------------- IN OPTIONAL -----------------------------
@@ -130,7 +130,7 @@ CONTAINS
INTEGER, DIMENSION(jpi,jpj) , INTENT(in ) :: ktop, kbot ! top and bottom level of the top boundary layer
REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: phtbl, pfrac ! fraction of bottom level to be affected by the tbl
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pe3 ! vertical scale factor
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pvarin ! tbl property to average between ktop, kbot over phtbl
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pvarin ! tbl property to average between ktop, kbot over phtbl
!!--------------------------------------------------------------------
INTEGER :: ji,jj,jk ! loop indices
INTEGER :: ikt, ikb ! top and bottom levels
diff --git a/src/OCE/ISF/isfutils.F90 b/src/OCE/ISF/isfutils.F90
index 63c489c59abba9230949223abe4a93736a340fcb..3d6e4183074d31ed1262131fe307f3f825feeb5a 100644
--- a/src/OCE/ISF/isfutils.F90
+++ b/src/OCE/ISF/isfutils.F90
@@ -10,12 +10,12 @@ MODULE isfutils
!! isfutils : - read_2dcstdta to read a constant input file with iom_get
!! - debug to print array sum, min, max in ocean.output
!!----------------------------------------------------------------------
-
+ USE par_kind
USE iom , ONLY: iom_open, iom_get, iom_close, jpdom_global ! read input file
USE lib_fortran , ONLY: glob_sum, glob_min, glob_max ! compute global value
USE par_oce , ONLY: jpi,jpj,jpk, jpnij, Nis0, Nie0, Njs0, Nje0 ! domain size
USE dom_oce , ONLY: narea ! local domain
- USE in_out_manager, ONLY: i8, wp, lwp, numout ! miscelenious
+ USE in_out_manager, ONLY: lwp, numout ! miscelenious
USE lib_mpp
IMPLICIT NONE
@@ -28,6 +28,7 @@ MODULE isfutils
PUBLIC read_2dcstdta, debug
+# include "single_precision_substitute.h90"
CONTAINS
SUBROUTINE read_2dcstdta(cdfile, cdvar, pvar)
@@ -70,9 +71,9 @@ CONTAINS
!!--------------------------------------------------------------------
!
! global min/max/sum to check data range and NaN
- zsum = glob_sum( 'debug', pvar(:,:) )
- zmin = glob_min( 'debug', pvar(:,:) )
- zmax = glob_max( 'debug', pvar(:,:) )
+ zsum =glob_sum( 'debug', CASTDP(pvar(:,:)) )
+ zmin = glob_min( 'debug', CASTDP(pvar(:,:)) )
+ zmax = glob_max( 'debug', CASTDP(pvar(:,:)) )
!
! basic check sum to check reproducibility
! TRANSFER function find out the integer corresponding to pvar(i,j) bit pattern
@@ -112,7 +113,7 @@ CONTAINS
!!
!!-------------------------- IN -------------------------------------
CHARACTER(LEN=*) , INTENT(in ) :: cdtxt
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pvar
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pvar
!!--------------------------------------------------------------------
REAL(wp) :: zmin, zmax, zsum
INTEGER(i8) :: imodd, ip
diff --git a/src/OCE/LBC/lbc_lnk_neicoll_generic.h90 b/src/OCE/LBC/lbc_lnk_neicoll_generic.h90
index 3ce416fe1fbf4ed39abd342c0ec78d204abc82d7..4da6498a1bf24c7432434e7a3212931b9c961249 100644
--- a/src/OCE/LBC/lbc_lnk_neicoll_generic.h90
+++ b/src/OCE/LBC/lbc_lnk_neicoll_generic.h90
@@ -1,5 +1,4 @@
-
- SUBROUTINE lbc_lnk_neicoll_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only )
+SUBROUTINE lbc_lnk_neicoll_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only )
CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine
TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c.
CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points
@@ -270,4 +269,3 @@
ENDIF
!
END SUBROUTINE lbc_lnk_neicoll_/**/PRECISION
-
diff --git a/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90 b/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90
index 395a3e93c037cf53ac82eb911726c24926168d3b..c832081a37b2da5f37fafdf3f3f239828251090c 100644
--- a/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90
+++ b/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90
@@ -1,4 +1,3 @@
-
#if ! defined BLOCK_ISEND && ! defined BLOCK_FILL
SUBROUTINE lbc_lnk_pt2pt_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only )
CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine
diff --git a/src/OCE/LBC/lbc_nfd_ext_generic.h90 b/src/OCE/LBC/lbc_nfd_ext_generic.h90
index 22e7ee348d86deb94129b3a4ef3be9e1703f1106..f825953ce155c12c69fbfdd4ed45e8387c54c7a5 100644
--- a/src/OCE/LBC/lbc_nfd_ext_generic.h90
+++ b/src/OCE/LBC/lbc_nfd_ext_generic.h90
@@ -1,5 +1,4 @@
-
- SUBROUTINE lbc_nfd_ext_/**/PRECISION( ptab, cd_nat, psgn, kextj )
+SUBROUTINE lbc_nfd_ext_/**/PRECISION( ptab, cd_nat, psgn, kextj )
!!----------------------------------------------------------------------
REAL(PRECISION), DIMENSION(:,1-kextj:),INTENT(inout) :: ptab
CHARACTER(len=1), INTENT(in ) :: cd_nat ! nature of array grid-points
@@ -117,4 +116,3 @@
ENDIF ! c_NFtype == 'F'
!
END SUBROUTINE lbc_nfd_ext_/**/PRECISION
-
diff --git a/src/OCE/LBC/lbc_nfd_generic.h90 b/src/OCE/LBC/lbc_nfd_generic.h90
index 18ae89738204699f95b59a2dd15ad27419865f7b..87c7b70e530fc91fb1f426432541731b89435780 100644
--- a/src/OCE/LBC/lbc_nfd_generic.h90
+++ b/src/OCE/LBC/lbc_nfd_generic.h90
@@ -1,5 +1,4 @@
-
- SUBROUTINE lbc_nfd_/**/PRECISION( ptab, cd_nat, psgn, khls, kfld )
+SUBROUTINE lbc_nfd_/**/PRECISION( ptab, cd_nat, psgn, khls, kfld )
TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c.
CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points
REAL(PRECISION), DIMENSION(:), INTENT(in ) :: psgn ! sign used across the north fold boundary
@@ -388,4 +387,3 @@
END DO ! ipf
!
END SUBROUTINE lbc_nfd_/**/PRECISION
-
diff --git a/src/OCE/LBC/mpp_lnk_icb_generic.h90 b/src/OCE/LBC/mpp_lnk_icb_generic.h90
index 8798f3e0c3e71217ced192fbb3c1f1879c0640fd..0be8c51df1e0781293adfd3c016f8150c072f4da 100644
--- a/src/OCE/LBC/mpp_lnk_icb_generic.h90
+++ b/src/OCE/LBC/mpp_lnk_icb_generic.h90
@@ -180,4 +180,4 @@
# undef LBCNORTH
# undef PRECISION
# undef SENDROUTINE
-# undef RECVROUTINE
+# undef RECVROUTINE
diff --git a/src/OCE/LBC/mpp_loc_generic.h90 b/src/OCE/LBC/mpp_loc_generic.h90
index 1bce8df2d3c2fb7e677f68185a5309346e764450..21783b85eea64eaa65a897d7311082636e390d82 100644
--- a/src/OCE/LBC/mpp_loc_generic.h90
+++ b/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(sp) , INTENT(in ) :: ARRAY_IN(i,j,k)
+# define ARRAY_TYPE(i,j,k) REAL(dp) , INTENT(in ) :: ARRAY_IN(i,j,k)
#if ! defined key_mpi_off
# define MPI_TYPE MPI_2REAL
#endif
diff --git a/src/OCE/LBC/mpp_nfd_generic.h90 b/src/OCE/LBC/mpp_nfd_generic.h90
index fd45035fe4f651ae275d26a3c83f08f2bd192911..d6e6101842cd62c1fdb3699a724742dfdc3e652e 100644
--- a/src/OCE/LBC/mpp_nfd_generic.h90
+++ b/src/OCE/LBC/mpp_nfd_generic.h90
@@ -1,5 +1,4 @@
-
- SUBROUTINE mpp_nfd_/**/PRECISION( ptab, cd_nat, psgn, kfillmode, pfillval, khls, kfld )
+SUBROUTINE mpp_nfd_/**/PRECISION( ptab, cd_nat, psgn, kfillmode, pfillval, khls, kfld )
TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c.
CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points
REAL(PRECISION), DIMENSION(:), INTENT(in ) :: psgn ! sign used across the north fold boundary
@@ -395,4 +394,3 @@
ENDIF ! ln_nnogather
!
END SUBROUTINE mpp_nfd_/**/PRECISION
-
diff --git a/src/OCE/LDF/ldfslp.F90 b/src/OCE/LDF/ldfslp.F90
index 1b5b09ea5a0ae83a5205a5cac4a56a7b9f87f492..a777f670a48b6e04cd52144b0d8f6a5579dbfad0 100644
--- a/src/OCE/LDF/ldfslp.F90
+++ b/src/OCE/LDF/ldfslp.F90
@@ -74,6 +74,7 @@ MODULE ldfslp
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -320,8 +321,8 @@ CONTAINS
CALL lbc_lnk( 'ldfslp', uslp , 'U', -1.0_wp , vslp , 'V', -1.0_wp , wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp )
IF(sn_cfctl%l_prtctl) THEN
- CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp - u : ', tab3d_2=vslp, clinfo2=' v : ')
- CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp - wi: ', tab3d_2=wslpj, clinfo2=' wj: ')
+ CALL prt_ctl(tab3d_1=CASTDP(uslp), clinfo1=' slp - u : ', tab3d_2=CASTDP(vslp), clinfo2=' v : ')
+ CALL prt_ctl(tab3d_1=CASTDP(wslpi), clinfo1=' slp - wi: ', tab3d_2=CASTDP(wslpj), clinfo2=' wj: ')
ENDIF
!
IF( ln_timing ) CALL timing_stop('ldf_slp')
diff --git a/src/OCE/LDF/ldftra.F90 b/src/OCE/LDF/ldftra.F90
index 5aaeecd83377adecee77293f3be7b023a3a7c4cb..cfa3f05aa0fd4cc4c0a7e42958e4e3879120c0de 100644
--- a/src/OCE/LDF/ldftra.F90
+++ b/src/OCE/LDF/ldftra.F90
@@ -730,7 +730,7 @@ CONTAINS
CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
! TEMP: [tiling] 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(inout) :: pu ! in : 3 ocean transport components [m3/s]
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pv ! out: 3 ocean transport components [m3/s]
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pv ! out: 3 ocean transport components [m3/s]
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pw ! increased by the eiv [m3/s]
!!
INTEGER :: ji, jj, jk ! dummy loop indices
@@ -867,7 +867,7 @@ CONTAINS
CALL iom_put( "veiv_heattr" , zztmp * zw2d ) ! heat transport in j-direction
CALL iom_put( "veiv_heattr3d", zztmp * zw3d ) ! heat transport in j-direction
!
- IF( iom_use( 'sophteiv' ) ) CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d )
+ IF( iom_use( 'sophteiv' ) ) CALL dia_ptr_hst( jp_tem, 'eiv', 0.5_wp * zw3d )
!
zztmp = 0.5_wp * 0.5
IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN
@@ -891,7 +891,7 @@ CONTAINS
CALL iom_put( "veiv_salttr" , zztmp * zw2d ) ! salt transport in j-direction
CALL iom_put( "veiv_salttr3d", zztmp * zw3d ) ! salt transport in j-direction
!
- IF( iom_use( 'sopsteiv' ) ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d )
+ IF( iom_use( 'sopsteiv' ) ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5_wp * zw3d )
!
!
END SUBROUTINE ldf_eiv_dia
diff --git a/src/OCE/OBS/ddatetoymdhms.h90 b/src/OCE/OBS/ddatetoymdhms.h90
index 3cd21f1e0dc9cb58fababa676d7faaede7c5604e..f114e601bdd742cfb5a36fb30bcb3a44537d9dfa 100644
--- a/src/OCE/OBS/ddatetoymdhms.h90
+++ b/src/OCE/OBS/ddatetoymdhms.h90
@@ -1,4 +1,4 @@
- !!----------------------------------------------------------------------
+!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: ddatetoymdhms.h90 13226 2020-07-02 14:24:31Z orioltp $
!! Software governed by the CeCILL license (see ./LICENSE)
@@ -20,7 +20,7 @@
!! * Modules used
!! * Arguments
- real(dp), INTENT(IN) :: ddate
+ real(wp), INTENT(IN) :: ddate
INTEGER, INTENT(OUT) :: kyea
INTEGER, INTENT(OUT) :: kmon
INTEGER, INTENT(OUT) :: kday
diff --git a/src/OCE/OBS/diaobs.F90 b/src/OCE/OBS/diaobs.F90
index 7d6b84576804423b710a091f2d34165945722200..1e831ab8a14936d743163c261ef4fbb39ba5e07b 100644
--- a/src/OCE/OBS/diaobs.F90
+++ b/src/OCE/OBS/diaobs.F90
@@ -161,8 +161,8 @@ CONTAINS
LOGICAL, DIMENSION(:), ALLOCATABLE :: llvar ! Logical for profile variable read
LOGICAL, DIMENSION(jpmaxnfiles) :: lmask ! Used for finding number of sstbias files
!
- REAL(dp) :: rn_dobsini ! Obs window start date YYYYMMDD.HHMMSS
- REAL(dp) :: rn_dobsend ! Obs window end date YYYYMMDD.HHMMSS
+ REAL(wp) :: rn_dobsini ! Obs window start date YYYYMMDD.HHMMSS
+ REAL(wp) :: rn_dobsend ! Obs window end date YYYYMMDD.HHMMSS
REAL(wp) :: ztype_avglamscl ! Local version of rn_*_avglamscl
REAL(wp) :: ztype_avgphiscl ! Local version of rn_*_avgphiscl
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zglam ! Model longitudes for profile variables
@@ -902,8 +902,8 @@ CONTAINS
IMPLICIT NONE
!! * Arguments
- REAL(KIND=dp), INTENT(OUT) :: ddobs ! Date in YYYYMMDD.HHMMSS
- INTEGER :: kstp
+ REAL(KIND=wp), INTENT(OUT) :: ddobs ! Date in YYYYMMDD.HHMMSS
+ INTEGER, INTENT(IN) :: kstp
!! * Local declarations
INTEGER :: iyea ! date - (year, month, day, hour, minute)
@@ -986,7 +986,7 @@ CONTAINS
IMPLICIT NONE
!! * Arguments
- REAL(KIND=dp), INTENT(OUT) :: ddobsini ! Initial date in YYYYMMDD.HHMMSS
+ REAL(KIND=wp), INTENT(OUT) :: ddobsini ! Initial date in YYYYMMDD.HHMMSS
CALL calc_date( nit000 - 1, ddobsini )
@@ -1013,7 +1013,7 @@ CONTAINS
IMPLICIT NONE
!! * Arguments
- REAL(dp), INTENT(OUT) :: ddobsfin ! Final date in YYYYMMDD.HHMMSS
+ REAL(wp), INTENT(OUT) :: ddobsfin ! Final date in YYYYMMDD.HHMMSS
CALL calc_date( nitend, ddobsfin )
diff --git a/src/OCE/OBS/find_obs_proc.h90 b/src/OCE/OBS/find_obs_proc.h90
index 605d339575b3d7f08517e2df27eea97dce28916f..077f3ce583374482ea97588110acacf175ed6729 100644
--- a/src/OCE/OBS/find_obs_proc.h90
+++ b/src/OCE/OBS/find_obs_proc.h90
@@ -1,4 +1,4 @@
- !!----------------------------------------------------------------------
+!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: find_obs_proc.h90 13286 2020-07-09 15:48:29Z smasson $
!! Software governed by the CeCILL license (see ./LICENSE)
diff --git a/src/OCE/OBS/greg2jul.h90 b/src/OCE/OBS/greg2jul.h90
index 5bef12f84639d4ffe9a61b21a339945276a46344..59560cc3c409f5cbf62f41feddc7d251f90d4229 100644
--- a/src/OCE/OBS/greg2jul.h90
+++ b/src/OCE/OBS/greg2jul.h90
@@ -1,4 +1,4 @@
- SUBROUTINE greg2jul( ksec, kmin, khour, kday, kmonth, kyear, pjulian, &
+SUBROUTINE greg2jul( ksec, kmin, khour, kday, kmonth, kyear, pjulian, &
& krefdate )
!!-----------------------------------------------------------------------
!!
diff --git a/src/OCE/OBS/grt_cir_dis.h90 b/src/OCE/OBS/grt_cir_dis.h90
index b797b45c70dd25b223edd9c9624355de9f01cd97..df94da030a8d2b1bad969bf69d2a0e5eb60ee477 100644
--- a/src/OCE/OBS/grt_cir_dis.h90
+++ b/src/OCE/OBS/grt_cir_dis.h90
@@ -1,4 +1,4 @@
- !!----------------------------------------------------------------------
+!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: grt_cir_dis.h90 13226 2020-07-02 14:24:31Z orioltp $
!! Software governed by the CeCILL license (see ./LICENSE)
diff --git a/src/OCE/OBS/grt_cir_dis_saa.h90 b/src/OCE/OBS/grt_cir_dis_saa.h90
index 794193e134a05f1a8d3b15108318cb5ffbd98bb4..f6b39a5f016254f9fe7294d752c0f248169c469b 100644
--- a/src/OCE/OBS/grt_cir_dis_saa.h90
+++ b/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)
@@ -29,4 +29,3 @@
grt_cir_dis_saa = SQRT( pa * pa + ( pb * pc )**2 )
END FUNCTION grt_cir_dis_saa
-
diff --git a/src/OCE/OBS/jul2greg.h90 b/src/OCE/OBS/jul2greg.h90
index f9b2823974633741900123d956e99b8831ac8dbc..ec75a986c7eab7bbfcecd125d7e654b155cafcd7 100644
--- a/src/OCE/OBS/jul2greg.h90
+++ b/src/OCE/OBS/jul2greg.h90
@@ -1,4 +1,4 @@
- RECURSIVE SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, &
+RECURSIVE SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, &
& prelday, krefdate )
!!-----------------------------------------------------------------------
!!
diff --git a/src/OCE/OBS/linquad.h90 b/src/OCE/OBS/linquad.h90
index 0dafa16e6d4ff09c0e4a113348c2db9e41924029..428793c106a236325724779939719a4ece1c15f5 100644
--- a/src/OCE/OBS/linquad.h90
+++ b/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)
@@ -56,4 +56,3 @@
ENDIF
END FUNCTION linquad
-
diff --git a/src/OCE/OBS/maxdist.h90 b/src/OCE/OBS/maxdist.h90
index 47f535fe71c03cf1fe42f41eee45e4bf8313dadd..89420f2ef4c198e41fc0c7d0d7bd90a6cabc40c0 100644
--- a/src/OCE/OBS/maxdist.h90
+++ b/src/OCE/OBS/maxdist.h90
@@ -1,10 +1,10 @@
- !!----------------------------------------------------------------------
+!!----------------------------------------------------------------------
!! 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)
!!----------------------------------------------------------------------
- REAL FUNCTION maxdist( pxv, pyv )
+ REAL(wp) FUNCTION maxdist( pxv, pyv )
!!----------------------------------------------------------------------
!! *** FUNCTION maxdist ***
!!
diff --git a/src/OCE/OBS/obs_const.F90 b/src/OCE/OBS/obs_const.F90
index d75941bf4df2a0d29612e74ba40aeeb95c220fd1..0887e3e1b60f2e174b47ebb8293e13b3fbb692a6 100644
--- a/src/OCE/OBS/obs_const.F90
+++ b/src/OCE/OBS/obs_const.F90
@@ -20,4 +20,3 @@ MODULE obs_const
REAL(kind=sp), PARAMETER :: obfillflt=99999.
END MODULE obs_const
-
diff --git a/src/OCE/OBS/obs_conv.F90 b/src/OCE/OBS/obs_conv.F90
index b84e5bc2c77b85d289f84b7616d12d624905a936..9c08464f40a2c9d2b13345a01eabc5f888975ccf 100644
--- a/src/OCE/OBS/obs_conv.F90
+++ b/src/OCE/OBS/obs_conv.F90
@@ -18,8 +18,7 @@ MODULE obs_conv
!! (approximate version)
!!---------------------------------------------------------------------
!! * Modules used
- USE par_kind, ONLY : & ! Precision variables
- & wp
+ USE par_kind
IMPLICIT NONE
!! * Function accessibility
diff --git a/src/OCE/OBS/obs_conv_functions.h90 b/src/OCE/OBS/obs_conv_functions.h90
index c89d80170fdd6d96a9c61d638ed8c5287f99dcb2..a74f65e9278d5f2a03c3d48aa0610f91e18c6742 100644
--- a/src/OCE/OBS/obs_conv_functions.h90
+++ b/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/src/OCE/OBS/obs_fbm.F90 b/src/OCE/OBS/obs_fbm.F90
index 9e591bf56c7898cae0f0ef4b46f80993f2675f8c..5c7df75b6f1431a5ca2dfb0c29f810907a8e226a 100644
--- a/src/OCE/OBS/obs_fbm.F90
+++ b/src/OCE/OBS/obs_fbm.F90
@@ -1544,7 +1544,7 @@ CONTAINS
CHARACTER(len=*) :: cdlongname ! Long name for variable
CHARACTER(len=*), OPTIONAL :: cdunits ! Units for variable
CHARACTER(len=*), OPTIONAL :: cfillvalue ! Fill value for character variables
- INTEGER, OPTIONAL :: ifillvalue ! Fill value for integer variables
+ INTEGER, OPTIONAL, INTENT(IN) :: ifillvalue ! Fill value for integer variables
REAL(kind=fbsp), OPTIONAL :: rfillvalue ! Fill value for real variables
CHARACTER(len=*), OPTIONAL :: conventions ! Conventions for variable
!! * Local variables
@@ -1611,7 +1611,7 @@ CONTAINS
!! * Arguments
CHARACTER(len=*) :: cdfilename ! Input filename
TYPE(obfbdata) :: fbdata ! obsfbdata structure
- LOGICAL, OPTIONAL :: ldgrid ! Allow forcing of grid info
+ LOGICAL, OPTIONAL, INTENT(IN) :: ldgrid ! Allow forcing of grid info
!! * Local variables
CHARACTER(LEN=14), PARAMETER :: cpname = 'read_obfbdata'
INTEGER :: idfile
diff --git a/src/OCE/OBS/obs_grd_bruteforce.h90 b/src/OCE/OBS/obs_grd_bruteforce.h90
index 5a41fa312c864dc2245e8f3a519f6a6de84fa55e..7340e336164d62bd1065633e9a44ff4236bb22cb 100644
--- a/src/OCE/OBS/obs_grd_bruteforce.h90
+++ b/src/OCE/OBS/obs_grd_bruteforce.h90
@@ -1,4 +1,4 @@
- SUBROUTINE obs_grd_bruteforce( kpi, kpj, kpiglo, kpjglo, &
+SUBROUTINE obs_grd_bruteforce( kpi, kpj, kpiglo, kpjglo, &
& kldi, klei, kldj, klej, &
& kmyproc, ktotproc, &
& pglam, pgphi, pmask, &
diff --git a/src/OCE/OBS/obs_grid.F90 b/src/OCE/OBS/obs_grid.F90
index 7157416234e257342c5fd610b1c5a0023fc4a57b..428ab5e3ab6b6a62861a3d181c1aed31167b7574 100644
--- a/src/OCE/OBS/obs_grid.F90
+++ b/src/OCE/OBS/obs_grid.F90
@@ -51,7 +51,7 @@ MODULE obs_grid
!!* Module variables
!! Default values
- REAL, PUBLIC :: rn_gridsearchres = 0.5 ! Resolution of grid
+ REAL(wp), PUBLIC :: rn_gridsearchres = 0.5 ! Resolution of grid
INTEGER, PRIVATE :: gsearch_nlons_def ! Num of longitudes
INTEGER, PRIVATE :: gsearch_nlats_def ! Num of latitudes
REAL(wp), PRIVATE :: gsearch_lonmin_def ! Min longitude
@@ -680,7 +680,7 @@ CONTAINS
INTEGER, PARAMETER :: histsize=90
INTEGER, DIMENSION(histsize) :: &
& histx1, histx2, histy1, histy2
- REAL, DIMENSION(histsize) :: &
+ REAL(wp), DIMENSION(histsize) :: &
& fhistx1, fhistx2, fhisty1, fhisty2
REAL(wp) :: histtol
CHARACTER(LEN=26) :: clfmt ! writing format
@@ -1182,4 +1182,3 @@ CONTAINS
#include "find_obs_proc.h90"
END MODULE obs_grid
-
diff --git a/src/OCE/OBS/obs_inter_sup.F90 b/src/OCE/OBS/obs_inter_sup.F90
index d8116276d3a5bcbf7cb2b5ebb187e1b2a427a575..4f96b738c43b8caf404d3ac7be3d045e6cadabae 100644
--- a/src/OCE/OBS/obs_inter_sup.F90
+++ b/src/OCE/OBS/obs_inter_sup.F90
@@ -383,4 +383,3 @@ CONTAINS
END SUBROUTINE obs_int_comm_3d_local
END MODULE obs_inter_sup
-
diff --git a/src/OCE/OBS/obs_inter_z1d.F90 b/src/OCE/OBS/obs_inter_z1d.F90
index 9aa7dba5617dcd867f28773d125390263443bacc..a25b5814c9efdcbd08c05bc2b67e2d9f0cd20c17 100644
--- a/src/OCE/OBS/obs_inter_z1d.F90
+++ b/src/OCE/OBS/obs_inter_z1d.F90
@@ -11,8 +11,7 @@ MODULE obs_inter_z1d
!! interpolating function for a cubic spline (n1dint=1)
!!----------------------------------------------------------------------
!! * Modules used
- USE par_kind, ONLY : & ! Precision variables
- & wp
+ USE par_kind
IMPLICIT NONE
@@ -34,4 +33,3 @@ CONTAINS
#include "obsinter_z1d.h90"
END MODULE obs_inter_z1d
-
diff --git a/src/OCE/OBS/obs_level_search.h90 b/src/OCE/OBS/obs_level_search.h90
index 8eb3a6b0d6bca24e7f806d9cb760770f3730c624..bd1b7aa713893f2ed2f22da923707b15f50bd9c9 100644
--- a/src/OCE/OBS/obs_level_search.h90
+++ b/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)
diff --git a/src/OCE/OBS/obs_mpp.F90 b/src/OCE/OBS/obs_mpp.F90
index 907421cb9c27c6bb133be92112fe9f477435f74c..7daaaf7688b5fefc4db4a03d89930ef7f69b227f 100644
--- a/src/OCE/OBS/obs_mpp.F90
+++ b/src/OCE/OBS/obs_mpp.F90
@@ -351,7 +351,7 @@ INCLUDE 'mpif.h'
!!----------------------------------------------------------------------
INTEGER , INTENT(in) :: knoin
INTEGER , INTENT(in) :: knoout
- INTEGER, DIMENSION(jpnij) :: kinv, koutv
+ INTEGER, DIMENSION(jpnij), INTENT(IN) :: kinv, koutv
INTEGER, DIMENSION(knoin) , INTENT(in ) :: kvalsin
INTEGER, DIMENSION(knoout), INTENT( out) :: kvalsout
!!
diff --git a/src/OCE/OBS/obs_prep.F90 b/src/OCE/OBS/obs_prep.F90
index aa330063b974da9bdc38ee640a13c0d6e698a193..b1f2a26100c2c8e391385cb8a655faeac661cfe8 100644
--- a/src/OCE/OBS/obs_prep.F90
+++ b/src/OCE/OBS/obs_prep.F90
@@ -734,7 +734,7 @@ CONTAINS
imonth_len(:) = nleapy ! all months with nleapy days per year
ENDIF
- END SUBROUTINE
+ END SUBROUTINE calc_month_len
SUBROUTINE obs_coo_tim_prof( kcycle, &
& kyea0, kmon0, kday0, khou0, kmin0, &
diff --git a/src/OCE/OBS/obs_profiles_def.F90 b/src/OCE/OBS/obs_profiles_def.F90
index 9f6352ac92219a434a3656f4beed573b292e5906..805b89f9c22524436658d9771aae3d3cf94161af 100644
--- a/src/OCE/OBS/obs_profiles_def.F90
+++ b/src/OCE/OBS/obs_profiles_def.F90
@@ -563,7 +563,7 @@ CONTAINS
!! * Arguments
TYPE(obs_prof), INTENT(IN) :: prof ! Original profile
TYPE(obs_prof), INTENT(INOUT) :: newprof ! New profile with the copy of the data
- LOGICAL :: lallocate ! Allocate newprof data
+ LOGICAL, INTENT(IN) :: lallocate ! Allocate newprof data
INTEGER,INTENT(IN) :: kumout ! Fortran unit for messages
TYPE(obs_prof_valid), OPTIONAL, INTENT(in) :: &
& lvalid ! Valid profiles
@@ -804,7 +804,7 @@ CONTAINS
!! * Arguments
TYPE(obs_prof),INTENT(INOUT) :: prof ! Updated profile data
TYPE(obs_prof),INTENT(INOUT) :: oldprof ! Original profile data
- LOGICAL :: ldeallocate ! Deallocate the updated data of insertion
+ LOGICAL, INTENT(IN) :: ldeallocate ! Deallocate the updated data of insertion
INTEGER,INTENT(in) :: kumout ! Output unit
!!* Local variables
@@ -925,4 +925,3 @@ CONTAINS
END SUBROUTINE obs_prof_staend
END MODULE obs_profiles_def
-
diff --git a/src/OCE/OBS/obs_read_prof.F90 b/src/OCE/OBS/obs_read_prof.F90
index de1287bde3c2ee1e4096e0a8beacc14baba8c04a..afa62732295a4e8c5e8f8efb7c8bea506b0a42ca 100644
--- a/src/OCE/OBS/obs_read_prof.F90
+++ b/src/OCE/OBS/obs_read_prof.F90
@@ -77,8 +77,8 @@ CONTAINS
LOGICAL, INTENT(IN) :: ldignmis ! Ignore missing files
LOGICAL, INTENT(IN) :: ldsatt ! Compute salinity at all temperature points
LOGICAL, INTENT(IN) :: ldmod ! Initialize model from input data
- REAL(dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS
- REAL(dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS
+ REAL(wp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS
+ REAL(wp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS
CHARACTER(len=8), DIMENSION(kvars), INTENT(IN) :: cdvars
INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
& kdailyavtypes ! Types of daily average observations
diff --git a/src/OCE/OBS/obs_read_surf.F90 b/src/OCE/OBS/obs_read_surf.F90
index 8c7e044672a1e98e6ff4203da4b0b079d25d57f0..6e3da280f08d7f0a9778e2cdfcec30bb78a64620 100644
--- a/src/OCE/OBS/obs_read_surf.F90
+++ b/src/OCE/OBS/obs_read_surf.F90
@@ -70,8 +70,8 @@ CONTAINS
LOGICAL, INTENT(IN) :: ldignmis ! Ignore missing files
LOGICAL, INTENT(IN) :: ldmod ! Initialize model from input data
LOGICAL, INTENT(IN) :: ldnightav ! Observations represent a night-time average
- REAL(dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS
- REAL(dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS
+ REAL(wp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS
+ REAL(wp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS
CHARACTER(len=8), DIMENSION(kvars), INTENT(IN) :: cdvars
!! * Local declarations
diff --git a/src/OCE/OBS/obs_rot_vel.F90 b/src/OCE/OBS/obs_rot_vel.F90
index 4330018f1ef6077fa89650de61e2174437c89172..46490d6ea56aab624a140ceea655aca81dac4572 100644
--- a/src/OCE/OBS/obs_rot_vel.F90
+++ b/src/OCE/OBS/obs_rot_vel.F90
@@ -57,7 +57,7 @@ CONTAINS
!! * Arguments
TYPE(obs_prof), INTENT(INOUT) :: profdata ! Profile data to be read
INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation methed
- REAL(wp), DIMENSION(*) :: &
+ REAL(wp), DIMENSION(:) :: &
& pu, &
& pv
!! * Local declarations
diff --git a/src/OCE/OBS/obs_sort.F90 b/src/OCE/OBS/obs_sort.F90
index f5b14f059702c1ea7d14aaf9e2384a9b7d823a28..978274bc8b1c0bcb114b0ec93a7550ff2dfd5273 100644
--- a/src/OCE/OBS/obs_sort.F90
+++ b/src/OCE/OBS/obs_sort.F90
@@ -144,4 +144,3 @@ CONTAINS
END SUBROUTINE index_sort
END MODULE obs_sort
-
diff --git a/src/OCE/OBS/obs_surf_def.F90 b/src/OCE/OBS/obs_surf_def.F90
index 54cb6a737a0b01b735005079683a2e93439428d4..4494c97877c5946d6585f90469a4412a4bf5ac96 100644
--- a/src/OCE/OBS/obs_surf_def.F90
+++ b/src/OCE/OBS/obs_surf_def.F90
@@ -333,7 +333,7 @@ CONTAINS
!! * Arguments
TYPE(obs_surf), INTENT(IN) :: surf ! Original surface data
TYPE(obs_surf), INTENT(INOUT) :: newsurf ! New surface data with a subset of the original data
- LOGICAL :: lallocate ! Allocate newsurf data
+ LOGICAL, INTENT(IN) :: lallocate ! Allocate newsurf data
INTEGER,INTENT(IN) :: kumout ! Fortran unit for messages
LOGICAL, OPTIONAL, INTENT(in), DIMENSION(:) :: &
& lvalid ! Valid of surface observations
@@ -462,7 +462,7 @@ CONTAINS
!! * Arguments
TYPE(obs_surf),INTENT(INOUT) :: surf ! Updated surface data
TYPE(obs_surf),INTENT(INOUT) :: oldsurf ! Original surface data
- LOGICAL :: ldeallocate ! Deallocate the updated data of insertion
+ LOGICAL, INTENT(IN) :: ldeallocate ! Deallocate the updated data of insertion
INTEGER,INTENT(in) :: kumout ! Output unit
!!* Local variables
@@ -527,4 +527,3 @@ CONTAINS
END SUBROUTINE obs_surf_decompress
END MODULE obs_surf_def
-
diff --git a/src/OCE/OBS/obs_utils.F90 b/src/OCE/OBS/obs_utils.F90
index 8e1fd17e7519a58f065d275ef44edcdac724a59b..6298ec97ea10bbd787a725ff10bdbbc5320860ad 100644
--- a/src/OCE/OBS/obs_utils.F90
+++ b/src/OCE/OBS/obs_utils.F90
@@ -67,9 +67,9 @@ CONTAINS
USE netcdf ! NetCDF library
!! * Arguments
- INTEGER :: kstatus
- INTEGER :: klineno
- CHARACTER(LEN=*) :: cd_name
+ INTEGER, INTENT(IN) :: kstatus
+ INTEGER, INTENT(IN) :: klineno
+ CHARACTER(LEN=*), INTENT(IN) :: cd_name
!! * Local declarations
CHARACTER(len=200) :: clineno
@@ -166,7 +166,7 @@ CONTAINS
!! * Modules used
!! * Arguments
- INTEGER :: klineno
+ INTEGER, INTENT(IN) :: klineno
CHARACTER(LEN=*) :: cd_name
!! * Local declarations
CHARACTER(len=200) :: clineno
@@ -193,7 +193,7 @@ CONTAINS
!! * Modules used
!! * Arguments
- INTEGER :: klineno
+ INTEGER, INTENT(IN) :: klineno
CHARACTER(LEN=*) :: cd_name
!! * Local declarations
CHARACTER(len=200) :: clineno
diff --git a/src/OCE/OBS/obsinter_h2d.h90 b/src/OCE/OBS/obsinter_h2d.h90
index 1328477b06aca36def378255cb3cbefa703f9d84..409d85fa483811a9b5cdcbbaeda85d34f0804f59 100644
--- a/src/OCE/OBS/obsinter_h2d.h90
+++ b/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/src/OCE/OBS/obsinter_z1d.h90 b/src/OCE/OBS/obsinter_z1d.h90
index 6cba566572fc57828c3b5bbb61398c4c620d5a6d..b1812b46dba2fe46c3741ba4855a3480c869b507 100644
--- a/src/OCE/OBS/obsinter_z1d.h90
+++ b/src/OCE/OBS/obsinter_z1d.h90
@@ -1,4 +1,4 @@
- !!----------------------------------------------------------------------
+!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: obsinter_z1d.h90 13226 2020-07-02 14:24:31Z orioltp $
!! Software governed by the CeCILL license (see ./LICENSE)
@@ -191,5 +191,3 @@
END DO
END SUBROUTINE obs_int_z1d_spl
-
-
diff --git a/src/OCE/OBS/str_c_to_for.h90 b/src/OCE/OBS/str_c_to_for.h90
index 6c575f95c7131515bc610a55a4c88863f645fa5d..64ac14f49488a216f5542c3738b24d4dcbdc868f 100644
--- a/src/OCE/OBS/str_c_to_for.h90
+++ b/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)
diff --git a/src/OCE/SBC/fldread.F90 b/src/OCE/SBC/fldread.F90
index f7a6d90fa6949a2144e762b1a8634f939fcaf8a3..1385e42007af8e70421135d692c4e5a419f72526 100644
--- a/src/OCE/SBC/fldread.F90
+++ b/src/OCE/SBC/fldread.F90
@@ -129,6 +129,7 @@ MODULE fldread
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -1100,7 +1101,7 @@ CONTAINS
CHARACTER (len=5) :: clname !
INTEGER , DIMENSION(4) :: ddims
INTEGER :: isrc
- REAL(wp), DIMENSION(jpi,jpj) :: data_tmp
+ REAL(dp), DIMENSION(jpi,jpj) :: data_tmp
!!----------------------------------------------------------------------
!
IF( nxt_wgt > tot_wgts ) THEN
diff --git a/src/OCE/SBC/sbc_oce.F90 b/src/OCE/SBC/sbc_oce.F90
index 3098b5865b6719eb5250180257f7d9e1ab143c75..17aefe7e1e0717af98655a98952d80b683ef3d61 100644
--- a/src/OCE/SBC/sbc_oce.F90
+++ b/src/OCE/SBC/sbc_oce.F90
@@ -126,7 +126,7 @@ MODULE sbc_oce
!!
!!
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tprecip !: total precipitation [Kg/m2/s]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sprecip !: solid precipitation [Kg/m2/s]
+ REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sprecip !: solid precipitation [Kg/m2/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_i !: ice fraction = 1 - lead fraction (between 0 to 1)
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask for ln_mixcpl (warning: allocated in sbccpl)
diff --git a/src/OCE/SBC/sbc_phy.F90 b/src/OCE/SBC/sbc_phy.F90
index cabec70fcfda4a096d045c62979b86cb029f02a8..6fec2ddf342be29bb7e21145a6d87862cc0d97a9 100644
--- a/src/OCE/SBC/sbc_phy.F90
+++ b/src/OCE/SBC/sbc_phy.F90
@@ -864,7 +864,7 @@ CONTAINS
zCh = zz0*ptst(ji,jj)/zdt
zCe = zz0*pqst(ji,jj)/zdq
- CALL BULK_FORMULA( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), zCd, zCh, zCe, &
+ CALL bulk_formula( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), zCd, zCh, zCe, &
& pwnd(ji,jj), pUb(ji,jj), ppa(ji,jj), prhoa(ji,jj), &
& pTau(ji,jj), zQsen, zQlat )
@@ -879,7 +879,7 @@ CONTAINS
END SUBROUTINE UPDATE_QNSOL_TAU
- SUBROUTINE BULK_FORMULA_SCLR( pzu, pTs, pqs, pTa, pqa, &
+ SUBROUTINE bulk_formula_sclr( pzu, pTs, pqs, pTa, pqa, &
& pCd, pCh, pCe, &
& pwnd, pUb, ppa, prhoa, &
& pTau, pQsen, pQlat, &
@@ -921,9 +921,9 @@ CONTAINS
IF( PRESENT(pEvap) ) pEvap = - zfact_evap * zevap
- END SUBROUTINE BULK_FORMULA_SCLR
+ END SUBROUTINE bulk_formula_sclr
- SUBROUTINE BULK_FORMULA_VCTR( pzu, pTs, pqs, pTa, pqa, &
+ SUBROUTINE bulk_formula_vctr( pzu, pTs, pqs, pTa, pqa, &
& pCd, pCh, pCe, &
& pwnd, pUb, ppa, prhoa, &
& pTau, pQsen, pQlat, &
@@ -957,7 +957,7 @@ CONTAINS
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), &
+ CALL bulk_formula_sclr( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), &
& pCd(ji,jj), pCh(ji,jj), pCe(ji,jj), &
& pwnd(ji,jj), pUb(ji,jj), ppa(ji,jj), prhoa(ji,jj), &
& pTau(ji,jj), pQsen(ji,jj), pQlat(ji,jj), &
@@ -966,7 +966,7 @@ CONTAINS
IF( PRESENT(pEvap) ) pEvap(ji,jj) = zevap
END_2D
- END SUBROUTINE BULK_FORMULA_VCTR
+ END SUBROUTINE bulk_formula_vctr
FUNCTION alpha_sw_vctr( psst )
diff --git a/src/OCE/SBC/sbcblk.F90 b/src/OCE/SBC/sbcblk.F90
index aa3668c3300bb8d3a46998a76f2f56014332d540..035a25146745544a7d6f187bbb649bfb5ce7176e 100644
--- a/src/OCE/SBC/sbcblk.F90
+++ b/src/OCE/SBC/sbcblk.F90
@@ -117,7 +117,7 @@ MODULE sbcblk
REAL(wp) :: rn_stau_a ! Alpha and Beta coefficients of Renault et al. 2020, eq. 10: Stau = Alpha * Wnd + Beta
REAL(wp) :: rn_stau_b !
!
- REAL(wp) :: rn_pfac ! multiplication factor for precipitation
+ REAL(dp) :: rn_pfac ! multiplication factor for precipitation
REAL(wp), PUBLIC :: rn_efac ! multiplication factor for evaporation
REAL(wp) :: rn_zqt ! z(q,t) : height of humidity and temperature measurements
REAL(wp) :: rn_zu ! z(u) : height of wind measurements
@@ -169,6 +169,7 @@ MODULE sbcblk
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: sbcblk.F90 15551 2021-11-28 20:19:36Z gsamson $
@@ -575,7 +576,7 @@ CONTAINS
CALL blk_oce_2( theta_air_zt(:,:), & ! <<= in
& sf(jp_qlw )%fnow(:,:,1), sf(jp_prec )%fnow(:,:,1), & ! <<= in
- & sf(jp_snow )%fnow(:,:,1), tsk_m, & ! <<= in
+ & CASTDP(sf(jp_snow )%fnow(:,:,1)), tsk_m, & ! <<= in
& zsen, zlat, zevp ) ! <=> in out
ENDIF
!
@@ -808,7 +809,7 @@ CONTAINS
rhoa(ji,jj) = rho_air( ztabs(ji,jj), q_zu(ji,jj), zpre(ji,jj) )
END_2D
- CALL BULK_FORMULA( rn_zu, zsspt(:,:), pssq(:,:), theta_zu(:,:), q_zu(:,:), &
+ CALL bulk_formula( rn_zu, zsspt(:,:), pssq(:,:), theta_zu(:,:), q_zu(:,:), &
& zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:), &
& wndm(:,:), zU_zu(:,:), pslp(:,:), rhoa(:,:), &
& taum(:,:), psen(:,:), plat(:,:), &
@@ -868,11 +869,11 @@ CONTAINS
CALL iom_put( "vtau_oce", ztau_j(:,:)*tmask(:,:,1) ) ! vtau at T-points!
IF(sn_cfctl%l_prtctl) THEN
- CALL prt_ctl( tab2d_1=pssq , clinfo1=' blk_oce_1: pssq : ', mask1=tmask )
- CALL prt_ctl( tab2d_1=wndm , clinfo1=' blk_oce_1: wndm : ', mask1=tmask )
- CALL prt_ctl( tab2d_1=utau , clinfo1=' blk_oce_1: utau : ', mask1=umask, &
- & tab2d_2=vtau , clinfo2=' vtau : ', mask2=vmask )
- CALL prt_ctl( tab2d_1=zcd_oce, clinfo1=' blk_oce_1: Cd : ', mask1=tmask )
+ CALL prt_ctl( tab2d_1=CASTDP(pssq), clinfo1=' blk_oce_1: pssq : ', mask1=tmask )
+ CALL prt_ctl( tab2d_1=CASTDP(wndm), clinfo1=' blk_oce_1: wndm : ', mask1=tmask )
+ CALL prt_ctl( tab2d_1=CASTDP(utau), clinfo1=' blk_oce_1: utau : ', mask1=umask, &
+ & tab2d_2=CASTDP(vtau), clinfo2=' vtau : ', mask2=vmask )
+ CALL prt_ctl( tab2d_1=CASTDP(zcd_oce), clinfo1=' blk_oce_1: Cd : ', mask1=tmask )
ENDIF
!
ENDIF ! ln_blk / ln_abl
@@ -907,7 +908,7 @@ CONTAINS
REAL(wp), INTENT(in), DIMENSION(:,:) :: ptair ! potential temperature of air #LB: confirm!
REAL(wp), INTENT(in), DIMENSION(:,:) :: pdqlw ! downwelling longwave radiation at surface [W/m^2]
REAL(wp), INTENT(in), DIMENSION(:,:) :: pprec
- REAL(wp), INTENT(in), DIMENSION(:,:) :: psnow
+ REAL(dp), INTENT(in), DIMENSION(:,:) :: psnow
REAL(wp), INTENT(in), DIMENSION(:,:) :: ptsk ! SKIN surface temperature [Celsius]
REAL(wp), INTENT(in), DIMENSION(:,:) :: psen
REAL(wp), INTENT(in), DIMENSION(:,:) :: plat
@@ -969,11 +970,11 @@ CONTAINS
ENDIF
!
IF(sn_cfctl%l_prtctl) THEN
- CALL prt_ctl(tab2d_1=zqlw , clinfo1=' blk_oce_2: zqlw : ', mask1=tmask )
- CALL prt_ctl(tab2d_1=psen , clinfo1=' blk_oce_2: psen : ', mask1=tmask )
- CALL prt_ctl(tab2d_1=plat , clinfo1=' blk_oce_2: plat : ', mask1=tmask )
- CALL prt_ctl(tab2d_1=qns , clinfo1=' blk_oce_2: qns : ', mask1=tmask )
- CALL prt_ctl(tab2d_1=emp , clinfo1=' blk_oce_2: emp : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=CASTDP(zqlw), clinfo1=' blk_oce_2: zqlw : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=CASTDP(psen), clinfo1=' blk_oce_2: psen : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=CASTDP(plat), clinfo1=' blk_oce_2: plat : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=CASTDP(qns), clinfo1=' blk_oce_2: qns : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=CASTDP(emp), clinfo1=' blk_oce_2: emp : ', mask1=tmask )
ENDIF
!
END SUBROUTINE blk_oce_2
@@ -1096,8 +1097,8 @@ CONTAINS
END_2D
CALL lbc_lnk( 'sbcblk', putaui, 'U', -1._wp, pvtaui, 'V', -1._wp )
!
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=putaui , clinfo1=' blk_ice: putaui : ', mask1=umask &
- & , tab2d_2=pvtaui , clinfo2=' pvtaui : ', mask2=vmask )
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=CASTDP(putaui), clinfo1=' blk_ice: putaui : ', mask1=umask &
+ & , tab2d_2=CASTDP(pvtaui), clinfo2=' pvtaui : ', mask2=vmask )
ELSE ! ln_abl
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
@@ -1109,7 +1110,7 @@ CONTAINS
ENDIF ! ln_blk / ln_abl
!
- IF(sn_cfctl%l_prtctl) CALL prt_ctl(tab2d_1=wndm_ice , clinfo1=' blk_ice: wndm_ice : ', mask1=tmask )
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl(tab2d_1=CASTDP(wndm_ice), clinfo1=' blk_ice: wndm_ice : ', mask1=tmask )
!
END SUBROUTINE blk_ice_1
@@ -1310,18 +1311,18 @@ CONTAINS
DO jl = 1, jpl
zmsk(:,:,jl) = tmask(:,:,1)
END DO
- CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice: qla_ice : ', mask1=zmsk, &
- & tab3d_2=z_qsb , clinfo2=' z_qsb : ' , mask2=zmsk, kdim=jpl)
- CALL prt_ctl(tab3d_1=z_qlw , clinfo1=' blk_ice: z_qlw : ', mask1=zmsk, &
- & tab3d_2=dqla_ice, clinfo2=' dqla_ice : ' , mask2=zmsk, kdim=jpl)
- CALL prt_ctl(tab3d_1=z_dqsb , clinfo1=' blk_ice: z_dqsb : ', mask1=zmsk, &
- & tab3d_2=z_dqlw , clinfo2=' z_dqlw : ' , mask2=zmsk, kdim=jpl)
- CALL prt_ctl(tab3d_1=dqns_ice, clinfo1=' blk_ice: dqns_ice : ', mask1=zmsk, &
- & tab3d_2=qsr_ice , clinfo2=' qsr_ice : ' , mask2=zmsk, kdim=jpl)
- CALL prt_ctl(tab3d_1=ptsu , clinfo1=' blk_ice: ptsu : ', mask1=zmsk, &
- & tab3d_2=qns_ice , clinfo2=' qns_ice : ' , mask2=zmsk, kdim=jpl)
- CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice: tprecip : ', mask1=tmask, &
- & tab2d_2=sprecip , clinfo2=' sprecip : ' , mask2=tmask )
+ CALL prt_ctl(tab3d_1=CASTDP(qla_ice) , clinfo1=' blk_ice: qla_ice : ', mask1=zmsk, &
+ & tab3d_2=CASTDP(z_qsb) , clinfo2=' z_qsb : ' , mask2=zmsk, kdim=jpl)
+ CALL prt_ctl(tab3d_1=CASTDP(z_qlw) , clinfo1=' blk_ice: z_qlw : ', mask1=zmsk, &
+ & tab3d_2=CASTDP(dqla_ice), clinfo2=' dqla_ice : ' , mask2=zmsk, kdim=jpl)
+ CALL prt_ctl(tab3d_1=CASTDP(z_dqsb) , clinfo1=' blk_ice: z_dqsb : ', mask1=zmsk, &
+ & tab3d_2=CASTDP(z_dqlw) , clinfo2=' z_dqlw : ' , mask2=zmsk, kdim=jpl)
+ CALL prt_ctl(tab3d_1=CASTDP(dqns_ice), clinfo1=' blk_ice: dqns_ice : ', mask1=zmsk, &
+ & tab3d_2=CASTDP(qsr_ice) , clinfo2=' qsr_ice : ' , mask2=zmsk, kdim=jpl)
+ CALL prt_ctl(tab3d_1=CASTDP(ptsu) , clinfo1=' blk_ice: ptsu : ', mask1=zmsk, &
+ & tab3d_2=CASTDP(qns_ice) , clinfo2=' qns_ice : ' , mask2=zmsk, kdim=jpl)
+ CALL prt_ctl(tab2d_1=CASTDP(tprecip) , clinfo1=' blk_ice: tprecip : ', mask1=tmask, &
+ & tab2d_2=CASTDP(sprecip) , clinfo2=' sprecip : ' , mask2=tmask )
DEALLOCATE(zmsk)
ENDIF
diff --git a/src/OCE/SBC/sbcblk_algo_coare3p0.F90 b/src/OCE/SBC/sbcblk_algo_coare3p0.F90
index 2ad244fcb4d788a921e25c502cfd966d479db70f..5c9e6d02f4ad4b52b552fd29efa88b0c38146067 100644
--- a/src/OCE/SBC/sbcblk_algo_coare3p0.F90
+++ b/src/OCE/SBC/sbcblk_algo_coare3p0.F90
@@ -169,9 +169,9 @@ CONTAINS
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ubzu ! bulk wind speed at zu [m/s]
!
INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CdN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: ChN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CeN
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: Cdn
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: Chn
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: Cen
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: Qsw ! [W/m^2]
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: rad_lw ! [W/m^2]
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: slp ! [Pa]
diff --git a/src/OCE/SBC/sbcblk_algo_coare3p6.F90 b/src/OCE/SBC/sbcblk_algo_coare3p6.F90
index cb7fff12b99999e0c740d5d8a23393f8dcfec3e7..58a0624d98ff1db00de058ec675fbd841f19b273 100644
--- a/src/OCE/SBC/sbcblk_algo_coare3p6.F90
+++ b/src/OCE/SBC/sbcblk_algo_coare3p6.F90
@@ -159,9 +159,9 @@ CONTAINS
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ubzu ! bulk wind speed at zu [m/s]
!
INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CdN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: ChN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CeN
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: Cdn
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: Chn
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: Cen
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: Qsw ! [W/m^2]
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: rad_lw ! [W/m^2]
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: slp ! [Pa]
diff --git a/src/OCE/SBC/sbcblk_algo_ecmwf.F90 b/src/OCE/SBC/sbcblk_algo_ecmwf.F90
index e4075308d8b329c03c61e516479c6323938221b5..74ccc356ae787a586ab7288ee385b7c2ee213327 100644
--- a/src/OCE/SBC/sbcblk_algo_ecmwf.F90
+++ b/src/OCE/SBC/sbcblk_algo_ecmwf.F90
@@ -165,9 +165,9 @@ CONTAINS
REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Ubzu ! bulk wind speed at zu [m/s]
!
INTEGER , INTENT(in ), OPTIONAL :: nb_iter ! number of iterations
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CdN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: ChN
- REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: CeN
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: Cdn
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: Chn
+ REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: Cen
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: Qsw ! [W/m^2]
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: rad_lw ! [W/m^2]
REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: slp ! [Pa]
diff --git a/src/OCE/SBC/sbcclo.F90 b/src/OCE/SBC/sbcclo.F90
index ba956f5e32dfa77dfea9106ee2855e2b2659d716..7238507f5e4c17f17ace2e40b09198098f386b19 100644
--- a/src/OCE/SBC/sbcclo.F90
+++ b/src/OCE/SBC/sbcclo.F90
@@ -159,7 +159,7 @@ MODULE sbcclo
!
END DO ! jcs
- END SUBROUTINE
+ END SUBROUTINE get_cssrcsurf
SUBROUTINE get_cstrgsurf(kncs, kmaskcs, kmaskcsgrp, psurftrg, kcsgrp )
!!-----------------------------------------------------------------------
@@ -211,7 +211,7 @@ MODULE sbcclo
!
END DO ! jcs
- END SUBROUTINE
+ END SUBROUTINE get_cstrgsurf
SUBROUTINE prt_csctl(kncs, psurfsrc, psurftrg, kcsgrp, cdcstype)
!!-----------------------------------------------------------------------
@@ -245,7 +245,7 @@ MODULE sbcclo
WRITE(numout,*)''
END IF
- END SUBROUTINE
+ END SUBROUTINE prt_csctl
SUBROUTINE sbc_csupdate(kncs, kcsgrp, kmsk_src, kmsk_grp, psurfsrc, psurftrg, cdcstype, kmsk_opnsea, psurf_opnsea, pwcs, pqcs)
!!-----------------------------------------------------------------------
@@ -319,7 +319,7 @@ MODULE sbcclo
!
END DO ! jcs
- END SUBROUTINE
+ END SUBROUTINE sbc_csupdate
SUBROUTINE alloc_csarr( klen, pvarsrc, pvartrg, kvargrp )
!!-----------------------------------------------------------------------
@@ -347,6 +347,6 @@ MODULE sbcclo
pvarsrc(:) = 0.e0_wp
pvartrg(:) = 0.e0_wp
kvargrp(:) = 0
- END SUBROUTINE
+ END SUBROUTINE alloc_csarr
END MODULE
diff --git a/src/OCE/SBC/sbccpl.F90 b/src/OCE/SBC/sbccpl.F90
index 79602758f20f23e2ab645ed1e224474d44d0c1aa..fb6f2a2baecd05c04e207912a357031696a3ebcf 100644
--- a/src/OCE/SBC/sbccpl.F90
+++ b/src/OCE/SBC/sbccpl.F90
@@ -223,6 +223,7 @@ MODULE sbccpl
!! Substitution
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -2316,7 +2317,7 @@ CONTAINS
ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part
ELSE
! we must send the surface potential temperature
- IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) )
+ IF( l_useCT ) THEN ; ztmp1(:,:) =eos_pt_from_ct( CASTSP(ts(:,:,1,jp_tem,Kmm)), CASTSP(ts(:,:,1,jp_sal,Kmm)) )
ELSE ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm)
ENDIF
!
@@ -2750,11 +2751,11 @@ CONTAINS
ENDIF
! ! SSS
IF( ssnd(jps_soce )%laction ) THEN
- CALL cpl_snd( jps_soce , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info )
+ CALL cpl_snd( jps_soce , isec, CASTSP(RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) )), info )
ENDIF
! ! first T level thickness
IF( ssnd(jps_e3t1st )%laction ) THEN
- CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm) , (/jpi,jpj,1/) ), info )
+ CALL cpl_snd( jps_e3t1st, isec, CASTSP(RESHAPE ( e3t(:,:,1,Kmm) , (/jpi,jpj,1/) )), info )
ENDIF
! ! Qsr fraction
IF( ssnd(jps_fraqsr)%laction ) THEN
diff --git a/src/OCE/SBC/sbcmod.F90 b/src/OCE/SBC/sbcmod.F90
index 6811e617be39177fd63249666eb699b5ae4f818d..65f4495fab1bb4c8095f2fa6b7e426676c6e6d2e 100644
--- a/src/OCE/SBC/sbcmod.F90
+++ b/src/OCE/SBC/sbcmod.F90
@@ -75,6 +75,7 @@ MODULE sbcmod
INTEGER :: nsbc ! type of surface boundary condition (deduced from namsbc informations)
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: sbcmod.F90 15372 2021-10-14 15:47:24Z davestorkey $
@@ -607,16 +608,16 @@ CONTAINS
ENDIF
!
IF(sn_cfctl%l_prtctl) THEN ! print mean trends (used for debugging)
- CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask )
- CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf - : ', mask1=tmask )
- CALL prt_ctl(tab2d_1=(sfx-rnf) , clinfo1=' sfx-rnf - : ', mask1=tmask )
- CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask )
- CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask )
- CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk )
+ CALL prt_ctl(tab2d_1=CASTDP(fr_i) , clinfo1=' fr_i - : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=CASTDP((emp-rnf)) , clinfo1=' emp-rnf - : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=CASTDP((sfx-rnf)) , clinfo1=' sfx-rnf - : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=CASTDP(qns) , clinfo1=' qns - : ', mask1=tmask )
+ CALL prt_ctl(tab2d_1=CASTDP(qsr) , clinfo1=' qsr - : ', mask1=tmask )
+ CALL prt_ctl(tab3d_1=CASTDP(tmask) , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk )
CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst - : ', mask1=tmask, kdim=1 )
CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss - : ', mask1=tmask, kdim=1 )
- CALL prt_ctl(tab2d_1=utau , clinfo1=' utau - : ', mask1=umask, &
- & tab2d_2=vtau , clinfo2=' vtau - : ', mask2=vmask )
+ CALL prt_ctl(tab2d_1=CASTDP(utau) , clinfo1=' utau - : ', mask1=umask, &
+ & tab2d_2=CASTDP(vtau) , clinfo2=' vtau - : ', mask2=vmask )
ENDIF
IF( kt == nitend ) CALL sbc_final ! Close down surface module if necessary
diff --git a/src/OCE/SBC/sbcssm.F90 b/src/OCE/SBC/sbcssm.F90
index 95e64875363eb85952e4b5b8c5a1dbd72963b9e8..39fc06d26959af3be52b97c36967f987330e737d 100644
--- a/src/OCE/SBC/sbcssm.F90
+++ b/src/OCE/SBC/sbcssm.F90
@@ -31,6 +31,7 @@ MODULE sbcssm
LOGICAL, SAVE :: l_ssm_mean = .FALSE. ! keep track of whether means have been read from restart file
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -241,7 +242,7 @@ CONTAINS
IF(lwp) WRITE(numout,*) ' default initialisation of ss._m arrays'
ssu_m(:,:) = uu(:,:,1,Kbb)
ssv_m(:,:) = vv(:,:,1,Kbb)
- IF( l_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) )
+ IF( l_useCT ) THEN ; sst_m(:,:) =eos_pt_from_ct( CASTSP(ts(:,:,1,jp_tem,Kmm)), CASTSP(ts(:,:,1,jp_sal,Kmm)) )
ELSE ; sst_m(:,:) = ts(:,:,1,jp_tem,Kmm)
ENDIF
sss_m(:,:) = ts (:,:,1,jp_sal,Kmm)
diff --git a/src/OCE/SBC/sbcwave.F90 b/src/OCE/SBC/sbcwave.F90
index 2264938d72a9f274537fd9378d55ba6e458c38c4..a9435f96251a143a86725800e3fa6f72d65c0c9e 100644
--- a/src/OCE/SBC/sbcwave.F90
+++ b/src/OCE/SBC/sbcwave.F90
@@ -71,7 +71,8 @@ MODULE sbcwave
REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tsd2d !: Surface Stokes Drift module at t-point
REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: div_sd !: barotropic stokes drift divergence
REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ut0sd, vt0sd !: surface Stokes drift velocities at t-point
- REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: usd, vsd, wsd !: Stokes drift velocities at u-, v- & w-points, resp.u
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: wsd!: Stokes drift velocities at u-, v- & w-points, resp.u
+ REAL(dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: usd, vsd!: Stokes drift velocities at u-, v- & w-points, resp.u
!
REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: charn !: charnock coefficient at t-point
REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tawx !: Net wave-supported stress, u
@@ -211,7 +212,7 @@ CONTAINS
END_3D
ENDIF
- CALL lbc_lnk( 'sbcwave', usd, 'U', -1.0_wp, vsd, 'V', -1.0_wp )
+ CALL lbc_lnk( 'sbcwave', usd, 'U', -1.0_dp, vsd, 'V', -1.0_dp )
!
! !== vertical Stokes Drift 3D velocity ==!
diff --git a/src/OCE/STO/stopar.F90 b/src/OCE/STO/stopar.F90
index 91cc93bb7947fc67569fd6b092b8a97fd33d1e63..2ba74a5c5661e9de3dc3d09246bc354cda65316a 100644
--- a/src/OCE/STO/stopar.F90
+++ b/src/OCE/STO/stopar.F90
@@ -915,4 +915,3 @@ CONTAINS
END MODULE stopar
-
diff --git a/src/OCE/STO/stopts.F90 b/src/OCE/STO/stopts.F90
index 6573a4fef53baf4cd3f2802b589c75776b2f299b..aeb80e519862432718b901ee54c3bbd01b7aae87 100644
--- a/src/OCE/STO/stopts.F90
+++ b/src/OCE/STO/stopts.F90
@@ -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
diff --git a/src/OCE/TDE/tide.h90 b/src/OCE/TDE/tide.h90
index 80872889cff89884aab6d8a6335eb3be79bfe0bf..6eb43a4d61a1abf58d4d0c2fcb104f897919356d 100644
--- a/src/OCE/TDE/tide.h90
+++ b/src/OCE/TDE/tide.h90
@@ -1,4 +1,4 @@
- !!=====================================================================
+!!=====================================================================
!! *** Include file tide.h90 ***
!!======================================================================
!! History : 3.2 ! 2007 (O. Le Galloudec) Original code
diff --git a/src/OCE/TRA/eosbn2.F90 b/src/OCE/TRA/eosbn2.F90
index 1c461517e7ddc65b16ca2e32bd40f6a18d789361..e13b4c933c489690888c2db1f391b0ab41f5d3f8 100644
--- a/src/OCE/TRA/eosbn2.F90
+++ b/src/OCE/TRA/eosbn2.F90
@@ -178,6 +178,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 +189,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 +232,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 +301,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 +310,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 +334,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 +471,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 +570,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 +652,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 +664,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 +683,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 +770,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 +889,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 +997,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 +1021,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 +1043,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 +1110,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 +1131,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 +1235,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
!
diff --git a/src/OCE/TRA/traadv.F90 b/src/OCE/TRA/traadv.F90
index aa9d4de26a5624edcc030029f14838f984b2312a..2c6dcdd099802f3c639dff4c5d167446a84a70b9 100644
--- a/src/OCE/TRA/traadv.F90
+++ b/src/OCE/TRA/traadv.F90
@@ -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
!
diff --git a/src/OCE/TRA/traadv_cen.F90 b/src/OCE/TRA/traadv_cen.F90
index 8f42bb87a14d2bb9654b8182b85900260358679e..c17aeffccff9f2129873181d8b4826ec22abc86c 100644
--- a/src/OCE/TRA/traadv_cen.F90
+++ b/src/OCE/TRA/traadv_cen.F90
@@ -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
diff --git a/src/OCE/TRA/traadv_cen_lf.F90 b/src/OCE/TRA/traadv_cen_lf.F90
index 6d1f08fb9aaafc6fbc9f7f6c7077d1328c9b958f..17d86953031b819706834d4a851d01ea0e2f7664 100644
--- a/src/OCE/TRA/traadv_cen_lf.F90
+++ b/src/OCE/TRA/traadv_cen_lf.F90
@@ -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(:,:,:) )
diff --git a/src/OCE/TRA/traadv_fct.F90 b/src/OCE/TRA/traadv_fct.F90
index bfc80b893c91c2349d8ae39911195b062df5c6cb..44daa0aae0aa5e98b84dd0416c3b9d7a27f9c57f 100644
--- a/src/OCE/TRA/traadv_fct.F90
+++ b/src/OCE/TRA/traadv_fct.F90
@@ -80,13 +80,14 @@ 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(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
@@ -274,7 +275,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 +299,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
@@ -399,9 +401,10 @@ 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
@@ -551,7 +554,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
@@ -641,7 +644,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
diff --git a/src/OCE/TRA/traadv_mus.F90 b/src/OCE/TRA/traadv_mus.F90
index 42db0c909605ab3e3ec5301eda94fdd2bdf606fb..13b1c2d21ec87722f99c559543d3cebe35d56c00 100644
--- a/src/OCE/TRA/traadv_mus.F90
+++ b/src/OCE/TRA/traadv_mus.F90
@@ -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
diff --git a/src/OCE/TRA/traadv_qck.F90 b/src/OCE/TRA/traadv_qck.F90
index cdb96902b43fea6bb976a8b0f55b4b4cad5bb74a..7282d60159992463ffa352e933120ff659d9f3fc 100644
--- a/src/OCE/TRA/traadv_qck.F90
+++ b/src/OCE/TRA/traadv_qck.F90
@@ -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
diff --git a/src/OCE/TRA/traadv_qck_lf.F90 b/src/OCE/TRA/traadv_qck_lf.F90
index e866bd80944f4aef98bc4cafd829acda452d085e..ad15ccc31556f3270e7b4618aeb08e63db660123 100644
--- a/src/OCE/TRA/traadv_qck_lf.F90
+++ b/src/OCE/TRA/traadv_qck_lf.F90
@@ -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
!
diff --git a/src/OCE/TRA/traadv_ubs.F90 b/src/OCE/TRA/traadv_ubs.F90
index 6a254d775c23c7277794f72b0553d4bbf93c1f4f..b834ca4890f64573c61a27a01cc0ddf3823c9bd9 100644
--- a/src/OCE/TRA/traadv_ubs.F90
+++ b/src/OCE/TRA/traadv_ubs.F90
@@ -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
!
diff --git a/src/OCE/TRA/traadv_ubs_lf.F90 b/src/OCE/TRA/traadv_ubs_lf.F90
index 034512641488d99d8ebf4e78638b1ca792941a84..a7908e1ae76b1b381b78329b7bdc7ac7a3a0d323 100644
--- a/src/OCE/TRA/traadv_ubs_lf.F90
+++ b/src/OCE/TRA/traadv_ubs_lf.F90
@@ -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
diff --git a/src/OCE/TRA/traatf.F90 b/src/OCE/TRA/traatf.F90
index 12b280fc30b53bdbc1894691411ee1600aeb2359..a0e04e5af85f6177d69c798b108121cf80e319f5 100644
--- a/src/OCE/TRA/traatf.F90
+++ b/src/OCE/TRA/traatf.F90
@@ -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
!
diff --git a/src/OCE/TRA/traatf_qco.F90 b/src/OCE/TRA/traatf_qco.F90
index 2b6333683a4ccaf96d8c006f72317ea5b8257eef..0235627957e2e3870cb67f001f2bc4812bfa2245 100644
--- a/src/OCE/TRA/traatf_qco.F90
+++ b/src/OCE/TRA/traatf_qco.F90
@@ -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
!!----------------------------------------------------------------------
!
diff --git a/src/OCE/TRA/trabbc.F90 b/src/OCE/TRA/trabbc.F90
index 7e2372b1e674841d138078d45953027843bc3c8d..12d2091a4f754aa8c99ca02579bc4e3482d34c66 100644
--- a/src/OCE/TRA/trabbc.F90
+++ b/src/OCE/TRA/trabbc.F90
@@ -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
diff --git a/src/OCE/TRA/trabbl.F90 b/src/OCE/TRA/trabbl.F90
index 71ccf284170581efed99358325d0bde8b8b35987..f8afe449b0148200e8e5cc4a6bdcabea7c0d005d 100644
--- a/src/OCE/TRA/trabbl.F90
+++ b/src/OCE/TRA/trabbl.F90
@@ -101,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
@@ -172,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
@@ -221,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
diff --git a/src/OCE/TRA/tradmp.F90 b/src/OCE/TRA/tradmp.F90
index 16cab127eece4aed8c9dd7378ce67a2090acccc2..67760bfe1a4236f4f08cf6cf40ee5a109ab73374 100644
--- a/src/OCE/TRA/tradmp.F90
+++ b/src/OCE/TRA/tradmp.F90
@@ -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
!!----------------------------------------------------------------------
diff --git a/src/OCE/TRA/traisf.F90 b/src/OCE/TRA/traisf.F90
index 0abba863ee67267e6a598be8ecca360c4a6c4304..bb276fcaef7bf5e43daa796e227ea635fe78aa35 100644
--- a/src/OCE/TRA/traisf.F90
+++ b/src/OCE/TRA/traisf.F90
@@ -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
diff --git a/src/OCE/TRA/traldf.F90 b/src/OCE/TRA/traldf.F90
index fc22984261f8e975db9c86a92e92d20bb83d0227..c8cfa4cd6d71c4c32c9dc30ced07e58ab4f5eca5 100644
--- a/src/OCE/TRA/traldf.F90
+++ b/src/OCE/TRA/traldf.F90
@@ -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
!!----------------------------------------------------------------------
diff --git a/src/OCE/TRA/traldf_iso.F90 b/src/OCE/TRA/traldf_iso.F90
index d91b67eab805faab7f06fe9c63b44dd843c46945..36e5f9dcdb8576313ac488231508277d52ca5acd 100644
--- a/src/OCE/TRA/traldf_iso.F90
+++ b/src/OCE/TRA/traldf_iso.F90
@@ -62,9 +62,9 @@ CONTAINS
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2)
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pt2 ! tracer (only used in kpass=2)
- REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pt_rhs ! tracer trend
+ REAL(dp), DIMENSION(:,:,:,:), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2)
+ REAL(dp), DIMENSION(:,:,:,:), INTENT(in ) :: pt2 ! tracer (only used in kpass=2)
+ REAL(dp), DIMENSION(:,:,:,:), INTENT(inout) :: pt_rhs ! tracer trend
!!
CALL tra_ldf_iso_t( kt, Kmm, kit000, cdtype, pahu, pahv, is_tile(pahu), &
& pgu , pgv , is_tile(pgu) , pgui, pgvi, is_tile(pgui), &
@@ -125,9 +125,9 @@ CONTAINS
REAL(wp), DIMENSION(A2D_T(ktah) ,JPK) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]
REAL(wp), DIMENSION(A2D_T(ktg) ,KJPT), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels
REAL(wp), DIMENSION(A2D_T(ktgi) ,KJPT), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels
- REAL(wp), DIMENSION(A2D_T(ktt) ,JPK,KJPT), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2)
- REAL(wp), DIMENSION(A2D_T(ktt2) ,JPK,KJPT), INTENT(in ) :: pt2 ! tracer (only used in kpass=2)
- REAL(wp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) :: pt_rhs ! tracer trend
+ REAL(dp), DIMENSION(A2D_T(ktt) ,JPK,KJPT), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2)
+ REAL(dp), DIMENSION(A2D_T(ktt2) ,JPK,KJPT), INTENT(in ) :: pt2 ! tracer (only used in kpass=2)
+ REAL(dp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) :: pt_rhs ! tracer trend
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
INTEGER :: ikt
diff --git a/src/OCE/TRA/traldf_lap_blp.F90 b/src/OCE/TRA/traldf_lap_blp.F90
index 16e5df16cdfb7ca8c542f8fc40d6061a84979c13..176b52209693aa8d4b42d2de9da423bcddc84763 100644
--- a/src/OCE/TRA/traldf_lap_blp.F90
+++ b/src/OCE/TRA/traldf_lap_blp.F90
@@ -59,8 +59,8 @@ CONTAINS
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pt ! before tracer fields
- REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pt_rhs ! tracer trend
+ REAL(dp), DIMENSION(:,:,:,:), INTENT(in ) :: pt ! before tracer fields
+ REAL(dp), DIMENSION(:,:,:,:), INTENT(inout) :: pt_rhs ! tracer trend
!!
CALL tra_ldf_lap_t( kt, Kmm, kit000, cdtype, pahu, pahv, is_tile(pahu), &
& pgu , pgv , is_tile(pgu) , pgui, pgvi, is_tile(pgui), &
@@ -98,8 +98,8 @@ CONTAINS
REAL(wp), DIMENSION(A2D_T(ktah), JPK) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]
REAL(wp), DIMENSION(A2D_T(ktg), KJPT), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels
REAL(wp), DIMENSION(A2D_T(ktgi), KJPT), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels
- REAL(wp), DIMENSION(A2D_T(ktt), JPK,KJPT), INTENT(in ) :: pt ! before tracer fields
- REAL(wp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) :: pt_rhs ! tracer trend
+ REAL(dp), DIMENSION(A2D_T(ktt), JPK,KJPT), INTENT(in ) :: pt ! before tracer fields
+ REAL(dp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) :: pt_rhs ! tracer trend
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
INTEGER :: iij
@@ -205,11 +205,11 @@ CONTAINS
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, 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,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 :: ji, jj, jk, jn ! dummy loop indices
- REAL(wp), DIMENSION(A2D(nn_hls),jpk,kjpt) :: zlap ! laplacian at t-point
+ REAL(dp), DIMENSION(A2D(nn_hls),jpk,kjpt) :: zlap ! laplacian at t-point
REAL(wp), DIMENSION(A2D(nn_hls), kjpt) :: zglu, zglv ! bottom GRADh of the laplacian (u- and v-points)
REAL(wp), DIMENSION(A2D(nn_hls), kjpt) :: zgui, zgvi ! top GRADh of the laplacian (u- and v-points)
!!---------------------------------------------------------------------
@@ -238,7 +238,7 @@ CONTAINS
CALL tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt, pt, zlap, kjpt, 1 )
END SELECT
!
- IF (nn_hls==1) CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp ) ! Lateral boundary conditions (unchanged sign)
+ IF (nn_hls==1) CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_dp ) ! Lateral boundary conditions (unchanged sign)
! ! Partial top/bottom cell: GRADh( zlap )
IF( ln_isfcav .AND. ln_zps ) THEN ; CALL zps_hde_isf( kt, kjpt, zlap, zglu, zglv, zgui, zgvi ) ! both top & bottom
ELSEIF( ln_zps ) THEN ; CALL zps_hde ( kt, kjpt, zlap, zglu, zglv ) ! only bottom
diff --git a/src/OCE/TRA/traldf_triad.F90 b/src/OCE/TRA/traldf_triad.F90
index 70eddec54f8399bc0e4531d1198843206aa64952..cb5c6cce5f8fba065557a3cb55f2343e008075b5 100644
--- a/src/OCE/TRA/traldf_triad.F90
+++ b/src/OCE/TRA/traldf_triad.F90
@@ -59,9 +59,9 @@ CONTAINS
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pgu , pgv ! tracer gradient at pstep levels
REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2)
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pt2 ! tracer (only used in kpass=2)
- REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pt_rhs ! tracer trend
+ REAL(dp), DIMENSION(:,:,:,:), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2)
+ REAL(dp), DIMENSION(:,:,:,:), INTENT(in ) :: pt2 ! tracer (only used in kpass=2)
+ REAL(dp), DIMENSION(:,:,:,:), INTENT(inout) :: pt_rhs ! tracer trend
!!
CALL tra_ldf_triad_t( kt, Kmm, kit000, cdtype, pahu, pahv, is_tile(pahu), &
& pgu , pgv , is_tile(pgu) , pgui, pgvi, is_tile(pgui), &
@@ -101,9 +101,9 @@ CONTAINS
REAL(wp), DIMENSION(A2D_T(ktah), JPK) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s]
REAL(wp), DIMENSION(A2D_T(ktg), KJPT), INTENT(in ) :: pgu , pgv ! tracer gradient at pstep levels
REAL(wp), DIMENSION(A2D_T(ktgi), KJPT), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels
- REAL(wp), DIMENSION(A2D_T(ktt), JPK,KJPT), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2)
- REAL(wp), DIMENSION(A2D_T(ktt2), JPK,KJPT), INTENT(in ) :: pt2 ! tracer (only used in kpass=2)
- REAL(wp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) :: pt_rhs ! tracer trend
+ REAL(dp), DIMENSION(A2D_T(ktt), JPK,KJPT), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2)
+ REAL(dp), DIMENSION(A2D_T(ktt2), JPK,KJPT), INTENT(in ) :: pt2 ! tracer (only used in kpass=2)
+ REAL(dp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) :: pt_rhs ! tracer trend
!
INTEGER :: ji, jj, jk, jn, kp, iij ! dummy loop indices
REAL(wp) :: zcoef0, ze3w_2, zsign ! - -
diff --git a/src/OCE/TRA/tramle.F90 b/src/OCE/TRA/tramle.F90
index a6f00b0bf72866c66e504760e7b3a4c00a1eae2e..8ad7587d17640fc01999c2016e466ad23f9752e9 100644
--- a/src/OCE/TRA/tramle.F90
+++ b/src/OCE/TRA/tramle.F90
@@ -88,7 +88,7 @@ CONTAINS
CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
! TEMP: [tiling] 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(inout) :: pu ! in : 3 ocean transport components
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pv ! out: same 3 transport components
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pv ! out: same 3 transport components
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pw ! increased by the MLE induced transport
!
INTEGER :: ji, jj, jk ! dummy loop indices
diff --git a/src/OCE/TRA/tranpc.F90 b/src/OCE/TRA/tranpc.F90
index d1e9c1c79a8fbac9dcf752eec9452eeb5ab1925a..33d0af1b12bff7be823d75bb1b9e3ceb3575777d 100644
--- a/src/OCE/TRA/tranpc.F90
+++ b/src/OCE/TRA/tranpc.F90
@@ -62,7 +62,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER, INTENT(in ) :: kt ! ocean time-step index
INTEGER, INTENT(in ) :: Kmm, Krhs, Kaa ! 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
INTEGER :: jiter, ikbot, ikp, ikup, ikdown, ilayer, ik_low ! local integers
diff --git a/src/OCE/TRA/traqsr.F90 b/src/OCE/TRA/traqsr.F90
index 0bde7adce5679affb5d610bbf82171cc27ea23d9..397eb91c4444fc19a4c6fe38dfc0d4d0c18a85d5 100644
--- a/src/OCE/TRA/traqsr.F90
+++ b/src/OCE/TRA/traqsr.F90
@@ -104,7 +104,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER, INTENT(in ) :: kt ! ocean time-step
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
INTEGER :: irgb ! local integers
@@ -316,7 +316,7 @@ CONTAINS
ENDIF
! ! print mean trends (used for debugging)
IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' qsr - Ta: ', mask1=tmask, clinfo3='tra-ta' )
- !
+
IF( ln_timing ) CALL timing_stop('tra_qsr')
!
END SUBROUTINE tra_qsr
diff --git a/src/OCE/TRA/trasbc.F90 b/src/OCE/TRA/trasbc.F90
index 556be0c26a1818c375fd6a4893abfc5028e28be9..7fc57b704aee062a930fc335d386faa4aeede568 100644
--- a/src/OCE/TRA/trasbc.F90
+++ b/src/OCE/TRA/trasbc.F90
@@ -73,7 +73,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 Eq.
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer Eq.
!
INTEGER :: ji, jj, jk, jn ! dummy loop indices
INTEGER :: ikt, ikb ! local integers
diff --git a/src/OCE/TRA/trazdf.F90 b/src/OCE/TRA/trazdf.F90
index 8280d3181b6b2731e8616a0a24a938bd15b4d759..a376ad8d44bdbb4811ed4153593b168b11f34d33 100644
--- a/src/OCE/TRA/trazdf.F90
+++ b/src/OCE/TRA/trazdf.F90
@@ -54,7 +54,7 @@ CONTAINS
!!---------------------------------------------------------------------
INTEGER , INTENT(in) :: kt ! ocean time-step index
INTEGER , INTENT(in) :: Kbb, Kmm, Krhs, Kaa ! 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), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds ! 3D workspace
@@ -142,11 +142,13 @@ CONTAINS
CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)
INTEGER , INTENT(in ) :: kjpt ! number of tracers
REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step
- 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) :: zrhs, zzwi, zzws ! local scalars
- REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwi, zwt, zwd, zws
+ REAL(wp) :: zzwi, zzws! local scalars
+ REAL(dp) :: zrhs! local scalars
+ REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zws
+ REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zwi, zwt, zwd
!!---------------------------------------------------------------------
!
! ! ============= !
diff --git a/src/OCE/TRA/zpshde.F90 b/src/OCE/TRA/zpshde.F90
index 0591067f9e804265264b6aae3adb49d98dbfa6eb..6a19742dfb15903af3d6c6ac9fc88eb97ddefe6e 100644
--- a/src/OCE/TRA/zpshde.F90
+++ b/src/OCE/TRA/zpshde.F90
@@ -44,7 +44,7 @@ CONTAINS
!!
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: kjpt ! number of tracers
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pta ! 4D tracers fields
+ REAL(dp), DIMENSION(:,:,:,:), INTENT(in ) :: pta ! 4D tracers fields
REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts
REAL(wp), DIMENSION(:,:,:) , INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields
REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom)
@@ -107,7 +107,7 @@ CONTAINS
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: kjpt ! number of tracers
INTEGER , INTENT(in ) :: ktta, ktgt, ktrd, ktgr
- REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in ) :: pta ! 4D tracers fields
+ REAL(dp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in ) :: pta ! 4D tracers fields
REAL(wp), DIMENSION(A2D_T(ktgt) ,KJPT), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts
REAL(wp), DIMENSION(A2D_T(ktrd),JPK ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields
REAL(wp), DIMENSION(A2D_T(ktgr) ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom)
@@ -211,7 +211,7 @@ CONTAINS
!!
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: kjpt ! number of tracers
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pta ! 4D tracers fields
+ REAL(dp), DIMENSION(:,:,:,:), INTENT(in ) :: pta ! 4D tracers fields
REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts
REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF)
REAL(wp), DIMENSION(:,:,:) , INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields
@@ -280,7 +280,7 @@ CONTAINS
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: kjpt ! number of tracers
INTEGER , INTENT(in ) :: ktta, ktgt, ktgti, ktrd, ktgr, ktgri
- REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in ) :: pta ! 4D tracers fields
+ REAL(dp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in ) :: pta ! 4D tracers fields
REAL(wp), DIMENSION(A2D_T(ktgt) ,KJPT), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts
REAL(wp), DIMENSION(A2D_T(ktgti) ,KJPT), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF)
REAL(wp), DIMENSION(A2D_T(ktrd),JPK ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields
diff --git a/src/OCE/TRD/trddyn.F90 b/src/OCE/TRD/trddyn.F90
index 8816056e52b877dbd4118eaba52ceb326bc1c8b4..78dd5ecdb007e0a8eb6248545956f9fe3ae888e6 100644
--- a/src/OCE/TRD/trddyn.F90
+++ b/src/OCE/TRD/trddyn.F90
@@ -52,7 +52,7 @@ CONTAINS
!! integral constraints, barotropic vorticity, kinetic enrgy,
!! and/or mixed layer budget.
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends
+ REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends
INTEGER , INTENT(in ) :: ktrd ! trend index
INTEGER , INTENT(in ) :: kt ! time step
INTEGER , INTENT(in ) :: Kmm ! time level index
@@ -98,7 +98,7 @@ CONTAINS
!!
!! ** Purpose : output 3D trends using IOM
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends
+ REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends
INTEGER , INTENT(in ) :: ktrd ! trend index
INTEGER , INTENT(in ) :: kt ! time step
INTEGER , INTENT(in ) :: Kmm ! time level index
diff --git a/src/OCE/TRD/trdglo.F90 b/src/OCE/TRD/trdglo.F90
index 0e4a2aea0f1d16b4f7299c6d414d292d8b45b027..bc787379549713e5b4fad389e343edbbe1914f62 100644
--- a/src/OCE/TRD/trdglo.F90
+++ b/src/OCE/TRD/trdglo.F90
@@ -45,12 +45,13 @@ MODULE trdglo
! !!! domain averaged trends
REAL(wp), DIMENSION(jptot_tra) :: tmo, smo ! temperature and salinity trends
- REAL(wp), DIMENSION(jptot_tra) :: t2 , s2 ! T^2 and S^2 trends
- REAL(wp), DIMENSION(jptot_dyn) :: umo, vmo ! momentum trends
+ REAL(wp), DIMENSION(jptot_tra) :: t2 , s2 ! T^2 and S^2 trends
+ REAL(wp), DIMENSION(jptot_dyn) :: umo, vmo ! momentum trends
REAL(wp), DIMENSION(jptot_dyn) :: hke ! kinetic energy trends (u^2+v^2)
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -67,8 +68,8 @@ CONTAINS
!! T, T^2, momentum, KE, and KE<->PE
!!
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend
+ REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend
+ REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend
INTEGER , INTENT(in ) :: ktrd ! tracer trend index
CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum or tracers trends type (='DYN'/'TRA')
INTEGER , INTENT(in ) :: kt ! time step
@@ -201,7 +202,7 @@ CONTAINS
zkz (:,:,:) = 0._wp
zkepe(:,:,:) = 0._wp
- CALL eos( ts(:,:,:,:,Kmm), rhd, rhop ) ! now potential density
+ CALL eos( ts(:,:,:,:,Kmm), rhd, CASTSP(rhop) ) ! now potential density
zcof = 0.5_wp / rho0 ! Density flux at w-point
zkz(:,:,1) = 0._wp
diff --git a/src/OCE/TRD/trdken.F90 b/src/OCE/TRD/trdken.F90
index d97b3eb80a37e9db31884014b55435e2ba3547cc..b23a4d68901e78a23b93ad8de63b6e0f1ad18c19 100644
--- a/src/OCE/TRD/trdken.F90
+++ b/src/OCE/TRD/trdken.F90
@@ -77,7 +77,7 @@ CONTAINS
!
!
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V masked trends
+ REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V masked trends
INTEGER , INTENT(in ) :: ktrd ! trend index
INTEGER , INTENT(in ) :: kt ! time step
INTEGER , INTENT(in ) :: Kmm ! time level index
@@ -89,7 +89,7 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zke ! 3D workspace
!!----------------------------------------------------------------------
!
- CALL lbc_lnk( 'trdken', putrd, 'U', -1.0_wp , pvtrd, 'V', -1.0_wp ) ! lateral boundary conditions
+ CALL lbc_lnk( 'trdken', putrd, 'U', -1.0_dp , pvtrd, 'V', -1.0_dp ) ! lateral boundary conditions
!
nkstp = kt
DO jk = 1, jpkm1
diff --git a/src/OCE/TRD/trdmxl.F90 b/src/OCE/TRD/trdmxl.F90
index bce0dd5367ca329c9588297506059ddc4f662177..cd711fecda37948799472cd3b339cbec51c1a58b 100644
--- a/src/OCE/TRD/trdmxl.F90
+++ b/src/OCE/TRD/trdmxl.F90
@@ -69,6 +69,7 @@ MODULE trdmxl
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -249,8 +250,8 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT( in ) :: ktrd ! ocean trend index
CHARACTER(len=2) , INTENT( in ) :: ctype ! 2D surface/bottom or 3D interior physics
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pttrdmxl ! temperature trend
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pstrdmxl ! salinity trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pttrdmxl ! temperature trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pstrdmxl ! salinity trend
!
INTEGER :: ji, jj, jk, isum
REAL(wp), DIMENSION(jpi,jpj) :: zvlmsk
@@ -374,9 +375,9 @@ CONTAINS
IF( sn_cfctl%l_prtctl ) THEN
WRITE(numout,*) ' we reach kt == nit000 + 1 = ', nit000+1
- CALL prt_ctl(tab2d_1=tmlbb , clinfo1=' tmlbb - : ', mask1=tmask)
- CALL prt_ctl(tab2d_1=tmlbn , clinfo1=' tmlbn - : ', mask1=tmask)
- CALL prt_ctl(tab2d_1=tmlatfb , clinfo1=' tmlatfb - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(tmlbb) , clinfo1=' tmlbb - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(tmlbn) , clinfo1=' tmlbn - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(tmlatfb), clinfo1=' tmlatfb - : ', mask1=tmask)
END IF
!
END IF
@@ -384,16 +385,16 @@ CONTAINS
IF( ( ln_rstart ) .AND. ( kt == nit000 ) .AND. sn_cfctl%l_prtctl ) THEN
IF( ln_trdmxl_instant ) THEN
WRITE(numout,*) ' restart from kt == nit000 = ', nit000
- CALL prt_ctl(tab2d_1=tmlbb , clinfo1=' tmlbb - : ', mask1=tmask)
- CALL prt_ctl(tab2d_1=tmlbn , clinfo1=' tmlbn - : ', mask1=tmask)
- CALL prt_ctl(tab2d_1=tmlatfb , clinfo1=' tmlatfb - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(tmlbb ) , clinfo1=' tmlbb - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(tmlbn ) , clinfo1=' tmlbn - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(tmlatfb ), clinfo1=' tmlatfb - : ', mask1=tmask)
ELSE
WRITE(numout,*) ' restart from kt == nit000 = ', nit000
- CALL prt_ctl(tab2d_1=tmlbn , clinfo1=' tmlbn - : ', mask1=tmask)
- CALL prt_ctl(tab2d_1=hmxlbn , clinfo1=' hmxlbn - : ', mask1=tmask)
- CALL prt_ctl(tab2d_1=tml_sumb , clinfo1=' tml_sumb - : ', mask1=tmask)
- CALL prt_ctl(tab2d_1=tmltrd_atf_sumb, clinfo1=' tmltrd_atf_sumb - : ', mask1=tmask)
- CALL prt_ctl(tab3d_1=tmltrd_csum_ub , clinfo1=' tmltrd_csum_ub - : ', mask1=tmask, kdim=1)
+ CALL prt_ctl(tab2d_1=CASTDP(tmlbn) , clinfo1=' tmlbn - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(hmxlbn) , clinfo1=' hmxlbn - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(tml_sumb) , clinfo1=' tml_sumb - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(tmltrd_atf_sumb), clinfo1=' tmltrd_atf_sumb - : ', mask1=tmask)
+ CALL prt_ctl(tab3d_1=CASTDP(tmltrd_csum_ub) , clinfo1=' tmltrd_csum_ub - : ', mask1=tmask, kdim=1)
END IF
END IF
@@ -551,15 +552,15 @@ CONTAINS
IF( sn_cfctl%l_prtctl ) THEN
IF( ln_trdmxl_instant ) THEN
- CALL prt_ctl(tab2d_1=tmlbb , clinfo1=' tmlbb - : ', mask1=tmask)
- CALL prt_ctl(tab2d_1=tmlbn , clinfo1=' tmlbn - : ', mask1=tmask)
- CALL prt_ctl(tab2d_1=tmlatfb , clinfo1=' tmlatfb - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(tmlbb) , clinfo1=' tmlbb - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(tmlbn ) , clinfo1=' tmlbn - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(tmlatfb) , clinfo1=' tmlatfb - : ', mask1=tmask)
ELSE
- CALL prt_ctl(tab2d_1=tmlbn , clinfo1=' tmlbn - : ', mask1=tmask)
- CALL prt_ctl(tab2d_1=hmxlbn , clinfo1=' hmxlbn - : ', mask1=tmask)
- CALL prt_ctl(tab2d_1=tml_sumb , clinfo1=' tml_sumb - : ', mask1=tmask)
- CALL prt_ctl(tab2d_1=tmltrd_atf_sumb, clinfo1=' tmltrd_atf_sumb - : ', mask1=tmask)
- CALL prt_ctl(tab3d_1=tmltrd_csum_ub , clinfo1=' tmltrd_csum_ub - : ', mask1=tmask, kdim=1)
+ CALL prt_ctl(tab2d_1=CASTDP(tmlbn) , clinfo1=' tmlbn - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(hmxlbn) , clinfo1=' hmxlbn - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(tml_sumb) , clinfo1=' tml_sumb - : ', mask1=tmask)
+ CALL prt_ctl(tab2d_1=CASTDP(tmltrd_atf_sumb), clinfo1=' tmltrd_atf_sumb - : ', mask1=tmask)
+ CALL prt_ctl(tab3d_1=CASTDP(tmltrd_csum_ub), clinfo1=' tmltrd_csum_ub - : ', mask1=tmask, kdim=1)
END IF
END IF
@@ -725,7 +726,7 @@ CONTAINS
INTEGER :: jl ! dummy loop indices
INTEGER :: inum ! logical unit
INTEGER :: ios ! local integer
- REAL(wp) :: zjulian, zsto, zout
+ REAL(dp) :: zjulian, zsto, zout
CHARACTER (LEN=40) :: clop
CHARACTER (LEN=12) :: clmxl, cltu, clsu
!!
diff --git a/src/OCE/TRD/trdpen.F90 b/src/OCE/TRD/trdpen.F90
index 0c356f841b8ef2122ddc847db98675675c1d8eaf..a6cdc8ee3fb2451c283f8476a37ee4e137e71f54 100644
--- a/src/OCE/TRD/trdpen.F90
+++ b/src/OCE/TRD/trdpen.F90
@@ -63,7 +63,7 @@ CONTAINS
!! constraints, barotropic vorticity, kinetic enrgy,
!! potential energy, and/or mixed layer budget.
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptrdx, ptrdy ! Temperature & Salinity trends
+ REAL(dp), DIMENSION(:,:,:), INTENT(in) :: ptrdx, ptrdy ! Temperature & Salinity trends
INTEGER , INTENT(in) :: ktrd ! tracer trend index
INTEGER , INTENT(in) :: kt ! time step index
INTEGER , INTENT(in) :: Kmm ! time level index
@@ -78,7 +78,7 @@ CONTAINS
!
IF( kt /= nkstp ) THEN ! full eos: set partial derivatives at the 1st call of kt time step
nkstp = kt
- CALL eos_pen( ts(:,:,:,:,Kmm), rab_PE, zpe, Kmm )
+ CALL eos_pen( ts(:,:,:,:,Kmm), rab_pe, zpe, Kmm )
CALL iom_put( "alphaPE", rab_pe(:,:,:,jp_tem) )
CALL iom_put( "betaPE" , rab_pe(:,:,:,jp_sal) )
CALL iom_put( "PEanom" , zpe )
diff --git a/src/OCE/TRD/trdtra.F90 b/src/OCE/TRD/trdtra.F90
index a3377863268e3c79e108bfaebad9e761281bfac5..4c7d90d3ea1aa31d71f9cca5e2654424ddd78071 100644
--- a/src/OCE/TRD/trdtra.F90
+++ b/src/OCE/TRD/trdtra.F90
@@ -36,7 +36,7 @@ MODULE trdtra
PUBLIC trd_tra ! called by all tra_... modules
- REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt ! use to store the temperature trends
+ REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt ! use to store the temperature trends
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_evd ! store avt_evd to calculate EVD trend
!! * Substitutions
@@ -80,12 +80,13 @@ CONTAINS
INTEGER , INTENT(in) :: Kmm, Krhs ! time level indices
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: ptrd ! tracer trend or flux
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pu ! now velocity
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! now tracer variable
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! now tracer variable
!
INTEGER :: jk ! loop indices
INTEGER :: i01 ! 0 or 1
- REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrds ! 3D workspace
- REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwt, zws, ztrdt ! 3D workspace
+ REAL(dp), DIMENSION(jpi,jpj,jpk) :: ztrds ! 3D workspace
+ REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwt, zws! 3D workspace
+ REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt! 3D workspace
!!----------------------------------------------------------------------
!
IF( .NOT. ALLOCATED( trdtx ) ) THEN ! allocate trdtra arrays
@@ -201,9 +202,9 @@ CONTAINS
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pf ! advective flux in one direction
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu ! now velocity in one direction
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt ! now or before tracer
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt ! now or before tracer
CHARACTER(len=1) , INTENT(in ) :: cdir ! X/Y/Z direction
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: ptrd ! advective trend in one direction
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: ptrd ! advective trend in one direction
INTEGER, INTENT(in) :: Kmm ! time level index
!
INTEGER :: ji, jj, jk ! dummy loop indices
@@ -238,8 +239,8 @@ CONTAINS
!! integral constraints, potential energy, and/or
!! mixed layer budget.
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend
+ REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend
+ REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend
INTEGER , INTENT(in ) :: ktrd ! tracer trend index
INTEGER , INTENT(in ) :: kt ! time step
INTEGER , INTENT(in ) :: Kmm ! time level index
@@ -299,8 +300,8 @@ CONTAINS
!!
!! ** Purpose : output 3D tracer trends using IOM
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend
+ REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend
+ REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend
INTEGER , INTENT(in ) :: ktrd ! tracer trend index
INTEGER , INTENT(in ) :: kt ! time step
INTEGER , INTENT(in ) :: Kmm ! time level index
diff --git a/src/OCE/TRD/trdtrc.F90 b/src/OCE/TRD/trdtrc.F90
index f825ddd8a854909ef9ff2b6c82892472b77f73d8..f4200feed859135894a873c13d7cc1c02aec7c72 100644
--- a/src/OCE/TRD/trdtrc.F90
+++ b/src/OCE/TRD/trdtrc.F90
@@ -12,7 +12,7 @@ CONTAINS
SUBROUTINE trd_trc( ptrtrd, kjn, ktrd, kt, Kmm )
INTEGER :: kt, kjn, ktrd
INTEGER :: Kmm ! time level index
- REAL(wp):: ptrtrd(:,:,:)
+ REAL(dp), DIMENSION(:,:,:) :: 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/src/OCE/TRD/trdvor.F90 b/src/OCE/TRD/trdvor.F90
index 974f5b1a9b06f1a16fcdbee8d7457b71f9a5ea6c..346d697c3b6e9e14260b8c10b32b0028dc81a3e8 100644
--- a/src/OCE/TRD/trdvor.F90
+++ b/src/OCE/TRD/trdvor.F90
@@ -50,12 +50,13 @@ MODULE trdvor
REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: rotot ! begining of the NN_WRITE-1 timesteps
REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrtot !
REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrres !
- REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: vortrd ! curl of trends
+ REAL(dp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: vortrd ! curl of trends
CHARACTER(len=12) :: cvort
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -85,7 +86,7 @@ CONTAINS
!! ** Purpose : computation of cumulated trends over analysis period
!! and make outputs (NetCDF format)
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends
+ REAL(dp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends
INTEGER , INTENT(in ) :: ktrd ! trend index
INTEGER , INTENT(in ) :: kt ! time step
INTEGER , INTENT(in ) :: Kmm ! time level index
@@ -94,7 +95,7 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv ! 2D workspace
!!----------------------------------------------------------------------
- CALL lbc_lnk( 'trdvor', putrd, 'U', -1.0_wp , pvtrd, 'V', -1.0_wp ) ! lateral boundary condition
+ CALL lbc_lnk( 'trdvor', putrd, 'U', -1.0_dp , pvtrd, 'V', -1.0_dp ) ! lateral boundary condition
SELECT CASE( ktrd )
CASE( jpdyn_hpg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_prg, Kmm ) ! Hydrostatique Pressure Gradient
@@ -227,8 +228,8 @@ CONTAINS
!
INTEGER , INTENT(in) :: ktrd ! ocean trend index
INTEGER , INTENT(in) :: Kmm ! time level index
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: putrdvor ! u vorticity trend
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pvtrdvor ! v vorticity trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: putrdvor ! u vorticity trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pvtrdvor ! v vorticity trend
!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp), DIMENSION(jpi,jpj) :: zudpvor, zvdpvor ! total cmulative trends
@@ -403,8 +404,8 @@ CONTAINS
CALL histwrite( nidvor,"sovortbv",it,vortrd(:,:,jpvor_bev),ndimvor1,ndexvor1) ! beta.V
CALL histwrite( nidvor,"sovowind",it,vortrd(:,:,jpvor_swf),ndimvor1,ndexvor1) ! wind stress
CALL histwrite( nidvor,"sovobfri",it,vortrd(:,:,jpvor_bfr),ndimvor1,ndexvor1) ! bottom friction
- CALL histwrite( nidvor,"1st_mbre",it,vor_avrtot ,ndimvor1,ndexvor1) ! First membre
- CALL histwrite( nidvor,"sovorgap",it,vor_avrres ,ndimvor1,ndexvor1) ! gap between 1st and 2 nd mbre
+ CALL histwrite( nidvor,"1st_mbre",it,CASTDP(vor_avrtot) ,ndimvor1,ndexvor1) ! First membre
+ CALL histwrite( nidvor,"sovorgap",it,CASTDP(vor_avrres) ,ndimvor1,ndexvor1) ! gap between 1st and 2 nd mbre
!
IF( ndebug /= 0 ) THEN
WRITE(numout,*) ' debuging trd_vor: III.4 done'
@@ -427,7 +428,7 @@ CONTAINS
!! ** Purpose : computation of vertically integrated T and S budgets
!! from ocean surface down to control surface (NetCDF output)
!!----------------------------------------------------------------------
- REAL(wp) :: zjulian, zsto, zout
+ REAL(dp) :: zjulian, zsto, zout
CHARACTER (len=40) :: clhstnam
CHARACTER (len=40) :: clop
!!----------------------------------------------------------------------
@@ -490,7 +491,7 @@ CONTAINS
! II.2 Compute julian date from starting date of the run
! ------------------------
- CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian )
+ CALL ymds2ju( nyear, nmonth, nday, CASTDP(rn_Dt), zjulian )
zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
IF(lwp) WRITE(numout,*)' '
IF(lwp) WRITE(numout,*)' Date 0 used :',nit000, &
@@ -501,8 +502,8 @@ CONTAINS
! ---------------------------------
CALL dia_nam( clhstnam, nn_trd, 'vort' ) ! filename
IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam
- CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi, & ! Horizontal grid : glamt and gphit
- & 1, jpj, nit000-1, zjulian, rn_Dt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set )
+ CALL histbeg( clhstnam, jpi, CASTDP(glamf), jpj, CASTDP(gphif),1, jpi, & ! Horizontal grid : glamt and gphit
+ & 1, jpj, nit000-1, zjulian, CASTDP(rn_Dt), nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set )
CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 ) ! surface
! Declare output fields as netCDF variables
diff --git a/src/OCE/USR/usrdef_hgr.F90 b/src/OCE/USR/usrdef_hgr.F90
index 2f617b552235a7b19c9cad93e777a785bcca0884..f96e7b6ae5362afe0c0edb915f4f69b986e469c1 100644
--- a/src/OCE/USR/usrdef_hgr.F90
+++ b/src/OCE/USR/usrdef_hgr.F90
@@ -62,8 +62,10 @@ CONTAINS
REAL(wp), DIMENSION(:,:), INTENT(out) :: pphit, pphiu, pphiv, pphif ! latitude outputs [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) :: pe1t, pe1u, pe1v, pe1f ! i-scale factors [m]
- REAL(wp), DIMENSION(:,:), INTENT(out) :: pe2t, pe2u, pe2v, pe2f ! j-scale factors [m]
+ 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]
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]
!
diff --git a/src/OCE/USR/usrdef_istate.F90 b/src/OCE/USR/usrdef_istate.F90
index 7ae061b03b669ca94ec9c82fa69d5d0a90847521..57d844cbbc1e192ffc9aace0eadc0ac7e7a4f484 100644
--- a/src/OCE/USR/usrdef_istate.F90
+++ b/src/OCE/USR/usrdef_istate.F90
@@ -46,9 +46,9 @@ CONTAINS
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pdept ! depth of t-point [m]
REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m]
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pts ! T & S fields [Celsius ; g/kg]
- REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s]
- REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s]
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pts ! T & S fields [Celsius ; g/kg]
+ REAL(dp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s]
+ REAL(dp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s]
!
INTEGER :: ji, jj, jk ! dummy loop indices
!!----------------------------------------------------------------------
@@ -89,7 +89,7 @@ CONTAINS
!! ** Method : Set ssh as null, ptmask is required for test cases
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m]
- REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height [m]
+ REAL(dp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height [m]
!!----------------------------------------------------------------------
!
IF(lwp) WRITE(numout,*)
diff --git a/src/OCE/USR/usrdef_sbc.F90 b/src/OCE/USR/usrdef_sbc.F90
index ce5b785a973082a9dd81b952667d965cd21a2bfc..d04070744cdb0986c68a35845f809ea784d191b4 100644
--- a/src/OCE/USR/usrdef_sbc.F90
+++ b/src/OCE/USR/usrdef_sbc.F90
@@ -31,6 +31,7 @@ MODULE usrdef_sbc
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: usrdef_sbc.F90 15145 2021-07-26 16:16:45Z smasson $
@@ -67,7 +68,7 @@ CONTAINS
REAL(wp) :: ztimemax1, ztimemin1 ! 21th June, and 21th decem. if date0 = 1st january
REAL(wp) :: ztimemax2, ztimemin2 ! 21th June, and 21th decem. if date0 = 1st january
REAL(wp) :: ztaun ! intensity
- REAL(wp) :: zemp_s, zemp_n, zemp_sais, ztstar
+ REAL(wp) :: zemp_S, zemp_N, zemp_sais, zTstar
REAL(wp) :: zcos_sais1, zcos_sais2, ztrp, zconv, t_star
REAL(wp) :: zsumemp, zsurf
REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3
@@ -130,8 +131,8 @@ CONTAINS
ENDIF
END_2D
- zsumemp = GLOB_SUM( 'usrdef_sbc', emp (:,:) )
- zsurf = GLOB_SUM( 'usrdef_sbc', tmask(:,:,1) )
+ zsumemp = GLOB_SUM( 'usrdef_sbc', CASTDP(emp (:,:)) )
+ zsurf = GLOB_SUM( 'usrdef_sbc', CASTDP(tmask(:,:,1)) )
zsumemp = zsumemp / zsurf ! Default GYRE configuration
! freshwater (mass flux) and update of qns with heat content of emp
diff --git a/src/OCE/USR/usrdef_zgr.F90 b/src/OCE/USR/usrdef_zgr.F90
index 99916151b849bf1bf43cda85df0c902111b48ed8..4e2d11f59ad230b8988e33e87c67db44fe07c802 100644
--- a/src/OCE/USR/usrdef_zgr.F90
+++ b/src/OCE/USR/usrdef_zgr.F90
@@ -52,7 +52,8 @@ CONTAINS
REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m]
REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pdept, pdepw ! grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3u, pe3v, pe3f! vertical scale factors [m]
+ REAL(dp), DIMENSION(:,:,:), INTENT(out) :: pe3t! vertical scale factors [m]
REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors
INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level
!
@@ -220,7 +221,8 @@ CONTAINS
REAL(wp), DIMENSION(:) , INTENT(in ) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m]
REAL(wp), DIMENSION(:) , INTENT(in ) :: pe3t_1d , pe3w_1d ! 1D vertical scale factors [m]
REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pdept, pdepw ! grid-point depth [m]
- REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m]
+ REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3u, pe3v, pe3f! vertical scale factors [m]
+ REAL(dp), DIMENSION(:,:,:), INTENT( out) :: pe3t! vertical scale factors [m]
REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3w , pe3uw, pe3vw ! - - -
!
INTEGER :: jk
diff --git a/src/OCE/ZDF/zdfddm.F90 b/src/OCE/ZDF/zdfddm.F90
index 4cfc6ead2360d0b6ed209be7e13c8c347bfb7596..8b96fb64a1598649719680ac747fa75173a8fcdc 100644
--- a/src/OCE/ZDF/zdfddm.F90
+++ b/src/OCE/ZDF/zdfddm.F90
@@ -30,6 +30,7 @@ MODULE zdfddm
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -158,7 +159,7 @@ CONTAINS
! ! ===============
!
IF(sn_cfctl%l_prtctl) THEN
- CALL prt_ctl(tab3d_1=avt , clinfo1=' ddm - t: ', tab3d_2=avs , clinfo2=' s: ')
+ CALL prt_ctl(tab3d_1=CASTDP(avt), clinfo1=' ddm - t: ', tab3d_2=CASTDP(avs) , clinfo2=' s: ')
ENDIF
!
END SUBROUTINE zdf_ddm
diff --git a/src/OCE/ZDF/zdfdrg.F90 b/src/OCE/ZDF/zdfdrg.F90
index 7c866594d4d6e9a06a3be206caa898d2eb2f7686..a8916a1727aeef5e3d0aad1280e17a111c2abb1c 100644
--- a/src/OCE/ZDF/zdfdrg.F90
+++ b/src/OCE/ZDF/zdfdrg.F90
@@ -74,6 +74,7 @@ MODULE zdfdrg
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -137,7 +138,7 @@ CONTAINS
END_2D
ENDIF
!
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=pCdU, clinfo1=' Cd*U ')
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=CASTDP(pCdU), clinfo1=' Cd*U ')
!
END SUBROUTINE zdf_drg
@@ -156,14 +157,14 @@ CONTAINS
!!---------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kmm ! time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pub, pvb ! the two components of the before velocity
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! the two components of the velocity tendency
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pub, pvb ! the two components of the before velocity
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! the two components of the velocity tendency
!!
INTEGER :: ji, jj ! dummy loop indexes
INTEGER :: ikbu, ikbv ! local integers
REAL(wp) :: zm1_2dt ! local scalar
REAL(wp) :: zCdu, zCdv ! - -
- REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv
+ REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv
!!---------------------------------------------------------------------
!
!!gm bug : time step is only rn_Dt (not 2 rn_Dt if euler start !)
diff --git a/src/OCE/ZDF/zdfgls.F90 b/src/OCE/ZDF/zdfgls.F90
index b37cdb9e14b9d3476ead8d3866bb22fe34005a39..61cc05ecb5cda078108a1edc00d43e051ac8dda9 100644
--- a/src/OCE/ZDF/zdfgls.F90
+++ b/src/OCE/ZDF/zdfgls.F90
@@ -114,6 +114,7 @@ MODULE zdfgls
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -856,8 +857,8 @@ CONTAINS
p_avt(A2D(nn_hls),1) = 0._wp
!
IF(sn_cfctl%l_prtctl) THEN
- CALL prt_ctl( tab3d_1=en , clinfo1=' gls - e: ', tab3d_2=p_avt, clinfo2=' t: ' )
- CALL prt_ctl( tab3d_1=p_avm, clinfo1=' gls - m: ' )
+ CALL prt_ctl( tab3d_1=CASTDP(en ) , clinfo1=' gls - e: ', tab3d_2=CASTDP(p_avt), clinfo2=' t: ' )
+ CALL prt_ctl( tab3d_1=CASTDP(p_avm), clinfo1=' gls - m: ' )
ENDIF
!
END SUBROUTINE zdf_gls
diff --git a/src/OCE/ZDF/zdfiwm.F90 b/src/OCE/ZDF/zdfiwm.F90
index d0a9540eaa619d70c6eff3ba70b4c417f26f84d1..7a8ba8dc626abcde4e0d25a2ec2900e71c4ca84b 100644
--- a/src/OCE/ZDF/zdfiwm.F90
+++ b/src/OCE/ZDF/zdfiwm.F90
@@ -53,6 +53,7 @@ MODULE zdfiwm
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -299,7 +300,7 @@ CONTAINS
ENDIF
ENDIF
- IF(sn_cfctl%l_prtctl) CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' iwm - av_wave: ', tab3d_2=avt, clinfo2=' avt: ')
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl(tab3d_1=CASTDP(zav_wave) , clinfo1=' iwm - av_wave: ', tab3d_2=CASTDP(avt), clinfo2=' avt: ')
!
END SUBROUTINE zdf_iwm
@@ -423,7 +424,7 @@ CONTAINS
ztmp(:,:,3) = e1e2t(:,:) * ensq_iwm(:,:)
ztmp(:,:,4) = e1e2t(:,:) * esho_iwm(:,:)
- zdia(1:4) = glob_sum_vec( 'zdfiwm', ztmp(:,:,1:4) )
+ zdia(1:4) =glob_sum_vec( 'zdfiwm', CASTDP(ztmp(:,:,1:4)) )
IF(lwp) THEN
WRITE(numout,*) ' Dissipation above abyssal hills: ', zdia(1) * 1.e-12_wp, 'TW'
diff --git a/src/OCE/ZDF/zdfmfc.F90 b/src/OCE/ZDF/zdfmfc.F90
index f984b2bfa425f1ceb62b6c249dff7a5a3fca0a98..095b2c0a8b4e770325661b78001fc2341d68093b 100644
--- a/src/OCE/ZDF/zdfmfc.F90
+++ b/src/OCE/ZDF/zdfmfc.F90
@@ -1,4 +1,4 @@
- MODULE zdfmfc
+MODULE zdfmfc
!!======================================================================
!! *** MODULE zdfmfc ***
!! Ocean physics: Mass-Flux scheme parameterization of Convection:
@@ -57,6 +57,7 @@
!
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.2 , NEMO Consortium (2018)
@@ -94,7 +95,7 @@ CONTAINS
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
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
REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) :: ztsp ! T/S of the plume
REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) :: ztse ! T/S at W point
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zrwp !
@@ -211,7 +212,7 @@ CONTAINS
! Compute the buoyancy acceleration on T-points at jk-1
zrautbm1(:,:) = zrautb(:,:)
- CALL eos( pts (:,:,jk ,:,Kmm) , zrautb(:,:) )
+ CALL eos( CASTSP(pts (:,:,jk ,:,Kmm)) , zrautb(:,:) )
CALL eos( ztsp(:,:,jk-1,: ) , zraupl(:,:) )
DO_2D( 0, 0, 0, 0 )
@@ -395,7 +396,8 @@ CONTAINS
SUBROUTINE diag_mfc( zdiagi, zdiagd, zdiags, p2dt, Kaa )
- REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: zdiagi, zdiagd, zdiags ! inout: tridaig. terms
+ REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: zdiags! inout: tridaig. terms
+ REAL(dp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) :: zdiagi, zdiagd! inout: tridaig. terms
REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step
INTEGER , INTENT(in ) :: Kaa ! ocean time level indices
@@ -411,7 +413,7 @@ CONTAINS
SUBROUTINE rhs_mfc( zrhs, jjn )
- REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: zrhs ! inout: rhs trend
+ REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: zrhs ! inout: rhs trend
INTEGER , INTENT(in ) :: jjn ! tracer indices
INTEGER :: ji, jj, jk ! dummy loop arguments
@@ -483,6 +485,3 @@ CONTAINS
!!======================================================================
END MODULE zdfmfc
-
-
-
diff --git a/src/OCE/ZDF/zdfmxl.F90 b/src/OCE/ZDF/zdfmxl.F90
index c387bdb14eb18cced95ea452b9f8f7c4906ce06a..a2510884cdf25bfeca911ec303e9978a03ea7a77 100644
--- a/src/OCE/ZDF/zdfmxl.F90
+++ b/src/OCE/ZDF/zdfmxl.F90
@@ -37,6 +37,7 @@ MODULE zdfmxl
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -115,7 +116,7 @@ CONTAINS
ENDIF
ENDIF
!
- IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ' )
+ IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=REAL(nmln,dp), clinfo1=' nmln : ', tab2d_2=CASTDP(hmlp), clinfo2=' hmlp : ' )
!
END SUBROUTINE zdf_mxl
diff --git a/src/OCE/ZDF/zdfosm.F90 b/src/OCE/ZDF/zdfosm.F90
index 1a4bfabbce4a561a1f9e95b51ba55e24dc339a86..73d7f2026a8692ccaa96a544f58e9f76b7d866c3 100644
--- a/src/OCE/ZDF/zdfosm.F90
+++ b/src/OCE/ZDF/zdfosm.F90
@@ -1711,7 +1711,7 @@ CONTAINS
REAL(wp) :: zari, ztau, zdh_ref, zddhdt, zvel_max
REAL(wp) :: ztmp ! Auxiliary variable
!!
- REAL, PARAMETER :: pp_ddh = 2.5_wp, pp_ddh_2 = 3.5_wp ! Also in pycnocline_depth
+ REAL(wp), PARAMETER :: pp_ddh = 2.5_wp, pp_ddh_2 = 3.5_wp ! Also in pycnocline_depth
!!----------------------------------------------------------------------
!
DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
@@ -3335,7 +3335,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! 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
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds ! 3D workspace
@@ -3409,7 +3409,7 @@ CONTAINS
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! Ocean time step index
INTEGER , INTENT(in ) :: Kmm, Krhs ! Ocean time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! Ocean velocities and RHS of momentum equation
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! Ocean velocities and RHS of momentum equation
!!
INTEGER :: ji, jj, jk ! dummy loop indices
!!----------------------------------------------------------------------
diff --git a/src/OCE/ZDF/zdftke.F90 b/src/OCE/ZDF/zdftke.F90
index 5680ec1e20176e01de75677426a40208fdf571f2..6e3e6b93fb9d2207d66068e57693f20df20fe787 100644
--- a/src/OCE/ZDF/zdftke.F90
+++ b/src/OCE/ZDF/zdftke.F90
@@ -102,6 +102,7 @@ MODULE zdftke
!! * Substitutions
# include "do_loop_substitute.h90"
+# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -701,8 +702,8 @@ CONTAINS
ENDIF
!
IF(sn_cfctl%l_prtctl) THEN
- CALL prt_ctl( tab3d_1=en , clinfo1=' tke - e: ', tab3d_2=p_avt, clinfo2=' t: ' )
- CALL prt_ctl( tab3d_1=p_avm, clinfo1=' tke - m: ' )
+ CALL prt_ctl( tab3d_1=CASTDP(en) , clinfo1=' tke - e: ', tab3d_2=CASTDP(p_avt), clinfo2=' t: ' )
+ CALL prt_ctl( tab3d_1=CASTDP(p_avm), clinfo1=' tke - m: ' )
ENDIF
!
END SUBROUTINE tke_avn
diff --git a/src/OCE/lib_fortran.F90 b/src/OCE/lib_fortran.F90
index 9929defb47e3b42cb645dae8d2488fff8d1e0f97..299a7c0047f4dc4eda95f0e50bae3cc381135057 100644
--- a/src/OCE/lib_fortran.F90
+++ b/src/OCE/lib_fortran.F90
@@ -113,13 +113,13 @@ CONTAINS
FUNCTION local_sum_2d( ptab )
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:), INTENT(in) :: ptab ! array on which operation is applied
- COMPLEX(dp) :: local_sum_2d
+ REAL(dp), DIMENSION(:,:), INTENT(in ) :: ptab ! array on which operation is applied
+ COMPLEX(dp) :: local_sum_2d
!
!!-----------------------------------------------------------------------
!
COMPLEX(dp):: ctmp
- REAL(wp) :: ztmp
+ REAL(dp) :: ztmp
INTEGER :: ji, jj ! dummy loop indices
INTEGER :: ipi, ipj ! dimensions
!!-----------------------------------------------------------------------
@@ -127,12 +127,12 @@ CONTAINS
ipi = SIZE(ptab,1) ! 1st dimension
ipj = SIZE(ptab,2) ! 2nd dimension
!
- ctmp = CMPLX( 0._dp, 0._dp, dp ) ! warning ctmp is cumulated
+ ctmp = CMPLX( 0.e0, 0.e0, dp ) ! warning ctmp is cumulated
DO jj = 1, ipj
DO ji = 1, ipi
ztmp = ptab(ji,jj) * tmask_i(ji,jj)
- CALL DDPDD( CMPLX( ztmp, 0._dp, dp ), ctmp )
+ CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp )
END DO
END DO
!
@@ -142,13 +142,13 @@ CONTAINS
FUNCTION local_sum_3d( ptab )
!!----------------------------------------------------------------------
- REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptab ! array on which operation is applied
- COMPLEX(dp) :: local_sum_3d
+ REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptab ! array on which operation is applied
+ COMPLEX(dp) :: local_sum_3d
!
!!-----------------------------------------------------------------------
!
COMPLEX(dp):: ctmp
- REAL(wp) :: ztmp
+ REAL(dp) :: ztmp
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ipi, ipj, ipk ! dimensions
!!-----------------------------------------------------------------------
@@ -157,13 +157,13 @@ CONTAINS
ipj = SIZE(ptab,2) ! 2nd dimension
ipk = SIZE(ptab,3) ! 3rd dimension
!
- ctmp = CMPLX( 0._dp, 0._dp, dp ) ! warning ctmp is cumulated
+ ctmp = CMPLX( 0.e0, 0.e0, dp ) ! warning ctmp is cumulated
DO jk = 1, ipk
DO jj = 1, ipj
DO ji = 1, ipi
ztmp = ptab(ji,jj,jk) * tmask_i(ji,jj)
- CALL DDPDD( CMPLX( ztmp, 0._dp, dp ), ctmp )
+ CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp )
END DO
END DO
END DO
@@ -286,12 +286,12 @@ CONTAINS
FUNCTION glob_sum_vec_3d( cdname, ptab ) RESULT( ptmp )
!!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
- REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptab ! array on which operation is applied
- REAL(wp), DIMENSION(SIZE(ptab,3)) :: ptmp
+ CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
+ REAL(dp), DIMENSION(:,:,:), INTENT(in) :: ptab ! array on which operation is applied
+ REAL(dp), DIMENSION(SIZE(ptab,3)) :: ptmp
!
COMPLEX(dp), DIMENSION(:), ALLOCATABLE :: ctmp
- REAL(wp) :: ztmp
+ REAL(dp) :: ztmp
INTEGER :: ji , jj , jk ! dummy loop indices
INTEGER :: ipi, ipj, ipk ! dimensions
INTEGER :: iis, iie, ijs, ije ! loop start and end
@@ -312,17 +312,17 @@ CONTAINS
ALLOCATE( ctmp(ipk) )
!
DO jk = 1, ipk
- ctmp(jk) = CMPLX( 0._dp, 0._dp, dp ) ! warning ctmp is cumulated
+ ctmp(jk) = CMPLX( 0.e0, 0.e0, dp ) ! warning ctmp is cumulated
DO jj = ijs, ije
DO ji = iis, iie
ztmp = ptab(ji,jj,jk) * tmask_i(ji,jj)
- CALL DDPDD( CMPLX( ztmp, 0._dp, dp ), ctmp(jk) )
+ CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp(jk) )
END DO
END DO
END DO
CALL mpp_sum( cdname, ctmp(:) ) ! sum over the global domain
!
- ptmp = REAL( ctmp(:), wp )
+ ptmp = REAL( ctmp(:), dp )
!
DEALLOCATE( ctmp )
!
@@ -330,12 +330,12 @@ CONTAINS
FUNCTION glob_sum_vec_4d( cdname, ptab ) RESULT( ptmp )
!!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: ptab ! array on which operation is applied
- REAL(wp), DIMENSION(SIZE(ptab,4)) :: ptmp
+ CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
+ REAL(dp), DIMENSION(:,:,:,:), INTENT(in) :: ptab ! array on which operation is applied
+ REAL(dp), DIMENSION(SIZE(ptab,4)) :: ptmp
!
COMPLEX(dp), DIMENSION(:), ALLOCATABLE :: ctmp
- REAL(wp) :: ztmp
+ REAL(dp) :: ztmp
INTEGER :: ji , jj , jk , jl ! dummy loop indices
INTEGER :: ipi, ipj, ipk, ipl ! dimensions
INTEGER :: iis, iie, ijs, ije ! loop start and end
@@ -362,14 +362,14 @@ CONTAINS
DO jj = ijs, ije
DO ji = iis, iie
ztmp = ptab(ji,jj,jk,jl) * tmask_i(ji,jj)
- CALL DDPDD( CMPLX( ztmp, 0._dp, dp ), ctmp(jl) )
+ CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp(jl) )
END DO
END DO
END DO
END DO
CALL mpp_sum( cdname, ctmp(:) ) ! sum over the global domain
!
- ptmp = REAL( ctmp(:), wp )
+ ptmp = REAL( ctmp(:), dp )
!
DEALLOCATE( ctmp )
!
@@ -377,9 +377,9 @@ CONTAINS
FUNCTION glob_min_vec_3d( cdname, ptab ) RESULT( ptmp )
!!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
- REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptab ! array on which operation is applied
- REAL(wp), DIMENSION(SIZE(ptab,3)) :: ptmp
+ CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
+ REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptab ! array on which operation is applied
+ REAL(dp), DIMENSION(SIZE(ptab,3)) :: ptmp
!
INTEGER :: jk ! dummy loop indice & dimension
INTEGER :: ipk ! dimension
@@ -396,9 +396,9 @@ CONTAINS
FUNCTION glob_min_vec_4d( cdname, ptab ) RESULT( ptmp )
!!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: ptab ! array on which operation is applied
- REAL(wp), DIMENSION(SIZE(ptab,4)) :: ptmp
+ CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: ptab ! array on which operation is applied
+ REAL(dp), DIMENSION(SIZE(ptab,4)) :: ptmp
!
INTEGER :: jk , jl ! dummy loop indice & dimension
INTEGER :: ipk, ipl ! dimension
@@ -419,9 +419,9 @@ CONTAINS
FUNCTION glob_max_vec_3d( cdname, ptab ) RESULT( ptmp )
!!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
- REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptab ! array on which operation is applied
- REAL(wp), DIMENSION(SIZE(ptab,3)) :: ptmp
+ CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
+ REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptab ! array on which operation is applied
+ REAL(dp), DIMENSION(SIZE(ptab,3)) :: ptmp
!
INTEGER :: jk ! dummy loop indice & dimension
INTEGER :: ipk ! dimension
@@ -438,9 +438,9 @@ CONTAINS
FUNCTION glob_max_vec_4d( cdname, ptab ) RESULT( ptmp )
!!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
- REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: ptab ! array on which operation is applied
- REAL(wp), DIMENSION(SIZE(ptab,4)) :: ptmp
+ CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
+ REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: ptab ! array on which operation is applied
+ REAL(dp), DIMENSION(SIZE(ptab,4)) :: ptmp
!
INTEGER :: jk , jl ! dummy loop indice & dimension
INTEGER :: ipk, ipl ! dimension
@@ -467,7 +467,7 @@ CONTAINS
!!
!!
!! ** Method : The code uses the compensated summation with doublet
- !! (sum,error) emulated useing complex numbers. ydda is the
+ !! (sum,error) emulated using complex numbers. ydda is the
!! scalar to add to the summ yddb
!!
!! ** Action : This does only work for MPI.
diff --git a/src/OCE/lib_fortran_generic.h90 b/src/OCE/lib_fortran_generic.h90
index e09d498522c066fc408a7d5e6d1c22a0aa3cc270..35dc7edc765231c8e092c1b145bd964ce28824f2 100644
--- a/src/OCE/lib_fortran_generic.h90
+++ b/src/OCE/lib_fortran_generic.h90
@@ -2,7 +2,7 @@
! ! FUNCTION FUNCTION_GLOBSUM !
# if defined DIM_1d
# define XD 1d
-# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
+# define ARRAY_TYPE(i,j,k) REAL(dp) , INTENT(in ) :: ARRAY_IN(i,j,k)
# define ARRAY_IN(i,j,k) ptab(i)
# define ARRAY2_IN(i,j,k) ptab2(i)
# define J_SIZE(ptab) 1
@@ -11,7 +11,7 @@
# endif
# if defined DIM_2d
# define XD 2d
-# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
+# define ARRAY_TYPE(i,j,k) REAL(dp) , INTENT(in ) :: ARRAY_IN(i,j,k)
# define ARRAY_IN(i,j,k) ptab(i,j)
# define ARRAY2_IN(i,j,k) ptab2(i,j)
# define J_SIZE(ptab) SIZE(ptab,2)
@@ -20,7 +20,7 @@
# endif
# if defined DIM_3d
# define XD 3d
-# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
+# define ARRAY_TYPE(i,j,k) REAL(dp) , INTENT(in ) :: ARRAY_IN(i,j,k)
# define ARRAY_IN(i,j,k) ptab(i,j,k)
# define ARRAY2_IN(i,j,k) ptab2(i,j,k)
# define J_SIZE(ptab) SIZE(ptab,2)
@@ -83,14 +83,14 @@
! ! FUNCTION FUNCTION_GLOBMINMAX !
# if defined DIM_2d
# define XD 2d
-# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
+# define ARRAY_TYPE(i,j,k) REAL(dp) , INTENT(in ) :: ARRAY_IN(i,j,k)
# define ARRAY_IN(i,j,k) ptab(i,j)
# define ARRAY2_IN(i,j,k) ptab2(i,j)
# define K_SIZE(ptab) 1
# endif
# if defined DIM_3d
# define XD 3d
-# define ARRAY_TYPE(i,j,k) REAL(wp) , INTENT(in ) :: ARRAY_IN(i,j,k)
+# define ARRAY_TYPE(i,j,k) REAL(dp) , INTENT(in ) :: ARRAY_IN(i,j,k)
# define ARRAY_IN(i,j,k) ptab(i,j,k)
# define ARRAY2_IN(i,j,k) ptab2(i,j,k)
# define K_SIZE(ptab) SIZE(ptab,3)
diff --git a/src/OCE/module_example.F90 b/src/OCE/module_example.F90
index 76a25caeb4c6be4e1ecf2535d3ab383e5a059f5c..0cfd06aef0d5d973fa503fe614a5b12af48228cb 100644
--- a/src/OCE/module_example.F90
+++ b/src/OCE/module_example.F90
@@ -16,6 +16,7 @@ MODULE exampl
!! exa_mpl_init : name of the module for a routine)
!! exa_mpl_stp : Please try to use 3 letter block for routine names
!!----------------------------------------------------------------------
+ USE par_kind
USE module_name1 ! brief description of the used module
USE module_name2 ! ....
diff --git a/src/OCE/oce.F90 b/src/OCE/oce.F90
index db45ce295f45f0577c01c50a9f84a48dd6cde58d..8047bad4dab58e195616bbbe27291e59d5c3f117 100644
--- a/src/OCE/oce.F90
+++ b/src/OCE/oce.F90
@@ -20,27 +20,29 @@ MODULE oce
!! dynamics and tracer fields
!! --------------------------
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uu , vv !: horizontal velocities [m/s]
+ REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uu , vv !: horizontal velocities [m/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ww !: vertical velocity [m/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wi !: vertical vel. (adaptive-implicit) [m/s]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv !: horizontal divergence [s-1]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: ts !: 4D T-S fields [Celsius,psu]
+ REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: ts !: 4D T-S fields [Celsius,psu]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: rab_b, rab_n !: thermal/haline expansion coef. [Celsius-1,psu-1]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rn2b , rn2 !: brunt-vaisala frequency**2 [s-2]
!
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhd !: in situ density anomalie rhd=(rho-rho0)/rho0 [no units]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhop !: potential volumic mass [kg/m3]
+ REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhop !: potential volumic mass [kg/m3]
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: Cu_adv !: vertical Courant number (adaptive-implicit)
!! free surface
!! ------------
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ssh, uu_b, vv_b !: SSH [m] and barotropic velocities [m/s]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssh_frc !: Forcing term in external mode for SSH [m/s]
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uu_b, vv_b!: SSH [m] and barotropic velocities [m/s]
+ REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ssh!: SSH [m] and barotropic velocities [m/s]
+ REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssh_frc !: Forcing term in external mode for SSH [m/s]
!! 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 , vb_e , vn_e , va_e !: v-external velocity
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshbb_e, sshb_e, sshn_e, ssha_e !: external ssh
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshbb_e, sshb_e!: external ssh
+ REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_e, ssha_e!: external ssh
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e !: external u-depth
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hv_e !: external v-depth
REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur_e !: inverse of u-depth
diff --git a/src/OCE/par_kind.F90 b/src/OCE/par_kind.F90
index 2a750c1645db739ef8333145d40e86cf25a2518e..9226b96f2ac9b4a2c5f839ee2cfbe2cc3831a0d6 100644
--- a/src/OCE/par_kind.F90
+++ b/src/OCE/par_kind.F90
@@ -30,7 +30,7 @@ MODULE par_kind
INTEGER, PUBLIC, PARAMETER :: i4 = SELECTED_INT_KIND( 9) !: single precision (integer 4)
INTEGER, PUBLIC, PARAMETER :: i8 = SELECTED_INT_KIND(14) !: double precision (integer 8)
- ! !!** Integer **
+ ! !!** Integer **
INTEGER, PUBLIC, PARAMETER :: lc = 256 !: Lenght of Character strings
INTEGER, PUBLIC, PARAMETER :: lca = 400 !: Lenght of Character arrays
diff --git a/src/OCE/single_precision_substitute.h90 b/src/OCE/single_precision_substitute.h90
new file mode 100644
index 0000000000000000000000000000000000000000..02e78ecb11e60e4ab596a382882f4bf55028e654
--- /dev/null
+++ b/src/OCE/single_precision_substitute.h90
@@ -0,0 +1,8 @@
+#if defined key_single
+# define CASTSP(x) REAL(x,sp)
+# define CASTDP(x) REAL(x,dp)
+#else
+# define CASTSP(x) x
+# define CASTDP(x) x
+#endif
+
diff --git a/src/OCE/stpctl.F90 b/src/OCE/stpctl.F90
index 96358bf94048c1bae16bd72d84b1f7cfb50e748d..a736dd7a90b173ec8c296dd32b2b9718af163d57 100644
--- a/src/OCE/stpctl.F90
+++ b/src/OCE/stpctl.F90
@@ -40,6 +40,8 @@ MODULE stpctl
!! $Id: stpctl.F90 15023 2021-06-18 14:35:25Z gsamson $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
+# include "single_precision_substitute.h90"
+# include "single_precision_substitute.h90"
CONTAINS
SUBROUTINE stp_ctl( kt, Kmm )
@@ -66,9 +68,9 @@ CONTAINS
INTEGER :: idtime, istatus
INTEGER , DIMENSION(jptst) :: iareasum, iareamin, iareamax
INTEGER , DIMENSION(3,jptst) :: iloc ! min/max loc indices
- REAL(wp) :: zzz, zminsal, zmaxsal ! local real
- REAL(wp), DIMENSION(jpvar+1) :: zmax
- REAL(wp), DIMENSION(jptst) :: zmaxlocal
+ REAL(dp) :: zzz, zminsal, zmaxsal ! local real
+ REAL(dp), DIMENSION(jpvar+1) :: zmax
+ REAL(dp), DIMENSION(jptst) :: zmaxlocal
LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce
LOGICAL, DIMENSION(jpi,jpj,jpk) :: llmsk
CHARACTER(len=20) :: clname
@@ -207,10 +209,10 @@ CONTAINS
llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0 ) == 1._wp ! define only the inner domain
CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:, Kmm)), llmsk(:,:,1), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F
llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain
- CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:, Kmm)), llmsk(:,:,:), zzz, iloc(1:3,2) )
+ CALL mpp_maxloc( 'stpctl', CASTDP(ABS( uu(:,:,:, Kmm))), llmsk(:,:,:), zzz, iloc(1:3,2) )
llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain
CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , llmsk(:,:,:), zzz, iloc(1:3,3) )
- CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , llmsk(:,:,:), zzz, iloc(1:3,4) )
+ CALL mpp_maxloc( 'stpctl', CASTDP(ts(:,:,:,jp_sal,Kmm)) , llmsk(:,:,:), zzz, iloc(1:3,4) )
! find which subdomain has the max.
iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0
DO ji = 1, jptst
@@ -237,10 +239,10 @@ CONTAINS
ENDIF
!
WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m or |U| > 10 m/s or S <= 0 or S >= 100 or NaN encounter in the tests'
- CALL wrt_line( ctmp2, kt, '|ssh| max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) )
- CALL wrt_line( ctmp3, kt, '|U| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) )
- CALL wrt_line( ctmp4, kt, 'Sal min', zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) )
- CALL wrt_line( ctmp5, kt, 'Sal max', zmax(4), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) )
+ CALL wrt_line( ctmp2, kt, '|ssh| max', CASTSP(zmax(1)), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) )
+ CALL wrt_line( ctmp3, kt, '|U| max', CASTSP(zmax(2)), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) )
+ CALL wrt_line( ctmp4, kt, 'Sal min', CASTSP(zmax(3)), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) )
+ CALL wrt_line( ctmp5, kt, 'Sal max', CASTSP(zmax(4)), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) )
IF( Agrif_Root() ) THEN
WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files'
ELSE
diff --git a/src/OCE/stpmlf.F90 b/src/OCE/stpmlf.F90
index f20dc3e5df907e2e9724e0540c40dc7eca52bd48..17e44e46e363fcce36bcb1fc77c5c85fdb6efa51 100644
--- a/src/OCE/stpmlf.F90
+++ b/src/OCE/stpmlf.F90
@@ -71,6 +71,7 @@ CONTAINS
#if defined key_agrif
RECURSIVE SUBROUTINE stp_MLF( )
INTEGER :: kstp ! ocean time-step index
+
#else
SUBROUTINE stp_MLF( kstp )
INTEGER, INTENT(in) :: kstp ! ocean time-step index
@@ -464,7 +465,6 @@ CONTAINS
!
END SUBROUTINE stp_MLF
-
SUBROUTINE mlf_baro_corr( Kmm, Kaa, puu, pvv )
!!----------------------------------------------------------------------
!! *** ROUTINE mlf_baro_corr ***
@@ -480,7 +480,7 @@ CONTAINS
USE dynspg_ts, ONLY : un_adv, vn_adv ! updated Kmm barotropic transport
!!
INTEGER , INTENT(in ) :: Kmm, Kaa ! before and after time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocities
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocities
!
INTEGER :: ji,jj, jk ! dummy loop indices
REAL(wp), DIMENSION(jpi,jpj) :: zue, zve
@@ -539,8 +539,8 @@ CONTAINS
!!
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kbb, Kaa ! before and after time level indices
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpt) , INTENT(inout) :: puu, pvv ! velocities to be time filtered
- REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpt) , INTENT(inout) :: puu, pvv ! velocities to be time filtered
+ REAL(dp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers
!!----------------------------------------------------------------------
!
! Update after tracer and velocity on domain lateral boundaries
@@ -550,8 +550,8 @@ CONTAINS
CALL Agrif_dyn( kt )
# endif
! ! local domain boundaries (T-point, unchanged sign)
- CALL lbc_lnk( 'finalize_lbc', puu(:,:,:, Kaa), 'U', -1._wp, pvv(:,:,: ,Kaa), 'V', -1._wp &
- & , pts(:,:,:,jp_tem,Kaa), 'T', 1._wp, pts(:,:,:,jp_sal,Kaa), 'T', 1._wp )
+ CALL lbc_lnk( 'finalize_lbc', puu(:,:,:, Kaa), 'U', -1._dp, pvv(:,:,: ,Kaa), 'V', -1._dp &
+ & , pts(:,:,:,jp_tem,Kaa), 'T', 1._dp, pts(:,:,:,jp_sal,Kaa), 'T', 1._dp )
!
! lbc_lnk needed for zdf_sh2 when using nn_hls = 2, moved here to allow tiling in zdf_phy
IF( nn_hls == 2 .AND. l_zdfsh2 ) CALL lbc_lnk( 'stp', avm_k, 'W', 1.0_wp )