Changeset 12546 for NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/CRS/crsdom.F90

Timestamp:

2020-03-13T11:06:44+01:00 (4 years ago)

Author:

orioltp

Message:

Adding precision specification in hardcoded reals and other modifications to allow compilation without forcing reals without precision specification to a certain value through compiler flags

File:

• NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/CRS/crsdom.F90 (modified) (10 diffs)

NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/CRS/crsdom.F90

@@ -86 +86 @@
             zmask = 0.0
             zmask = SUM( tmask(ijis:ijie,ij:je_2,jk) ) 
-            IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0
+            IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0_wp
                
             zmask = 0.0
             zmask = SUM( vmask(ijis:ijie,je_2     ,jk) )  
-            IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0
+            IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0_wp
                
             zmask = 0.0
             zmask = SUM(umask(ijie,ij:je_2,jk))   
-            IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0
+            IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0_wp
                
             fmask_crs(ji,je_2,jk) = fmask(ijie,2,jk)
@@ -108 +108 @@
                zmask = 0.0
                zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) ) 
-               IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0
+               IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0_wp
                
                zmask = 0.0
                zmask = SUM( vmask(ijis:ijie,ijje     ,jk) )  
-               IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0
+               IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0_wp
                
                zmask = 0.0
                zmask = SUM( umask(ijie     ,ijjs:ijje,jk) )  
-               IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0
+               IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0_wp
                
                fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk)  
@@ -124 +124 @@
 
       !
-      CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 )
-      CALL crs_lbc_lnk( vmask_crs, 'V', 1.0 )
-      CALL crs_lbc_lnk( umask_crs, 'U', 1.0 )
-      CALL crs_lbc_lnk( fmask_crs, 'F', 1.0 )
+      CALL crs_lbc_lnk( tmask_crs, 'T', 1.0_wp )
+      CALL crs_lbc_lnk( vmask_crs, 'V', 1.0_wp )
+      CALL crs_lbc_lnk( umask_crs, 'U', 1.0_wp )
+      CALL crs_lbc_lnk( fmask_crs, 'F', 1.0_wp )
       !
    END SUBROUTINE crs_dom_msk
@@ -206 +206 @@
 
       ! Retroactively add back the boundary halo cells.
-      CALL crs_lbc_lnk( p_gphi_crs, cd_type, 1.0 )
-      CALL crs_lbc_lnk( p_glam_crs, cd_type, 1.0 )
+      CALL crs_lbc_lnk( p_gphi_crs, cd_type, 1.0_wp )
+      CALL crs_lbc_lnk( p_glam_crs, cd_type, 1.0_wp )
          
       ! Fill up jrow=1 which is zeroed out or not handled by lbc_lnk and lbc_nfd
@@ -296 +296 @@
       ENDDO
 
-      CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0, pfillval=1.0 )
-      CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0, pfillval=1.0 )
+      CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0_wp, pfillval=1.0_wp )
+      CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0_wp, pfillval=1.0_wp )
 
    END SUBROUTINE crs_dom_hgr
@@ -440 +440 @@
       ENDDO
       !                                             !  Retroactively add back the boundary halo cells.
-      CALL crs_lbc_lnk( p_fld1_crs, cd_type, 1.0 ) 
-      CALL crs_lbc_lnk( p_fld2_crs, cd_type, 1.0 ) 
+      CALL crs_lbc_lnk( p_fld1_crs, cd_type, 1.0_wp ) 
+      CALL crs_lbc_lnk( p_fld2_crs, cd_type, 1.0_wp ) 
       !
       !
@@ -1748 +1748 @@
        ENDDO
                   
-       CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0, pfillval=1.0 )  
-       CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pfillval=1.0 )  
+       CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0_wp, pfillval=1.0_wp )  
+       CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0_wp, pfillval=1.0_wp )  
        !              
        !
@@ -1857 +1857 @@
       ENDDO   
 
-      CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0, pfillval=1.0 )
-      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pfillval=1.0 )
+      CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0_wp, pfillval=1.0_wp )
+      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0_wp, pfillval=1.0_wp )
 
    END SUBROUTINE crs_dom_sfc
@@ -2246 +2246 @@
      
       zmbk(:,:) = 0.0
-      zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ;   CALL crs_lbc_lnk(zmbk,'T',1.0)   ;   mbathy_crs(:,:) = NINT( zmbk(:,:) )
+      zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ;   CALL crs_lbc_lnk(zmbk,'T',1.0_wp)   ;   mbathy_crs(:,:) = NINT( zmbk(:,:) )
 
 
@@ -2266 +2266 @@
       ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
       zmbk(:,:) = 1.e0;    
-      zmbk(:,:) = REAL( mbku_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'U',1.0) ; mbku_crs  (:,:) = MAX( NINT( zmbk(:,:) ), 1 ) 
-      zmbk(:,:) = REAL( mbkv_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'V',1.0) ; mbkv_crs  (:,:) = MAX( NINT( zmbk(:,:) ), 1 ) 
+      zmbk(:,:) = REAL( mbku_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'U',1.0_wp) ; mbku_crs  (:,:) = MAX( NINT( zmbk(:,:) ), 1 ) 
+      zmbk(:,:) = REAL( mbkv_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'V',1.0_wp) ; mbkv_crs  (:,:) = MAX( NINT( zmbk(:,:) ), 1 ) 
       !
    END SUBROUTINE crs_dom_bat