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

NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/IOM/iom.F90

@@ -98 +98 @@
    !! * Substitutions
 #  include "do_loop_substitute.h90"
+#  include "single_precision_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -169 +170 @@
       IF(.NOT.llrst_context) CALL set_scalar
       !
-      IF( cdname == cxios_context ) THEN
-         CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. )
+      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN  
+         CALL set_grid( "T", CASTWP(glamt), CASTWP(gphit), .FALSE., .FALSE. )
          CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. )
          CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. )
-         CALL set_grid( "W", glamt, gphit, .FALSE., .FALSE. )
-         CALL set_grid( "F", glamf, gphif, .FALSE., .FALSE. )
-         CALL set_grid_znl( gphit )
+         CALL set_grid( "W", CASTWP(glamt), CASTWP(gphit), .FALSE., .FALSE. )
+         CALL set_grid( "F", CASTWP(glamf), CASTWP(gphif), .FALSE., .FALSE. )
+         CALL set_grid_znl( CASTWP(gphit) )
          !
          IF( ln_cfmeta ) THEN   ! Add additional grid metadata
@@ -181 +182 @@
             CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp))
             CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp))
-            CALL iom_set_domain_attr("grid_W", area = REAL( e1e2t(Nis0:Nie0, Njs0:Nje0), dp))
+            CALL iom_set_domain_attr("grid_W", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp))
             CALL iom_set_domain_attr("grid_F", area = real( e1e2f(Nis0:Nie0, Njs0:Nje0), dp))
-            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
+            CALL set_grid_bounds( "T", CASTWP(glamf), CASTWP(gphif), CASTWP(glamt), CASTWP(gphit) )
             CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
             CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv )
-            CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit )
-            CALL set_grid_bounds( "F", glamt, gphit, glamf, gphif )
+            CALL set_grid_bounds( "W", CASTWP(glamf), CASTWP(gphif), CASTWP(glamt), CASTWP(gphit) )
+            CALL set_grid_bounds( "F", CASTWP(glamt), CASTWP(gphit), CASTWP(glamf), CASTWP(gphif) )
          ENDIF
       ENDIF
@@ -603 +604 @@
       CALL xios_get_handle("domain_definition",domaingroup_hdl)
       CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N")
-      CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr)
+      CALL set_grid("N", CASTWP(glamt), CASTWP(gphit), .TRUE., ld_rstr)
 
       CALL xios_get_handle("axis_definition",axisgroup_hdl)
@@ -1060 +1061 @@
       INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
       CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
-      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold
+      REAL(wp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold
       INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
       INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading
@@ -1084 +1085 @@
       INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
       CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
-      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold
+      REAL(wp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold
       INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
       INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading
@@ -1104 +1105 @@
       INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
       CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
-      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold
+      REAL(wp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold
       INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
       INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading
@@ -1128 +1129 @@
       INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
       CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
-      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold
+      REAL(wp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold
       INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
       INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading
@@ -1161 +1162 @@
       INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime     ! record number
       CHARACTER(len=1)           , INTENT(in   ), OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
-      REAL(dp)                   , INTENT(in   ), OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold
+      REAL(wp)                   , INTENT(in   ), OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold
       INTEGER                    , INTENT(in   ), OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
       INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart    ! start position of the reading in each axis
@@ -2664 +2665 @@
       !! ** 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
@@ -2671 +2672 @@
       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
       !!----------------------------------------------------------------------