Changeset 14219 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynatf.F90

Timestamp:

2020-12-18T18:52:57+01:00 (4 years ago)

Author:

mcastril

Message:

Add Mixed Precision support by Oriol Tintó

File:

• NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynatf.F90 (modified) (9 diffs)

NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynatf.F90

@@ -60 +60 @@
    PUBLIC    dyn_atf   ! routine called by step.F90
 
+#  include "single_precision_substitute.h90"
 #if defined key_qco   ||   defined key_linssh
    !!----------------------------------------------------------------------
@@ -71 +72 @@
       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(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3t, pe3u, pe3v ! scale factors to be time filtered
+      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv         ! velocities to be time filtered
+      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3t
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3u, pe3v ! scale factors to be time filtered
 
       WRITE(*,*) 'dyn_atf: You should not have seen this print! error?', kt
@@ -116 +118 @@
       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(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3t, pe3u, pe3v ! scale factors to be time filtered
+      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv         ! velocities to be time filtered
+      REAL(dp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3t
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3u, pe3v ! scale factors to be time filtered
       !
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zue3a, zue3n, zue3b, zcoef    ! local scalars
+      REAL(dp)  :: zcoef
+      REAL(wp) ::   zue3a, zue3n, zue3b    ! local scalars
       REAL(wp) ::   zve3a, zve3n, zve3b, z1_2dt   !   -      -
       REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zue, zve, zwfld
       REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zutau, zvtau
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3t_f, ze3u_f, ze3v_f, zua, zva
+      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3t_f
+      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) ::   zua, zva
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3u_f, ze3v_f 
       !!----------------------------------------------------------------------
       !
@@ -229 +235 @@
             !     to manage rnf, isf and possibly in the futur icb, tide water glacier (...)
             !     ...(kt, coef, ktop, kbot, hz, fwf_b, fwf)
-            IF ( ln_isf ) CALL isf_dynatf( kt, Kmm, ze3t_f, rn_atfp * rn_Dt )
+            IF ( ln_isf ) CALL isf_dynatf( kt, Kmm, ze3t_f, CASTWP(rn_atfp * rn_Dt) )
             !
             pe3t(:,:,1:jpkm1,Kmm) = ze3t_f(:,:,1:jpkm1)        ! filtered scale factor at T-points
@@ -235 +241 @@
             IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity
                ! Before filtered scale factor at (u/v)-points
-               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3u(:,:,:,Kmm), 'U' )
-               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3v(:,:,:,Kmm), 'V' )
+               CALL dom_vvl_interpol( CASTWP(pe3t(:,:,:,Kmm)), pe3u(:,:,:,Kmm), 'U' )
+               CALL dom_vvl_interpol( CASTWP(pe3t(:,:,:,Kmm)), pe3v(:,:,:,Kmm), 'V' )
                DO_3D( 1, 1, 1, 1, 1, jpkm1 )
                   puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) )
@@ -246 +252 @@
                ALLOCATE( ze3u_f(jpi,jpj,jpk) , ze3v_f(jpi,jpj,jpk) )
                ! Now filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f
-               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3u_f, 'U' )
-               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3v_f, 'V' )
+               CALL dom_vvl_interpol( CASTWP(pe3t(:,:,:,Kmm)), ze3u_f, 'U' )
+               CALL dom_vvl_interpol( CASTWP(pe3t(:,:,:,Kmm)), ze3v_f, 'V' )
                DO_3D( 1, 1, 1, 1, 1, jpkm1 )
                   zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa)
@@ -328 +334 @@
          IF ( ln_drgice_imp.OR.ln_isfcav ) THEN
             ALLOCATE(zutau(jpi,jpj))
+            zutau(:,:) = 0._wp
             DO_2D( 0, 0, 0, 0 )
                jk = miku(ji,jj)
@@ -342 +349 @@
          IF ( ln_drgice_imp.OR.ln_isfcav ) THEN
             ALLOCATE(zvtau(jpi,jpj))
+            zvtau(:,:) = 0._wp
             DO_2D( 0, 0, 0, 0 )
                jk = mikv(ji,jj)
@@ -353 +361 @@
       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=CASTWP(puu(:,:,:,Kaa)), clinfo1=' nxt  - puu(:,:,:,Kaa): ', mask1=umask,   &
+         &                                  tab3d_2=CASTWP(pvv(:,:,:,Kaa)), clinfo2=' pvv(:,:,:,Kaa): '       , mask2=vmask )
+      ! 
       IF( ln_dynspg_ts )   DEALLOCATE( zue, zve )
       IF( l_trddyn     )   DEALLOCATE( zua, zva )