Changeset 12840 for NEMO/branches/2020/r12581_ticket2418/src/OCE/stpctl.F90
- Timestamp:
- 2020-05-01T10:58:58+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12581_ticket2418/src/OCE/stpctl.F90
r12685 r12840 64 64 INTEGER :: ji ! dummy loop indices 65 65 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 67 68 REAL(wp) :: zzz ! local real 68 REAL(wp), DIMENSION(9) :: zmax, zmaxlocal , zarea69 REAL(wp), DIMENSION(9) :: zmax, zmaxlocal 69 70 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 70 71 LOGICAL, DIMENSION(jpi,jpj,jpk) :: llmsk … … 176 177 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) THEN ! NaN encounter in the tests 177 178 ! 179 iloc(:,:) = 0 178 180 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 179 181 ! first: close the netcdf file, so we can read it … … 185 187 CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , tmask(:,:,:), zzz, iloc(1:3,4) ) 186 188 ! find which subdomain has the max. 187 zarea(:) = 0._wp189 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 188 190 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 190 194 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 192 198 ELSE ! find local min and max locations: 193 199 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc … … 196 202 iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 197 203 iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 198 zarea(:) = narea! this is local information204 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 199 205 ENDIF 200 206 ! 201 207 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))-1203 WRITE(ctmp3,9200) kt, ' |U| max ', zmax(2), iloc(1,2), iloc(2,2), iloc(3,2), NINT(zarea(2))-1204 WRITE(ctmp4,9200) kt, ' Sal min ', -zmax(3), iloc(1,3), iloc(2,3), iloc(3,3), NINT(zarea(3))-1205 WRITE(ctmp5,9200) kt, ' Sal max ', zmax(4), iloc(1,4), iloc(2,4), iloc(3,4), NINT(zarea(4))-1208 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) ) 206 212 IF( Agrif_Root() ) THEN 207 213 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' … … 214 220 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 215 221 IF(lwp) CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 216 ELSE ! only mpi subdomains with errors are here -> STOP now222 ELSE ! only mpi subdomains with errors are here -> STOP now 217 223 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 218 224 ENDIF … … 223 229 ENDIF 224 230 ! 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)227 231 9500 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 228 232 ! 229 233 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 ! 283 9100 FORMAT('MPI rank ', a) 284 9200 FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 285 9300 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j ', a, ' ', a, ' ', a, ' ', a) 286 9400 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 287 ! 288 END SUBROUTINE wrt_line 289 230 290 231 291 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.