Ignore:
Timestamp:
2020-05-01T10:58:58+02:00 (9 months ago)
Author:
smasson
Message:

r12581_ticket2418: improve stpctl error messages and release the max of 9999 MPI tasks in files names, see #2418

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/r12581_ticket2418/src/OCE/stpctl.F90

    r12685 r12840  
    6464      INTEGER                         ::   ji                                    ! dummy loop indices 
    6565      INTEGER                         ::   idtime, istatus 
    66       INTEGER, DIMENSION(3,4)         ::   iloc                                  ! min/max loc indices 
     66      INTEGER , DIMENSION(9)          ::   iareasum, iareamin, iareamax 
     67      INTEGER , DIMENSION(3,4)        ::   iloc                                  ! min/max loc indices 
    6768      REAL(wp)                        ::   zzz                                   ! local real  
    68       REAL(wp), DIMENSION(9)          ::   zmax, zmaxlocal, zarea 
     69      REAL(wp), DIMENSION(9)          ::   zmax, zmaxlocal 
    6970      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns 
    7071      LOGICAL, DIMENSION(jpi,jpj,jpk) ::   llmsk 
     
    176177         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) THEN   ! NaN encounter in the tests 
    177178         ! 
     179         iloc(:,:) = 0 
    178180         IF( ll_colruns ) THEN   ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 
    179181            ! first: close the netcdf file, so we can read it 
     
    185187            CALL mpp_maxloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) ,  tmask(:,:,:), zzz, iloc(1:3,4) ) 
    186188            ! find which subdomain has the max. 
    187             zarea(:) = 0._wp 
     189            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
    188190            DO ji = 1, 9 
    189                IF( zmaxlocal(ji) == zmax(ji) )   zarea(ji) = narea  
     191               IF( zmaxlocal(ji) == zmax(ji) ) THEN 
     192                  iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1 
     193               ENDIF 
    190194            END DO 
    191             CALL mpp_max( "stpctl", zarea )         ! max over the global domain 
     195            CALL mpp_min( "stpctl", iareamin )         ! min over the global domain 
     196            CALL mpp_max( "stpctl", iareamax )         ! max over the global domain 
     197            CALL mpp_sum( "stpctl", iareasum )         ! sum over the global domain 
    192198         ELSE                    ! find local min and max locations: 
    193199            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
     
    196202            iloc(1:3,3) = MINLOC(       ts(:,:,:,jp_sal,Kmm) , mask =  tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    197203            iloc(1:3,4) = MAXLOC(       ts(:,:,:,jp_sal,Kmm) , mask =  tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    198             zarea(:) = narea     ! this is local information 
     204            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
    199205         ENDIF 
    200206         ! 
    201207         WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests' 
    202          WRITE(ctmp2,9100) kt, ' |ssh| max ',  zmax(1), iloc(1,1), iloc(2,1),            NINT(zarea(1))-1 
    203          WRITE(ctmp3,9200) kt, ' |U|   max ',  zmax(2), iloc(1,2), iloc(2,2), iloc(3,2), NINT(zarea(2))-1 
    204          WRITE(ctmp4,9200) kt, ' Sal   min ', -zmax(3), iloc(1,3), iloc(2,3), iloc(3,3), NINT(zarea(3))-1 
    205          WRITE(ctmp5,9200) kt, ' Sal   max ',  zmax(4), iloc(1,4), iloc(2,4), iloc(3,4), NINT(zarea(4))-1 
     208         CALL wrt_line( ctmp2, kt, '|ssh| max',  zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
     209         CALL wrt_line( ctmp3, kt, '|U|   max',  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
     210         CALL wrt_line( ctmp4, kt, 'Sal   min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 
     211         CALL wrt_line( ctmp5, kt, 'Sal   max',  zmax(4), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) ) 
    206212         IF( Agrif_Root() ) THEN 
    207213            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files' 
     
    214220         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
    215221            IF(lwp)   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
    216          ELSE   ! only mpi subdomains with errors are here -> STOP now 
     222         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
    217223            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
    218224         ENDIF 
     
    223229      ENDIF 
    224230      ! 
    225 9100  FORMAT(' kt ',i8,a,1pg11.4,' at i j  ',2i6, 6x,' MPI rank',i6) 
    226 9200  FORMAT(' kt ',i8,a,1pg11.4,' at i j k',2i6, i6,' MPI rank',i6) 
    2272319500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 
    228232      ! 
    229233   END SUBROUTINE stp_ctl 
     234 
     235 
     236   SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 
     237      !!---------------------------------------------------------------------- 
     238      !!                     ***  ROUTINE wrt_line  *** 
     239      !! 
     240      !! ** Purpose :   write information line 
     241      !! 
     242      !!---------------------------------------------------------------------- 
     243      CHARACTER(len=*),      INTENT(  out) ::   cdline 
     244      CHARACTER(len=*),      INTENT(in   ) ::   cdprefix 
     245      REAL(wp),              INTENT(in   ) ::   pval 
     246      INTEGER, DIMENSION(3), INTENT(in   ) ::   kloc 
     247      INTEGER,               INTENT(in   ) ::   kt, ksum, kmin, kmax 
     248      ! 
     249      CHARACTER(len=9) ::   clkt, clsum, clmin, clmax 
     250      CHARACTER(len=9) ::   cli, clj, clk 
     251      CHARACTER(len=1) ::   clfmt 
     252      CHARACTER(len=4) ::   cl4   ! needed to be able to compile with Agrif, I don't know why 
     253      INTEGER          ::   ifmtk 
     254      !!---------------------------------------------------------------------- 
     255      WRITE(clkt , '(i9)') kt 
     256       
     257      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
     258      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
     259      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
     260      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij-1,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
     261      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
     262                                   WRITE(clmax, cl4) kmax-1 
     263      ! 
     264      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1      ! how many digits to we need to write jpiglo? (we decide max = 9) 
     265      cl4 = '(i'//clfmt//')'   ;   WRITE(cli, cl4) kloc(1)      ! this is ok with AGRIF 
     266      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1      ! how many digits to we need to write jpjglo? (we decide max = 9) 
     267      cl4 = '(i'//clfmt//')'   ;   WRITE(clj, cl4) kloc(2)      ! this is ok with AGRIF 
     268      ! 
     269      IF( ksum == 1 ) THEN   ;   WRITE(cdline,9100) TRIM(clmin) 
     270      ELSE                   ;   WRITE(cdline,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 
     271      ENDIF 
     272      IF(kloc(3) == 0) THEN 
     273         ifmtk = INT(LOG10(REAL(jpk,wp))) + 1                   ! how many digits to we need to write jpk? (we decide max = 9) 
     274         clk = REPEAT(' ', ifmtk)                               ! create the equivalent in blank string 
     275         WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(cdline) 
     276      ELSE 
     277         WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1      ! how many digits to we need to write jpk? (we decide max = 9) 
     278         !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
     279         cl4 = '(i'//clfmt//')'   ;   WRITE(clk, cl4) kloc(3)   ! this is ok with AGRIF 
     280         WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj),    TRIM(clk), TRIM(cdline) 
     281      ENDIF 
     282      ! 
     2839100  FORMAT('MPI rank ', a) 
     2849200  FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 
     2859300  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j   ', a, ' ', a, ' ', a, ' ', a) 
     2869400  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 
     287      ! 
     288   END SUBROUTINE wrt_line 
     289 
    230290 
    231291   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.