Changeset 15057 for NEMO

Timestamp:

2021-06-25T09:43:49+02:00 (3 years ago)

Author:

smasson

Message:

trunk: use 2*wp precision in prtctl, #2703

File:

• NEMO/trunk/src/OCE/IOM/prtctl.F90 (modified) (6 diffs)

NEMO/trunk/src/OCE/IOM/prtctl.F90

@@ -52 +52 @@
       INTEGER                             , INTENT(in), OPTIONAL ::   kdim
       !
-      INTEGER :: itab2d_1, itab3d_1, itab4d_1, itab2d_2, itab3d_2
-      !!
-      IF( PRESENT(tab2d_1)  ) THEN ; itab2d_1 = is_tile(tab2d_1)  ; ELSE ; itab2d_1 = 0 ; ENDIF
-      IF( PRESENT(tab3d_1)  ) THEN ; itab3d_1 = is_tile(tab3d_1)  ; ELSE ; itab3d_1 = 0 ; ENDIF
-      IF( PRESENT(tab4d_1)  ) THEN ; itab4d_1 = is_tile(tab4d_1)  ; ELSE ; itab4d_1 = 0 ; ENDIF
-      IF( PRESENT(tab2d_2)  ) THEN ; itab2d_2 = is_tile(tab2d_2)  ; ELSE ; itab2d_2 = 0 ; ENDIF
-      IF( PRESENT(tab3d_2)  ) THEN ; itab3d_2 = is_tile(tab3d_2)  ; ELSE ; itab3d_2 = 0 ; ENDIF
-
-      CALL prt_ctl_t (tab2d_1, itab2d_1, tab3d_1, itab3d_1, tab4d_1, itab4d_1, tab2d_2, itab2d_2, tab3d_2, itab3d_2,  &
-      &               mask1, mask2, clinfo, clinfo1, clinfo2, clinfo3, kdim )
+      IF(     PRESENT(tab2d_2) ) THEN
+         CALL prt_ctl_t(ktab2d_1 = is_tile(tab2d_1), ktab3d_1 = 0, ktab4d_1 = 0, ktab2d_2 = is_tile(tab2d_2), ktab3d_2 = 0,   &
+            &            tab2d_1 =    REAL(tab2d_1, 2*wp),                        tab2d_2 =    REAL(tab2d_2, 2*wp),           &
+            &           mask1 = mask1, mask2 = mask2, &
+            &           clinfo = clinfo, clinfo1 = clinfo1, clinfo2 = clinfo2, clinfo3 = clinfo3 )
+      ELSEIF( PRESENT(tab3d_2) ) THEN     
+         CALL prt_ctl_t(ktab2d_1 = 0, ktab3d_1 = is_tile(tab3d_1), ktab4d_1 = 0, ktab2d_2 = 0, ktab3d_2 = is_tile(tab3d_2),       &
+            &                          tab3d_1 = REAL(tab3d_1, 2*wp),                           tab3d_2 =    REAL(tab3d_2, 2*wp), &
+            &           mask1 = mask1, mask2 = mask2, &
+            &           clinfo = clinfo, clinfo1 = clinfo1, clinfo2 = clinfo2, clinfo3 = clinfo3 )
+      ELSEIF( PRESENT(tab2d_1) ) THEN     
+         CALL prt_ctl_t(ktab2d_1 = is_tile(tab2d_1), ktab3d_1 = 0, ktab4d_1 = 0, ktab2d_2 = 0, ktab3d_2 = 0,   &
+            &           tab2d_1 = REAL(tab2d_1,2*wp),  &
+            &           mask1 = mask1,  &
+            &           clinfo = clinfo, clinfo1 = clinfo1, clinfo3 = clinfo3 )
+      ELSEIF( PRESENT(tab3d_1) ) THEN     
+         CALL prt_ctl_t(ktab2d_1 = 0, ktab3d_1 = is_tile(tab3d_1), ktab4d_1 = 0, ktab2d_2 = 0, ktab3d_2 = 0,   &
+            &                          tab3d_1 =    REAL(tab3d_1, 2*wp),  &
+            &           mask1 = mask1,  &
+            &           clinfo = clinfo, clinfo1 = clinfo1, clinfo3 = clinfo3 )
+      ELSEIF( PRESENT(tab4d_1) ) THEN     
+         CALL prt_ctl_t(ktab2d_1 = 0, ktab3d_1 = 0, ktab4d_1 = is_tile(tab4d_1), ktab2d_2 = 0, ktab3d_2 = 0,   &
+            &                                        tab4d_1 =    REAL(tab4d_1, 2*wp),  &
+            &           mask1 = mask1,  &
+            &           clinfo = clinfo, clinfo1 = clinfo1, clinfo3 = clinfo3 )
+      ENDIF
+
    END SUBROUTINE prt_ctl
 
