Changeset 14143 for NEMO/trunk/src/OCE/stpctl.F90
- Timestamp:
- 2020-12-09T22:26:04+01:00 (3 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/stpctl.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/stpctl.F90
r14131 r14143 15 15 !!---------------------------------------------------------------------- 16 16 !! stp_ctl : Control the run 17 !! stp_ctl_SWE : Control the run (SWE only) 17 18 !!---------------------------------------------------------------------- 18 19 USE oce ! ocean dynamics and tracers variables … … 33 34 34 35 PUBLIC stp_ctl ! routine called by step.F90 36 PUBLIC stp_ctl_SWE ! routine called by stpmlf.F90 35 37 36 38 INTEGER :: nrunid ! netcdf file id 37 39 INTEGER, DIMENSION(8) :: nvarid ! netcdf variable id 40 INTEGER, DIMENSION(2) :: nvarid_SWE ! netcdf variable id (SWE only) 38 41 !!---------------------------------------------------------------------- 39 42 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 270 273 271 274 275 SUBROUTINE stp_ctl_SWE( kt, Kmm ) 276 !!---------------------------------------------------------------------- 277 !! *** ROUTINE stp_ctl_SWE *** 278 !! 279 !! ** Purpose : Control the run 280 !! 281 !! ** Method : - Save the time step in numstp 282 !! - Print it each 50 time steps 283 !! - Stop the run IF problem encountered by setting nstop > 0 284 !! Problems checked: e3t0+ssh minimum smaller that 0 285 !! |U| maximum larger than 10 m/s 286 !! ( not for SWE : negative sea surface salinity ) 287 !! 288 !! ** Actions : "time.step" file = last ocean time-step 289 !! "run.stat" file = run statistics 290 !! nstop indicator sheared among all local domain 291 !!---------------------------------------------------------------------- 292 INTEGER, INTENT(in ) :: kt ! ocean time-step index 293 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 294 !! 295 INTEGER :: ji ! dummy loop indices 296 INTEGER :: idtime, istatus 297 INTEGER , DIMENSION(3) :: iareasum, iareamin, iareamax 298 INTEGER , DIMENSION(3,4) :: iloc ! min/max loc indices 299 REAL(wp) :: zzz ! local real 300 REAL(wp), DIMENSION(3) :: zmax, zmaxlocal 301 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 302 LOGICAL, DIMENSION(jpi,jpj,jpk) :: llmsk 303 CHARACTER(len=20) :: clname 304 !!---------------------------------------------------------------------- 305 ! 306 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 307 ! 308 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 309 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 310 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 311 ! 312 IF( kt == nit000 ) THEN 313 ! 314 IF( lwp ) THEN 315 WRITE(numout,*) 316 WRITE(numout,*) 'stp_ctl_SWE : time-stepping control' 317 WRITE(numout,*) '~~~~~~~~~~~' 318 ENDIF 319 ! ! open time.step ascii file, done only by 1st subdomain 320 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 321 ! 322 IF( ll_wrtruns ) THEN 323 ! ! open run.stat ascii file, done only by 1st subdomain 324 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 325 ! ! open run.stat.nc netcdf file, done only by 1st subdomain 326 clname = 'run.stat.nc' 327 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 328 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 329 istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 330 istatus = NF90_DEF_VAR( nrunid, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), nvarid_SWE(1) ) 331 istatus = NF90_DEF_VAR( nrunid, 'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid_SWE(2) ) 332 istatus = NF90_ENDDEF(nrunid) 333 ENDIF 334 ! 335 ENDIF 336 ! 337 ! !== write current time step ==! 338 ! !== done only by 1st subdomain at writting timestep ==! 339 IF( lwm .AND. ll_wrtstp ) THEN 340 WRITE ( numstp, '(1x, i8)' ) kt 341 REWIND( numstp ) 342 ENDIF 343 ! !== test of local extrema ==! 344 ! !== done by all processes at every time step ==! 345 ! 346 llmsk( 1:Nis1,:,:) = .FALSE. ! exclude halos from the checked region 347 llmsk(Nie1: jpi,:,:) = .FALSE. 348 llmsk(:, 1:Njs1,:) = .FALSE. 349 llmsk(:,Nje1: jpj,:) = .FALSE. 350 ! 351 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0) == 1._wp ! define only the inner domain 352 ! 353 ll_0oce = .NOT. ANY( llmsk(:,:,1) ) ! no ocean point in the inner domain? 354 ! 355 zmax(1) = MINVAL( -e3t_0(:,:,1)-ssh(:,:,Kmm) , mask = llmsk(:,:,1) ) ! e3t_Kmm min 356 ! 357 llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 358 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) , mask = llmsk(:,:,:) ) ! velocity max (zonal only) 359 zmax(3) = REAL( nstop , wp ) ! stop indicator 360 361 ! !== get global extrema ==! 362 ! !== done by all processes if writting run.stat ==! 363 IF( ll_colruns ) THEN 364 zmaxlocal(:) = zmax(:) 365 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 366 nstop = NINT( zmax(3) ) ! update nstop indicator (now sheared among all local domains) 367 ELSE 368 ! if no ocean point: MAXVAL returns -HUGE => we must overwrite this value to avoid error handling bellow. 369 IF( ll_0oce ) zmax(1:4) = (/ 0._wp, 0._wp, -1._wp, 1._wp /) ! default "valid" values... 370 ENDIF 371 ! 372 zmax(1) = -zmax(1) ! move back from max(-zz) to min(zz) : easier to manage! 373 ! 374 ! !== write "run.stat" files ==! 375 ! !== done only by 1st subdomain at writting timestep ==! 376 IF( ll_wrtruns ) THEN 377 WRITE(numrun,9500) kt, zmax(1), zmax(2) 378 istatus = NF90_PUT_VAR( nrunid, nvarid_SWE(1), (/ zmax(1)/), (/kt/), (/1/) ) 379 istatus = NF90_PUT_VAR( nrunid, nvarid_SWE(2), (/ zmax(2)/), (/kt/), (/1/) ) 380 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 381 ENDIF 382 ! !== error handling ==! 383 ! !== done by all processes at every time step ==! 384 ! 385 !!SWE specific : start 386 IF( zmax(1) <= 0._wp .OR. & ! negative e3t_Kmm 387 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 388 & ISNAN( zmax(1) + zmax(2) ) .OR. & ! NaN encounter in the tests 389 & ABS( zmax(1) + zmax(2) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 390 ! 391 iloc(:,:) = 0 392 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 393 ! first: close the netcdf file, so we can read it 394 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid) 395 ! get global loc on the min/max 396 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0 ) == 1._wp ! define only the inner domain 397 CALL mpp_minloc( 'stpctl', e3t_0(:,:,1) + ssh(:,:,Kmm), llmsk(:,:,1), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 398 llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 399 CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:,Kmm)) , llmsk(:,:,:), zzz, iloc(1:3,2) ) 400 ! find which subdomain has the max. 401 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 402 DO ji = 1, 3 403 IF( zmaxlocal(ji) == zmax(ji) ) THEN 404 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 405 ENDIF 406 END DO 407 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain 408 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain 409 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain 410 ELSE ! find local min and max locations: 411 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 412 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0 ) == 1._wp ! define only the inner domain 413 iloc(1:2,1) = MINLOC( e3t_0(:,:,1) + ssh(:,:,Kmm), mask = llmsk(:,:,1) ) 414 ! 415 llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 416 iloc(1:3,2) = MAXLOC( ABS( uu(:,:,:, Kmm)), mask = llmsk(:,:,:) ) 417 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 418 ENDIF 419 ! 420 WRITE(ctmp1,*) ' stp_ctl_SWE: e3t0+ssh < 0 m or |U| > 10 m/s or NaN encounter in the tests' 421 CALL wrt_line( ctmp2, kt, 'e3t0+ssh min', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 422 CALL wrt_line( ctmp3, kt, '|U| max' , zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 423 IF( Agrif_Root() ) THEN 424 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' 425 ELSE 426 WRITE(ctmp6,*) ' ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 427 ENDIF 428 ! 429 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 430 ! 431 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 432 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ' ', ctmp6 ) 433 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) 434 ENDIF 435 ELSE ! only mpi subdomains with errors are here -> STOP now 436 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ' ', ctmp6 ) 437 ENDIF 438 ! 439 ENDIF 440 !!SWE specific : end 441 ! 442 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... 443 ngrdstop = Agrif_Fixed() ! store which grid got this error 444 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock 445 ENDIF 446 ! 447 9500 FORMAT(' it :', i8, ' e3t_min: ', D23.16, ' |U|_max: ', D23.16) 448 ! 449 END SUBROUTINE stp_ctl_SWE 450 451 272 452 SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 273 453 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
