New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 15057 – NEMO

Changeset 15057


Ignore:
Timestamp:
2021-06-25T09:43:49+02:00 (3 years ago)
Author:
smasson
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r14072 r15057  
    5252      INTEGER                             , INTENT(in), OPTIONAL ::   kdim 
    5353      ! 
    54       INTEGER :: itab2d_1, itab3d_1, itab4d_1, itab2d_2, itab3d_2 
    55       !! 
    56       IF( PRESENT(tab2d_1)  ) THEN ; itab2d_1 = is_tile(tab2d_1)  ; ELSE ; itab2d_1 = 0 ; ENDIF 
    57       IF( PRESENT(tab3d_1)  ) THEN ; itab3d_1 = is_tile(tab3d_1)  ; ELSE ; itab3d_1 = 0 ; ENDIF 
    58       IF( PRESENT(tab4d_1)  ) THEN ; itab4d_1 = is_tile(tab4d_1)  ; ELSE ; itab4d_1 = 0 ; ENDIF 
    59       IF( PRESENT(tab2d_2)  ) THEN ; itab2d_2 = is_tile(tab2d_2)  ; ELSE ; itab2d_2 = 0 ; ENDIF 
    60       IF( PRESENT(tab3d_2)  ) THEN ; itab3d_2 = is_tile(tab3d_2)  ; ELSE ; itab3d_2 = 0 ; ENDIF 
    61  
    62       CALL prt_ctl_t (tab2d_1, itab2d_1, tab3d_1, itab3d_1, tab4d_1, itab4d_1, tab2d_2, itab2d_2, tab3d_2, itab3d_2,  & 
    63       &               mask1, mask2, clinfo, clinfo1, clinfo2, clinfo3, kdim ) 
     54      IF(     PRESENT(tab2d_2) ) THEN 
     55         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,   & 
     56            &            tab2d_1 =    REAL(tab2d_1, 2*wp),                        tab2d_2 =    REAL(tab2d_2, 2*wp),           & 
     57            &           mask1 = mask1, mask2 = mask2, & 
     58            &           clinfo = clinfo, clinfo1 = clinfo1, clinfo2 = clinfo2, clinfo3 = clinfo3 ) 
     59      ELSEIF( PRESENT(tab3d_2) ) THEN      
     60         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),       & 
     61            &                          tab3d_1 = REAL(tab3d_1, 2*wp),                           tab3d_2 =    REAL(tab3d_2, 2*wp), & 
     62            &           mask1 = mask1, mask2 = mask2, & 
     63            &           clinfo = clinfo, clinfo1 = clinfo1, clinfo2 = clinfo2, clinfo3 = clinfo3 ) 
     64      ELSEIF( PRESENT(tab2d_1) ) THEN      
     65         CALL prt_ctl_t(ktab2d_1 = is_tile(tab2d_1), ktab3d_1 = 0, ktab4d_1 = 0, ktab2d_2 = 0, ktab3d_2 = 0,   & 
     66            &           tab2d_1 = REAL(tab2d_1,2*wp),  & 
     67            &           mask1 = mask1,  & 
     68            &           clinfo = clinfo, clinfo1 = clinfo1, clinfo3 = clinfo3 ) 
     69      ELSEIF( PRESENT(tab3d_1) ) THEN      
     70         CALL prt_ctl_t(ktab2d_1 = 0, ktab3d_1 = is_tile(tab3d_1), ktab4d_1 = 0, ktab2d_2 = 0, ktab3d_2 = 0,   & 
     71            &                          tab3d_1 =    REAL(tab3d_1, 2*wp),  & 
     72            &           mask1 = mask1,  & 
     73            &           clinfo = clinfo, clinfo1 = clinfo1, clinfo3 = clinfo3 ) 
     74      ELSEIF( PRESENT(tab4d_1) ) THEN      
     75         CALL prt_ctl_t(ktab2d_1 = 0, ktab3d_1 = 0, ktab4d_1 = is_tile(tab4d_1), ktab2d_2 = 0, ktab3d_2 = 0,   & 
     76            &                                        tab4d_1 =    REAL(tab4d_1, 2*wp),  & 
     77            &           mask1 = mask1,  & 
     78            &           clinfo = clinfo, clinfo1 = clinfo1, clinfo3 = clinfo3 ) 
     79      ENDIF 
     80 
    6481   END SUBROUTINE prt_ctl 
    6582 
    … …  
    103120      !!---------------------------------------------------------------------- 
    104121      INTEGER                             , INTENT(in)           ::   ktab2d_1, ktab3d_1, ktab4d_1, ktab2d_2, ktab3d_2 
    105       REAL(wp),         DIMENSION(A2D_T(ktab2d_1))    , INTENT(in), OPTIONAL ::   tab2d_1 
    106       REAL(wp),         DIMENSION(A2D_T(ktab3d_1),:)  , INTENT(in), OPTIONAL ::   tab3d_1 
    107       REAL(wp),         DIMENSION(A2D_T(ktab4d_1),:,:), INTENT(in), OPTIONAL ::   tab4d_1 
    108       REAL(wp),         DIMENSION(A2D_T(ktab2d_2))    , INTENT(in), OPTIONAL ::   tab2d_2 
    109       REAL(wp),         DIMENSION(A2D_T(ktab3d_2),:)  , INTENT(in), OPTIONAL ::   tab3d_2 
    110       REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask1 
    111       REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask2 
     122      REAL(2*wp),         DIMENSION(A2D_T(ktab2d_1))    , INTENT(in), OPTIONAL ::   tab2d_1 
     123      REAL(2*wp),         DIMENSION(A2D_T(ktab3d_1),:)  , INTENT(in), OPTIONAL ::   tab3d_1 
     124      REAL(2*wp),         DIMENSION(A2D_T(ktab4d_1),:,:), INTENT(in), OPTIONAL ::   tab4d_1 
     125      REAL(2*wp),         DIMENSION(A2D_T(ktab2d_2))    , INTENT(in), OPTIONAL ::   tab2d_2 
     126      REAL(2*wp),         DIMENSION(A2D_T(ktab3d_2),:)  , INTENT(in), OPTIONAL ::   tab3d_2 
     127      REAL(wp),           DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask1 
     128      REAL(wp),           DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask2 
    112129      CHARACTER(len=*), DIMENSION(:)      , INTENT(in), OPTIONAL ::   clinfo    ! information about the tab3d array 
    113130      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo1 
    … …  
    117134      ! 
    118135      CHARACTER(len=30) :: cl1, cl2 
     136      CHARACTER(len=6) :: clfmt 
    119137      INTEGER ::  jn, jl, kdir 
    120138      INTEGER ::  iis, iie, jjs, jje 
    121139      INTEGER ::  itra, inum 
    122       REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 
     140      REAL(2*wp) :: zsum1, zsum2, zvctl1, zvctl2 
    123141      !!---------------------------------------------------------------------- 
    124142      ! 
    … …  
    135153      IF( PRESENT(tab4d_1) )   itra = SIZE(tab4d_1,dim=4) 
    136154 
     155      IF( wp == sp )   clfmt = 'D23.16'   ! 16 significant numbers 
     156      IF( wp == dp )   clfmt = 'D41.34'   ! 34 significant numbers 
     157       
    137158      ! Loop over each sub-domain, i.e. the total number of processors ijsplt 
    138159      DO jl = 1, SIZE(nall_ictls) 
    … …  
    202223                  ! 
    203224                  IF( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN 
    204                      WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1 - zvctl1, cl2, zsum2 - zvctl2 
     225                     WRITE(inum, "(3x,a,' : ',"//clfmt//",3x,a,' : ',"//clfmt//")") cl1, zsum1 - zvctl1, cl2, zsum2 - zvctl2 
    205226                  ELSE 
    206                      WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 - zvctl1 
     227                     WRITE(inum, "(3x,a,' : ',"//clfmt//"                       )") cl1, zsum1 - zvctl1 
    207228                  ENDIF 
    208229                  ! 
    … …  
    220241                  END SELECT 
    221242               ELSEIF ( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN 
    222                   WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1, cl2, zsum2 
     243                  WRITE(inum, "(3x,a,' : ',"//clfmt//",3x,a,' : ',"//clfmt//")") cl1, zsum1, cl2, zsum2 
    223244               ELSE 
    224                   WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 
     245                  WRITE(inum, "(3x,a,' : ',"//clfmt//"                       )") cl1, zsum1 
    225246               ENDIF 
    226247 
Note: See TracChangeset for help on using the changeset viewer.