@@ -103 +120 @@
       !!----------------------------------------------------------------------
       INTEGER                             , INTENT(in)           ::   ktab2d_1, ktab3d_1, ktab4d_1, ktab2d_2, ktab3d_2
-      REAL(wp),         DIMENSION(A2D_T(ktab2d_1))    , INTENT(in), OPTIONAL ::   tab2d_1
-      REAL(wp),         DIMENSION(A2D_T(ktab3d_1),:)  , INTENT(in), OPTIONAL ::   tab3d_1
-      REAL(wp),         DIMENSION(A2D_T(ktab4d_1),:,:), INTENT(in), OPTIONAL ::   tab4d_1
-      REAL(wp),         DIMENSION(A2D_T(ktab2d_2))    , INTENT(in), OPTIONAL ::   tab2d_2
-      REAL(wp),         DIMENSION(A2D_T(ktab3d_2),:)  , INTENT(in), OPTIONAL ::   tab3d_2
-      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask1
-      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask2
+      REAL(2*wp),         DIMENSION(A2D_T(ktab2d_1))    , INTENT(in), OPTIONAL ::   tab2d_1
+      REAL(2*wp),         DIMENSION(A2D_T(ktab3d_1),:)  , INTENT(in), OPTIONAL ::   tab3d_1
+      REAL(2*wp),         DIMENSION(A2D_T(ktab4d_1),:,:), INTENT(in), OPTIONAL ::   tab4d_1
+      REAL(2*wp),         DIMENSION(A2D_T(ktab2d_2))    , INTENT(in), OPTIONAL ::   tab2d_2
+      REAL(2*wp),         DIMENSION(A2D_T(ktab3d_2),:)  , INTENT(in), OPTIONAL ::   tab3d_2
+      REAL(wp),           DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask1
+      REAL(wp),           DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask2
       CHARACTER(len=*), DIMENSION(:)      , INTENT(in), OPTIONAL ::   clinfo    ! information about the tab3d array
       CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo1
@@ -117 +134 @@
       !
       CHARACTER(len=30) :: cl1, cl2
+      CHARACTER(len=6) :: clfmt
       INTEGER ::  jn, jl, kdir
       INTEGER ::  iis, iie, jjs, jje
       INTEGER ::  itra, inum
-      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2
+      REAL(2*wp) :: zsum1, zsum2, zvctl1, zvctl2
       !!----------------------------------------------------------------------
       !
@@ -135 +153 @@
       IF( PRESENT(tab4d_1) )   itra = SIZE(tab4d_1,dim=4)
 
+      IF( wp == sp )   clfmt = 'D23.16'   ! 16 significant numbers
+      IF( wp == dp )   clfmt = 'D41.34'   ! 34 significant numbers
+      
       ! Loop over each sub-domain, i.e. the total number of processors ijsplt
       DO jl = 1, SIZE(nall_ictls)
@@ -202 +223 @@
                   !
                   IF( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN
-                     WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1 - zvctl1, cl2, zsum2 - zvctl2
+                     WRITE(inum, "(3x,a,' : ',"//clfmt//",3x,a,' : ',"//clfmt//")") cl1, zsum1 - zvctl1, cl2, zsum2 - zvctl2
                   ELSE
-                     WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 - zvctl1
+                     WRITE(inum, "(3x,a,' : ',"//clfmt//"                       )") cl1, zsum1 - zvctl1
                   ENDIF
                   !
@@ -220 +241 @@
                   END SELECT
                ELSEIF ( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN
-                  WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1, cl2, zsum2
+                  WRITE(inum, "(3x,a,' : ',"//clfmt//",3x,a,' : ',"//clfmt//")") cl1, zsum1, cl2, zsum2
                ELSE
-                  WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1
+                  WRITE(inum, "(3x,a,' : ',"//clfmt//"                       )") cl1, zsum1
                ENDIF