Changeset 14219 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traatf.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/TRA/traatf.F90 (modified) (8 diffs)

NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traatf.F90

@@ -59 +59 @@
 #  include "do_loop_substitute.h90"
 #  include "domzgr_substitute.h90"
+#  include "single_precision_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -89 +90 @@
       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
@@ -152 +153 @@
       ELSE                                            ! Leap-Frog + Asselin filter time stepping
          !
-         IF( ln_linssh ) THEN   ;   CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nit000,        'TRA', pts, jpts )  ! linear free surface
-         ELSE                   ;   CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nit000, rn_Dt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface
+         IF( ln_linssh ) THEN   ;   CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nit000,        'TRA', pts, jpts )  ! linear free surface 
+         ELSE                   ;   CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nit000, CASTWP(rn_Dt), 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface
          ENDIF
          !
@@ -171 +172 @@
       !
       !                        ! control print
-      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kmm), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
-         &                                  tab3d_2=pts(:,:,:,jp_sal,Kmm), clinfo2=       ' Sn: ', mask2=tmask )
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Kmm)), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
+         &                                  tab3d_2=CASTWP(pts(:,:,:,jp_sal,Kmm)), clinfo2=       ' Sn: ', mask2=tmask )
       !
       IF( ln_timing )   CALL timing_stop('tra_atf')
@@ -194 +195 @@
       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
@@ -238 +239 @@
       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
@@ -244 +245 @@
       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, ze3t_d, zscale  !   -      -
+      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, ze3t_d, zscale  !   -      -
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrd_atf
       !!----------------------------------------------------------------------
@@ -384 +385 @@
    !!======================================================================
 END MODULE traatf
+