Changeset 14644 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/stpctl.F90
- Timestamp:
- 2021-03-26T15:33:49+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/stpctl.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette _wave@13990sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/stpctl.F90
r14219 r14644 15 15 !!---------------------------------------------------------------------- 16 16 !! stp_ctl : Control the run 17 !! stp_ctl_SWE : Control the run (SWE only)18 17 !!---------------------------------------------------------------------- 19 18 USE oce ! ocean dynamics and tracers variables … … 34 33 35 34 PUBLIC stp_ctl ! routine called by step.F90 36 PUBLIC stp_ctl_SWE ! routine called by stpmlf.F90 37 38 INTEGER :: nrunid ! netcdf file id 39 INTEGER, DIMENSION(8) :: nvarid ! netcdf variable id 40 INTEGER, DIMENSION(2) :: nvarid_SWE ! netcdf variable id (SWE only) 35 36 INTEGER, PARAMETER :: jpvar = 8 37 INTEGER :: nrunid ! netcdf file id 38 INTEGER, DIMENSION(jpvar) :: nvarid ! netcdf variable id 41 39 !!---------------------------------------------------------------------- 42 40 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 49 47 !!---------------------------------------------------------------------- 50 48 !! *** ROUTINE stp_ctl *** 51 !! 49 !! 52 50 !! ** Purpose : Control the run 53 51 !! … … 65 63 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 66 64 !! 65 INTEGER, PARAMETER :: jptst = 4 67 66 INTEGER :: ji ! dummy loop indices 68 67 INTEGER :: idtime, istatus 69 INTEGER , DIMENSION( 9):: iareasum, iareamin, iareamax70 INTEGER , DIMENSION(3, 4):: iloc ! min/max loc indices68 INTEGER , DIMENSION(jptst) :: iareasum, iareamin, iareamax 69 INTEGER , DIMENSION(3,jptst) :: iloc ! min/max loc indices 71 70 REAL(dp) :: zzz, zminsal, zmaxsal ! local real 72 REAL(dp), DIMENSION( 9) ::zmax73 REAL(wp), DIMENSION( 9) ::zmaxlocal71 REAL(dp), DIMENSION(jpvar+1) :: zmax 72 REAL(wp), DIMENSION(jptst) :: zmaxlocal 74 73 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 75 74 LOGICAL, DIMENSION(jpi,jpj,jpk) :: llmsk … … 79 78 ! 80 79 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 81 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 80 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 82 81 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 83 82 ! … … 112 111 istatus = NF90_ENDDEF(nrunid) 113 112 ENDIF 114 ! 113 ! 115 114 ENDIF 116 115 ! … … 124 123 ! !== done by all processes at every time step ==! 125 124 ! 126 llmsk( 1:Nis1,:,:) = .FALSE.! exclude halos from the checked region127 llmsk(Nie 1:jpi,:,:) = .FALSE.128 llmsk(:, 1:Njs1,:) = .FALSE.129 llmsk(:,Nje 1:jpj,:) = .FALSE.125 llmsk( 1:nn_hls,:,:) = .FALSE. ! exclude halos from the checked region 126 llmsk(Nie0+1: jpi,:,:) = .FALSE. 127 llmsk(:, 1:nn_hls,:) = .FALSE. 128 llmsk(:,Nje0+1: jpj,:) = .FALSE. 130 129 ! 131 130 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0) == 1._wp ! define only the inner domain … … 156 155 zmax(5:8) = 0._wp 157 156 ENDIF 158 zmax( 9) = REAL( nstop, wp )! stop indicator157 zmax(jpvar+1) = REAL( nstop, wp ) ! stop indicator 159 158 ! 160 159 ! !== get global extrema ==! 161 160 ! !== done by all processes if writting run.stat ==! 162 161 IF( ll_colruns ) THEN 163 zmaxlocal(:) = zmax( :)162 zmaxlocal(:) = zmax(1:jptst) 164 163 CALL mpp_max( "stpctl", zmax ) ! max over the global domain: ok even of ll_0oce = .true. 165 nstop = NINT( zmax( 9) )! update nstop indicator (now sheared among all local domains)164 nstop = NINT( zmax(jpvar+1) ) ! update nstop indicator (now sheared among all local domains) 166 165 ELSE 167 166 ! if no ocean point: MAXVAL returns -HUGE => we must overwrite this value to avoid error handling bellow. 168 IF( ll_0oce ) zmax(1:4) = (/ 0._wp, 0._wp, -1._wp, 1._wp /) ! default "valid" values... 169 ENDIF 170 ! 171 zmax(3) = -zmax(3) ! move back from max(-zz) to min(zz) : easier to manage! 172 zmax(5) = -zmax(5) ! move back from max(-zz) to min(zz) : easier to manage! 173 IF( ll_colruns ) THEN 174 zmaxlocal(3) = -zmaxlocal(3) ! move back from max(-zz) to min(zz) : easier to manage! 175 zmaxlocal(5) = -zmaxlocal(5) ! move back from max(-zz) to min(zz) : easier to manage! 176 ENDIF 167 IF( ll_0oce ) zmax(1:jptst) = (/ 0._wp, 0._wp, -1._wp, 1._wp /) ! default "valid" values... 168 ENDIF 169 ! 170 zmax(3) = -zmax(3) ! move back from max(-zz) to min(zz) : easier to manage! 171 zmax(5) = -zmax(5) ! move back from max(-zz) to min(zz) : easier to manage! 172 IF( ll_colruns ) zmaxlocal(3) = -zmaxlocal(3) ! move back from max(-zz) to min(zz) : easier to manage! 177 173 ! 178 174 ! !== write "run.stat" files ==! 179 175 ! !== done only by 1st subdomain at writting timestep ==! 180 176 IF( ll_wrtruns ) THEN 181 WRITE(numrun,9500) kt, zmax(1 ), zmax(2), zmax(3), zmax(4)182 DO ji = 1, 6 + 2 * COUNT((/ln_zad_Aimp/) )177 WRITE(numrun,9500) kt, zmax(1:jptst) 178 DO ji = 1, jpvar - 2 * COUNT( .NOT. (/ln_zad_Aimp/) ) 183 179 istatus = NF90_PUT_VAR( nrunid, nvarid(ji), (/zmax(ji)/), (/kt/), (/1/) ) 184 180 END DO … … 189 185 ! 190 186 IF ( ln_SEOS.AND.(rn_b0==0._wp) ) THEN ! Discard checks on salinity 191 zmaxsal = +HUGE(1._dp)! if not used in eos192 zminsal = -HUGE(1._dp) 187 zmaxsal = HUGE(1._dp) ! if not used in eos 188 zminsal = -HUGE(1._dp) 193 189 ELSE 194 190 zmaxsal = 100._wp … … 196 192 ENDIF 197 193 ! 198 IF( zmax(1) > 20._wp .OR. & ! too large sea surface height ( > 20 m )199 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s)200 & zmax(3) <= zminsal .OR. & ! negative or zero sea surface salinity201 & zmax(4) >= zmaxsal .OR. & ! too large sea surface salinity ( > 100 )202 & zmax(4) < zminsal .OR. & ! too large sea surface salinity (keep this line for sea-ice)203 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests204 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests194 IF( zmax(1) > 20._wp .OR. & ! too large sea surface height ( > 20 m ) 195 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 196 & zmax(3) <= zminsal .OR. & ! negative or zero sea surface salinity 197 & zmax(4) >= zmaxsal .OR. & ! too large sea surface salinity ( > 100 ) 198 & zmax(4) < zminsal .OR. & ! too large sea surface salinity (keep this line for sea-ice) 199 & ISNAN( SUM(zmax(1:jptst)) ) .OR. & ! NaN encounter in the tests 200 & ABS( SUM(zmax(1:jptst)) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 205 201 ! 206 202 iloc(:,:) = 0 … … 218 214 ! find which subdomain has the max. 219 215 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 220 DO ji = 1, 9216 DO ji = 1, jptst 221 217 IF( zmaxlocal(ji) == zmax(ji) ) THEN 222 218 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 … … 235 231 iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) ) 236 232 iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) ) 237 DO ji = 1, 4! local domain indices ==> global domain indices, excluding halos233 DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos 238 234 iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 239 235 END DO … … 254 250 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 255 251 ! 256 IF( ll_colruns . or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files252 IF( ll_colruns .OR. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 257 253 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 258 254 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) … … 272 268 ! 273 269 END SUBROUTINE stp_ctl 274 275 276 SUBROUTINE stp_ctl_SWE( kt, Kmm )277 !!----------------------------------------------------------------------278 !! *** ROUTINE stp_ctl_SWE ***279 !!280 !! ** Purpose : Control the run281 !!282 !! ** Method : - Save the time step in numstp283 !! - Print it each 50 time steps284 !! - Stop the run IF problem encountered by setting nstop > 0285 !! Problems checked: e3t0+ssh minimum smaller that 0286 !! |U| maximum larger than 10 m/s287 !! ( not for SWE : negative sea surface salinity )288 !!289 !! ** Actions : "time.step" file = last ocean time-step290 !! "run.stat" file = run statistics291 !! nstop indicator sheared among all local domain292 !!----------------------------------------------------------------------293 INTEGER, INTENT(in ) :: kt ! ocean time-step index294 INTEGER, INTENT(in ) :: Kmm ! ocean time level index295 !!296 INTEGER :: ji ! dummy loop indices297 INTEGER :: idtime, istatus298 INTEGER , DIMENSION(3) :: iareasum, iareamin, iareamax299 INTEGER , DIMENSION(3,4) :: iloc ! min/max loc indices300 REAL(dp) :: zzz ! local real301 REAL(dp), DIMENSION(3) :: zmax, zmaxlocal302 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce303 LOGICAL, DIMENSION(jpi,jpj,jpk) :: llmsk304 CHARACTER(len=20) :: clname305 !!----------------------------------------------------------------------306 !307 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid308 !309 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )310 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1311 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm312 !313 IF( kt == nit000 ) THEN314 !315 IF( lwp ) THEN316 WRITE(numout,*)317 WRITE(numout,*) 'stp_ctl_SWE : time-stepping control'318 WRITE(numout,*) '~~~~~~~~~~~'319 ENDIF320 ! ! open time.step ascii file, done only by 1st subdomain321 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )322 !323 IF( ll_wrtruns ) THEN324 ! ! open run.stat ascii file, done only by 1st subdomain325 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )326 ! ! open run.stat.nc netcdf file, done only by 1st subdomain327 clname = 'run.stat.nc'328 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)329 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid )330 istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime )331 istatus = NF90_DEF_VAR( nrunid, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), nvarid_SWE(1) )332 istatus = NF90_DEF_VAR( nrunid, 'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid_SWE(2) )333 istatus = NF90_ENDDEF(nrunid)334 ENDIF335 !336 ENDIF337 !338 ! !== write current time step ==!339 ! !== done only by 1st subdomain at writting timestep ==!340 IF( lwm .AND. ll_wrtstp ) THEN341 WRITE ( numstp, '(1x, i8)' ) kt342 REWIND( numstp )343 ENDIF344 ! !== test of local extrema ==!345 ! !== done by all processes at every time step ==!346 !347 llmsk( 1:Nis1,:,:) = .FALSE. ! exclude halos from the checked region348 llmsk(Nie1: jpi,:,:) = .FALSE.349 llmsk(:, 1:Njs1,:) = .FALSE.350 llmsk(:,Nje1: jpj,:) = .FALSE.351 !352 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0) == 1._wp ! define only the inner domain353 !354 ll_0oce = .NOT. ANY( llmsk(:,:,1) ) ! no ocean point in the inner domain?355 !356 zmax(1) = MINVAL( -e3t_0(:,:,1)-ssh(:,:,Kmm) , mask = llmsk(:,:,1) ) ! e3t_Kmm min357 !358 llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain359 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) , mask = llmsk(:,:,:) ) ! velocity max (zonal only)360 zmax(3) = REAL( nstop , wp ) ! stop indicator361 362 ! !== get global extrema ==!363 ! !== done by all processes if writting run.stat ==!364 IF( ll_colruns ) THEN365 zmaxlocal(:) = zmax(:)366 CALL mpp_max( "stpctl", zmax ) ! max over the global domain367 nstop = NINT( zmax(3) ) ! update nstop indicator (now sheared among all local domains)368 ELSE369 ! if no ocean point: MAXVAL returns -HUGE => we must overwrite this value to avoid error handling bellow.370 IF( ll_0oce ) zmax(1:4) = (/ 0._wp, 0._wp, -1._wp, 1._wp /) ! default "valid" values...371 ENDIF372 !373 zmax(1) = -zmax(1) ! move back from max(-zz) to min(zz) : easier to manage!374 !375 ! !== write "run.stat" files ==!376 ! !== done only by 1st subdomain at writting timestep ==!377 IF( ll_wrtruns ) THEN378 WRITE(numrun,9500) kt, zmax(1), zmax(2)379 istatus = NF90_PUT_VAR( nrunid, nvarid_SWE(1), (/ zmax(1)/), (/kt/), (/1/) )380 istatus = NF90_PUT_VAR( nrunid, nvarid_SWE(2), (/ zmax(2)/), (/kt/), (/1/) )381 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid)382 ENDIF383 ! !== error handling ==!384 ! !== done by all processes at every time step ==!385 !386 !!SWE specific : start387 IF( zmax(1) <= 0._wp .OR. & ! negative e3t_Kmm388 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s)389 & ISNAN( zmax(1) + zmax(2) ) .OR. & ! NaN encounter in the tests390 & ABS( zmax(1) + zmax(2) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests391 !392 iloc(:,:) = 0393 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc394 ! first: close the netcdf file, so we can read it395 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid)396 ! get global loc on the min/max397 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0 ) == 1._wp ! define only the inner domain398 CALL mpp_minloc( 'stpctl', e3t_0(:,:,1) + ssh(:,:,Kmm), llmsk(:,:,1), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F399 llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain400 CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:,Kmm)) , llmsk(:,:,:), zzz, iloc(1:3,2) )401 ! find which subdomain has the max.402 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0403 DO ji = 1, 3404 IF( zmaxlocal(ji) == zmax(ji) ) THEN405 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1406 ENDIF407 END DO408 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain409 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain410 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain411 ELSE ! find local min and max locations:412 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc413 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0 ) == 1._wp ! define only the inner domain414 iloc(1:2,1) = MINLOC( e3t_0(:,:,1) + ssh(:,:,Kmm), mask = llmsk(:,:,1) )415 !416 llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain417 iloc(1:3,2) = MAXLOC( ABS( uu(:,:,:, Kmm)), mask = llmsk(:,:,:) )418 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information419 ENDIF420 !421 WRITE(ctmp1,*) ' stp_ctl_SWE: e3t0+ssh < 0 m or |U| > 10 m/s or NaN encounter in the tests'422 CALL wrt_line( ctmp2, kt, 'e3t0+ssh min', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) )423 CALL wrt_line( ctmp3, kt, '|U| max' , zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) )424 IF( Agrif_Root() ) THEN425 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files'426 ELSE427 WRITE(ctmp6,*) ' ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files'428 ENDIF429 !430 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file431 !432 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files433 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ' ', ctmp6 )434 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop)435 ENDIF436 ELSE ! only mpi subdomains with errors are here -> STOP now437 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ' ', ctmp6 )438 ENDIF439 !440 ENDIF441 !!SWE specific : end442 !443 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet...444 ngrdstop = Agrif_Fixed() ! store which grid got this error445 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock446 ENDIF447 !448 9500 FORMAT(' it :', i8, ' e3t_min: ', D23.16, ' |U|_max: ', D23.16)449 !450 END SUBROUTINE stp_ctl_SWE451 270 452 271
Note: See TracChangeset
for help on using the changeset viewer.
