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

NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/CRS/crsini.F90

@@ -30 +30 @@
    !! * Substitutions
 #  include "domzgr_substitute.h90"
+#  include "single_precision_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -127 +128 @@
      !      
      IF ( nresty /= 0 .AND. nrestx /= 0 ) THEN
-        CALL crs_dom_coordinates( gphit, glamt, 'T', gphit_crs, glamt_crs ) 
+        CALL crs_dom_coordinates( CASTWP(gphit), CASTWP(glamt), 'T', gphit_crs, glamt_crs ) 
         CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )       
         CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs ) 
-        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs ) 
+        CALL crs_dom_coordinates( CASTWP(gphif), CASTWP(glamf), 'F', gphif_crs, glamf_crs ) 
      ELSEIF ( nresty /= 0 .AND. nrestx == 0 ) THEN
         CALL crs_dom_coordinates( gphiu, glamu, 'T', gphit_crs, glamt_crs )
         CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )
-        CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
-        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+        CALL crs_dom_coordinates( CASTWP(gphif), CASTWP(glamf), 'V', gphiv_crs, glamv_crs )
+        CALL crs_dom_coordinates( CASTWP(gphif), CASTWP(glamf), 'F', gphif_crs, glamf_crs )
      ELSEIF ( nresty == 0 .AND. nrestx /= 0 ) THEN
         CALL crs_dom_coordinates( gphiv, glamv, 'T', gphit_crs, glamt_crs )
-        CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
+        CALL crs_dom_coordinates( CASTWP(gphif), CASTWP(glamf), 'U', gphiu_crs, glamu_crs )
         CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs )
-        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+        CALL crs_dom_coordinates( CASTWP(gphif), CASTWP(glamf), 'F', gphif_crs, glamf_crs )
      ELSE 
-        CALL crs_dom_coordinates( gphif, glamf, 'T', gphit_crs, glamt_crs )
-        CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
-        CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
-        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+        CALL crs_dom_coordinates(CASTWP(gphif),CASTWP(glamf), 'T', gphit_crs, glamt_crs )
+        CALL crs_dom_coordinates(CASTWP(gphif),CASTWP(glamf), 'U', gphiu_crs, glamu_crs )
+        CALL crs_dom_coordinates(CASTWP(gphif),CASTWP(glamf), 'V', gphiv_crs, glamv_crs )
+        CALL crs_dom_coordinates(CASTWP(gphif),CASTWP(glamf), 'F', gphif_crs, glamf_crs )
      ENDIF
 
@@ -153 +154 @@
      !      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( e1f, e2f, 'F', e1f_crs, e2f_crs )
+     CALL crs_dom_hgr( CASTWP(e1t), CASTWP(e2t), 'T', e1t_crs, e2t_crs )
+     CALL crs_dom_hgr( CASTWP(e1u), e2u, 'U', e1u_crs, e2u_crs )
+     CALL crs_dom_hgr( e1v, CASTWP(e2v), 'V', e1v_crs, e2v_crs )
+     CALL crs_dom_hgr( CASTWP(e1f), CASTWP(e2f), 'F', e1f_crs, e2f_crs )
 
      e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:)
@@ -184 +185 @@
 
      !    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=CASTWP(e1t), p_e2=CASTWP(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 +194 @@
      !    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( e1t, e2t, ze3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)
+     CALL crs_dom_e3( CASTWP(e1t), CASTWP(e2t), ze3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs)
+     CALL crs_dom_e3( CASTWP(e1u), e2u, ze3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs)
+     CALL crs_dom_e3( e1v, CASTWP(e2v), ze3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)
+     CALL crs_dom_e3( CASTWP(e1t), CASTWP(e2t), ze3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)
 
      ! Replace 0 by e3t_0 or e3w_0
@@ -219 +220 @@
      !---------------------------------------------------------
      ! 4.a. Ocean volume or area unmasked and masked
-     CALL crs_dom_facvol( tmask, 'T', e1t, e2t, ze3t, ocean_volume_crs_t, facvol_t )
+     CALL crs_dom_facvol( tmask, 'T', CASTWP(e1t), CASTWP(e2t), ze3t, ocean_volume_crs_t, facvol_t )
      !
      bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:)
@@ -226 +227 @@
      WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:)
 
-     CALL crs_dom_facvol( tmask, 'W', e1t, e2t, ze3w, ocean_volume_crs_w, facvol_w )
+     CALL crs_dom_facvol( tmask, 'W', CASTWP(e1t), CASTWP(e2t), ze3w, ocean_volume_crs_w, facvol_w )
      !
      !---------------------------------------------------------