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 12270 – NEMO

Changeset 12270


Ignore:
Timestamp:
2019-12-18T13:41:43+01:00 (4 years ago)
Author:
mathiot
Message:

fix bugs in isfutils debug subroutines found during icb reproducibility test

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/ISF/isfutils.F90

    r12169 r12270  
    1212   !!---------------------------------------------------------------------- 
    1313 
    14    USE iom           , ONLY: iom_open, iom_get, iom_close, jpdom_data ! read input file 
    15    USE lib_fortran   , ONLY: glob_sum, glob_min, glob_max             ! compute global value 
    16    USE par_oce       , ONLY: jpi,jpj,jpk                              ! domain size 
    17    USE dom_oce       , ONLY: nldi, nlei, nldj, nlej                  ! local domain 
    18    USE in_out_manager, ONLY: i8, wp, lwp, numout                          ! miscelenious 
     14   USE iom           , ONLY: iom_open, iom_get, iom_close, jpdom_data        ! read input file 
     15   USE lib_fortran   , ONLY: glob_sum, glob_min, glob_max                    ! compute global value 
     16   USE par_oce       , ONLY: jpi,jpj,jpk, jpnij                              ! domain size 
     17   USE dom_oce       , ONLY: nldi, nlei, nldj, nlej, narea, tmask_h, tmask_i ! local domain 
     18   USE in_out_manager, ONLY: i8, wp, lwp, numout                             ! miscelenious 
    1919   USE lib_mpp 
    2020 
     
    3838      !! 
    3939      !!-------------------------- OUT ------------------------------------- 
    40       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pvar          ! output variable 
     40      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pvar     ! output variable 
    4141      !!-------------------------- IN  ------------------------------------- 
    42       CHARACTER(len=*)          , INTENT(in   ) :: cdfile   ! input file name 
    43       CHARACTER(len=*)           , INTENT(in   ) :: cdvar    ! variable name 
     42      CHARACTER(len=*)            , INTENT(in   ) :: cdfile   ! input file name 
     43      CHARACTER(len=*)            , INTENT(in   ) :: cdvar    ! variable name 
    4444      !!-------------------------------------------------------------------- 
    4545      INTEGER :: inum 
     
    5959      !! 
    6060      !!-------------------------- IN  ------------------------------------- 
    61       CHARACTER(LEN=*)          , INTENT(in   ) :: cdtxt 
     61      CHARACTER(LEN=*)            , INTENT(in   ) :: cdtxt 
    6262      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pvar 
    6363      !!-------------------------------------------------------------------- 
    6464      REAL(wp)    :: zmin, zmax, zsum 
    6565      INTEGER(i8) :: imodd, ip 
    66       INTEGER     :: itmps,imods, ji, jj, jk 
     66      INTEGER     :: imods 
     67      INTEGER     :: isums, idums 
     68      INTEGER     :: ji,jj,jk 
     69      INTEGER, DIMENSION(jpnij) :: itmps 
    6770      !!-------------------------------------------------------------------- 
    6871      ! 
     
    7881      imodd=65521 ! highest prime number < 2**16 with i8 type 
    7982      imods=65521 ! highest prime number < 2**16 with default integer for mpp_sum subroutine 
    80       itmps=0 
     83      isums=0 ; itmps(:)=0 ; 
     84      ! 
     85      ! local MOD sum 
    8186      DO jj=nldj,nlej 
    8287         DO ji=nldi,nlei 
    83             itmps = MOD(itmps + MOD(TRANSFER(pvar(ji,jj), ip),imodd), imods) 
     88            idums = ABS(MOD(TRANSFER(pvar(ji,jj), ip),imodd)) 
     89            itmps(narea) = MOD(itmps(narea) + idums, imods) 
    8490         END DO 
    8591      END DO 
    86       CALL mpp_sum('debug',itmps) 
     92      ! 
     93      ! global MOD sum 
     94      CALL mpp_max('debug',itmps(:)) 
     95      DO jk = 1,jpnij 
     96         isums = MOD(isums + itmps(jk),imods) 
     97      END DO 
    8798      ! 
    8899      ! print out 
    89100      IF (lwp) THEN 
    90          WRITE(numout,*) TRIM(cdtxt),' (min, max, sum, tag) : ',zmin, zmax, zsum, itmps 
     101         WRITE(numout,*) TRIM(cdtxt),' (min, max, sum, tag) : ',zmin, zmax, zsum, isums 
    91102         CALL FLUSH(numout) 
    92103      END IF 
     
    101112      !! 
    102113      !!-------------------------- IN  ------------------------------------- 
    103       CHARACTER(LEN=*)              , INTENT(in   ) :: cdtxt 
     114      CHARACTER(LEN=*)                , INTENT(in   ) :: cdtxt 
    104115      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pvar 
    105116      !!-------------------------------------------------------------------- 
    106       REAL(wp) :: zmin, zmax, zsum 
     117      REAL(wp)    :: zmin, zmax, zsum 
    107118      INTEGER(i8) :: imodd, ip 
    108       INTEGER     :: itmps,imods, ji, jj, jk 
     119      INTEGER     :: imods 
     120      INTEGER     :: isums, idums 
     121      INTEGER     :: ji,jj,jk 
     122      INTEGER, DIMENSION(jpnij) :: itmps 
    109123      !!-------------------------------------------------------------------- 
    110124      ! 
     
    120134      imodd=65521 ! highest prime number < 2**16 with i8 type 
    121135      imods=65521 ! highest prime number < 2**16 with default integer for mpp_sum subroutine 
    122       itmps=0 
     136      itmps=0; isums=0 
     137      ! 
     138      ! local MOD sum 
    123139      DO jk=1,jpk 
    124140         DO jj=nldj,nlej 
    125141            DO ji=nldi,nlei 
    126                itmps = MOD(itmps + MOD(TRANSFER(pvar(ji,jj,jk), ip),imodd), imods) 
     142               idums = ABS(MOD(TRANSFER(pvar(ji,jj,jk), ip),imodd)) 
     143               itmps(narea) = MOD(itmps(narea) + idums, imods) 
    127144            END DO 
    128145         END DO 
    129146      END DO 
    130       CALL mpp_sum('debug',itmps) 
     147      ! 
     148      ! global MOD sum 
     149      CALL mpp_max('debug',itmps) 
     150      DO jk = 1,jpnij 
     151         isums = MOD(isums+itmps(jk),imods) 
     152      END DO 
    131153      ! 
    132154      ! print out 
    133155      IF (lwp) THEN 
    134          WRITE(numout,*) TRIM(cdtxt),' (min, max, sum, tag) : ',zmin, zmax, zsum, itmps 
     156         WRITE(numout,*) TRIM(cdtxt),' (min, max, sum, tag) : ',zmin, zmax, zsum, isums 
    135157         CALL FLUSH(numout) 
    136158      END IF 
Note: See TracChangeset for help on using the changeset viewer.