Changeset 14771
- Timestamp:
- 2021-04-30T12:20:05+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/DIA_GPU/MY_SRC
- Files:
-
- 2 edited
-
diahsb.F90 (modified) (20 diffs)
-
stpctl.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/DIA_GPU/MY_SRC/diahsb.F90
r14091 r14771 7 7 !! Ocean diagnostics: Heat, salt and volume budgets 8 8 !!====================================================================== 9 !! History : 3.3 ! 2010-09 (M. Leclair) Original code 9 !! History : 3.3 ! 2010-09 (M. Leclair) Original code 10 10 !! ! 2012-10 (C. Rousset) add iom_put 11 11 !!---------------------------------------------------------------------- … … 24 24 USE domvvl ! vertical scale factors 25 25 USE traqsr ! penetrative solar radiation 26 USE trabbc ! bottom boundary condition 26 USE trabbc ! bottom boundary condition 27 27 USE trabbc ! bottom boundary condition 28 28 USE restart ! ocean restart … … 47 47 REAL(wp) :: frc_wn_t, frc_wn_s ! global forcing trends 48 48 ! 49 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf 49 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf 50 50 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf_ini , ssh_ini ! 51 51 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini ! … … 65 65 !!--------------------------------------------------------------------------- 66 66 !! *** ROUTINE dia_hsb *** 67 !! 67 !! 68 68 !! ** Purpose: Compute the ocean global heat content, salt content and volume conservation 69 !! 69 !! 70 70 !! ** Method : - Compute the deviation of heat content, salt content and volume 71 71 !! at the current time step from their values at nit000 … … 78 78 INTEGER :: ji, jj, jk ! dummy loop indice 79 79 REAL(wp) :: zdiff_hc , zdiff_sc ! heat and salt content variations 80 REAL(wp) :: zdiff_hc1 , zdiff_sc1 ! - - - - 80 REAL(wp) :: zdiff_hc1 , zdiff_sc1 ! - - - - 81 81 REAL(wp) :: zdiff_v1 , zdiff_v2 ! volume variation 82 82 REAL(wp) :: zerr_hc1 , zerr_sc1 ! heat and salt content misfit … … 89 89 REAL(wp), DIMENSION(jpi,jpj,jpkm1) :: zwrk ! 3D workspace 90 90 !!--------------------------------------------------------------------------- 91 IF( ln_timing ) CALL timing_start('dia_hsb') 91 IF( ln_timing ) CALL timing_start('dia_hsb') 92 92 ! 93 93 ts(:,:,:,1,Kmm) = ts(:,:,:,1,Kmm) * tmask(:,:,:) ; ts(:,:,:,1,Kbb) = ts(:,:,:,1,Kbb) * tmask(:,:,:) ; … … 122 122 z2d1(:,:) = surf(:,:) * ww(:,:,1) * ts(:,:,1,jp_sal,Kbb) 123 123 END IF 124 z_wn_trd_t = - glob_sum( 'diahsb', z2d0 ) 124 z_wn_trd_t = - glob_sum( 'diahsb', z2d0 ) 125 125 z_wn_trd_s = - glob_sum( 'diahsb', z2d1 ) 126 126 ENDIF … … 148 148 DO ji = 1, jpi 149 149 DO jj = 1, jpj 150 z2d0(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) - ssh_hc_loc_ini(ji,jj) ) 151 z2d1(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) - ssh_sc_loc_ini(ji,jj) ) 150 z2d0(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) - ssh_hc_loc_ini(ji,jj) ) 151 z2d1(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) - ssh_sc_loc_ini(ji,jj) ) 152 152 END DO 153 153 END DO 154 154 ELSE ! no under ice-shelf seas 155 z2d0(:,:) = surf(:,:) * ( ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) - ssh_hc_loc_ini(:,:) ) 156 z2d1(:,:) = surf(:,:) * ( ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) - ssh_sc_loc_ini(:,:) ) 155 z2d0(:,:) = surf(:,:) * ( ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) - ssh_hc_loc_ini(:,:) ) 156 z2d1(:,:) = surf(:,:) * ( ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) - ssh_sc_loc_ini(:,:) ) 157 157 END IF 158 z_ssh_hc = glob_sum_full( 'diahsb', z2d0 ) 159 z_ssh_sc = glob_sum_full( 'diahsb', z2d1 ) 158 z_ssh_hc = glob_sum_full( 'diahsb', z2d0 ) 159 z_ssh_sc = glob_sum_full( 'diahsb', z2d1 ) 160 160 ENDIF 161 161 ! … … 184 184 zdiff_sc = zdiff_sc - frc_s 185 185 IF( ln_linssh ) THEN 186 zdiff_hc1 = zdiff_hc + z_ssh_hc 186 zdiff_hc1 = zdiff_hc + z_ssh_hc 187 187 zdiff_sc1 = zdiff_sc + z_ssh_sc 188 188 zerr_hc1 = z_ssh_hc - frc_wn_t … … 204 204 !!gm end 205 205 206 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 207 CALL iom_put( 'bgfrctem' , frc_t * rho0 * rcp * 1.e-20 ) ! hc - surface forcing (1.e20 J) 208 CALL iom_put( 'bgfrchfx' , frc_t * rho0 * rcp / & ! hc - surface forcing (W/m2) 206 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 207 CALL iom_put( 'bgfrctem' , frc_t * rho0 * rcp * 1.e-20 ) ! hc - surface forcing (1.e20 J) 208 CALL iom_put( 'bgfrchfx' , frc_t * rho0 * rcp / & ! hc - surface forcing (W/m2) 209 209 & ( surf_tot * kt * rn_Dt ) ) 210 CALL iom_put( 'bgfrcsal' , frc_s * 1.e-9 ) ! sc - surface forcing (psu*km3) 210 CALL iom_put( 'bgfrcsal' , frc_s * 1.e-9 ) ! sc - surface forcing (psu*km3) 211 211 212 212 IF( .NOT. ln_linssh ) THEN 213 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature drift (C) 213 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature drift (C) 214 214 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity drift (PSU) 215 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rho0 * rcp ) ! Heat content drift (1.e20 J) 216 CALL iom_put( 'bgheatfx' , zdiff_hc * rho0 * rcp / & ! Heat flux drift (W/m2) 215 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rho0 * rcp ) ! Heat content drift (1.e20 J) 216 CALL iom_put( 'bgheatfx' , zdiff_hc * rho0 * rcp / & ! Heat flux drift (W/m2) 217 217 & ( surf_tot * kt * rn_Dt ) ) 218 218 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content drift (psu*km3) 219 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 220 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t drift (km3) 219 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 220 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t drift (km3) 221 221 ! 222 222 IF( kt == nitend .AND. lwp ) THEN … … 231 231 ! 232 232 ELSE 233 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content drift (C) 233 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content drift (C) 234 234 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content drift (PSU) 235 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rho0 * rcp ) ! Heat content drift (1.e20 J) 236 CALL iom_put( 'bgheatfx' , zdiff_hc1 * rho0 * rcp / & ! Heat flux drift (W/m2) 235 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rho0 * rcp ) ! Heat content drift (1.e20 J) 236 CALL iom_put( 'bgheatfx' , zdiff_hc1 * rho0 * rcp / & ! Heat flux drift (W/m2) 237 237 & ( surf_tot * kt * rn_Dt ) ) 238 238 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content drift (psu*km3) 239 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 239 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 240 240 CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot ) ! hc - error due to free surface (C) 241 241 CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot ) ! sc - error due to free surface (psu) … … 252 252 !!--------------------------------------------------------------------- 253 253 !! *** ROUTINE dia_hsb_rst *** 254 !! 254 !! 255 255 !! ** Purpose : Read or write DIA file in restart file 256 256 !! … … 264 264 !!---------------------------------------------------------------------- 265 265 ! 266 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 266 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 267 267 IF( ln_rstart ) THEN !* Read the restart file 268 268 ! … … 270 270 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : read hsb restart at it= ', kt,' date= ', ndastp 271 271 IF(lwp) WRITE(numout,*) 272 CALL iom_get( numror, 'frc_v', frc_v , ldxios = lrxios)273 CALL iom_get( numror, 'frc_t', frc_t , ldxios = lrxios)274 CALL iom_get( numror, 'frc_s', frc_s , ldxios = lrxios)272 CALL iom_get( numror, 'frc_v', frc_v ) 273 CALL iom_get( numror, 'frc_t', frc_t ) 274 CALL iom_get( numror, 'frc_s', frc_s ) 275 275 IF( ln_linssh ) THEN 276 CALL iom_get( numror, 'frc_wn_t', frc_wn_t , ldxios = lrxios)277 CALL iom_get( numror, 'frc_wn_s', frc_wn_s , ldxios = lrxios)276 CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 277 CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 278 278 ENDIF 279 CALL iom_get( numror, jpdom_auto, 'surf_ini' , surf_ini , ldxios = lrxios) ! ice sheet coupling280 CALL iom_get( numror, jpdom_auto, 'ssh_ini' , ssh_ini , ldxios = lrxios)281 CALL iom_get( numror, jpdom_auto, 'e3t_ini' , e3t_ini , ldxios = lrxios)282 CALL iom_get( numror, jpdom_auto, 'tmask_ini' , tmask_ini , ldxios = lrxios)283 CALL iom_get( numror, jpdom_auto, 'hc_loc_ini', hc_loc_ini , ldxios = lrxios)284 CALL iom_get( numror, jpdom_auto, 'sc_loc_ini', sc_loc_ini , ldxios = lrxios)279 CALL iom_get( numror, jpdom_auto, 'surf_ini' , surf_ini ) ! ice sheet coupling 280 CALL iom_get( numror, jpdom_auto, 'ssh_ini' , ssh_ini ) 281 CALL iom_get( numror, jpdom_auto, 'e3t_ini' , e3t_ini ) 282 CALL iom_get( numror, jpdom_auto, 'tmask_ini' , tmask_ini ) 283 CALL iom_get( numror, jpdom_auto, 'hc_loc_ini', hc_loc_ini ) 284 CALL iom_get( numror, jpdom_auto, 'sc_loc_ini', sc_loc_ini ) 285 285 IF( ln_linssh ) THEN 286 CALL iom_get( numror, jpdom_auto, 'ssh_hc_loc_ini', ssh_hc_loc_ini , ldxios = lrxios)287 CALL iom_get( numror, jpdom_auto, 'ssh_sc_loc_ini', ssh_sc_loc_ini , ldxios = lrxios)286 CALL iom_get( numror, jpdom_auto, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 287 CALL iom_get( numror, jpdom_auto, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 288 288 ENDIF 289 289 ELSE … … 301 301 END DO 302 302 frc_v = 0._wp ! volume trend due to forcing 303 frc_t = 0._wp ! heat content - - - - 304 frc_s = 0._wp ! salt content - - - - 303 frc_t = 0._wp ! heat content - - - - 304 frc_s = 0._wp ! salt content - - - - 305 305 IF( ln_linssh ) THEN 306 306 IF( ln_isfcav ) THEN … … 326 326 IF(lwp) WRITE(numout,*) 327 327 ! 328 IF( lwxios ) CALL iom_swap( cwxios_context ) 329 CALL iom_rstput( kt, nitrst, numrow, 'frc_v', frc_v, ldxios = lwxios ) 330 CALL iom_rstput( kt, nitrst, numrow, 'frc_t', frc_t, ldxios = lwxios ) 331 CALL iom_rstput( kt, nitrst, numrow, 'frc_s', frc_s, ldxios = lwxios ) 328 CALL iom_rstput( kt, nitrst, numrow, 'frc_v', frc_v ) 329 CALL iom_rstput( kt, nitrst, numrow, 'frc_t', frc_t ) 330 CALL iom_rstput( kt, nitrst, numrow, 'frc_s', frc_s ) 332 331 IF( ln_linssh ) THEN 333 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t , ldxios = lwxios)334 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s , ldxios = lwxios)332 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 333 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 335 334 ENDIF 336 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini' , surf_ini , ldxios = lwxios) ! ice sheet coupling337 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini' , ssh_ini , ldxios = lwxios)338 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini' , e3t_ini , ldxios = lwxios)339 CALL iom_rstput( kt, nitrst, numrow, 'tmask_ini' , tmask_ini , ldxios = lwxios)340 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini , ldxios = lwxios)341 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini , ldxios = lwxios)335 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini' , surf_ini ) ! ice sheet coupling 336 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini' , ssh_ini ) 337 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini' , e3t_ini ) 338 CALL iom_rstput( kt, nitrst, numrow, 'tmask_ini' , tmask_ini ) 339 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini ) 340 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini ) 342 341 IF( ln_linssh ) THEN 343 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini , ldxios = lwxios)344 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini , ldxios = lwxios)342 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 343 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 345 344 ENDIF 346 IF( lwxios ) CALL iom_swap( cxios_context )347 345 ! 348 346 ENDIF … … 354 352 !!--------------------------------------------------------------------------- 355 353 !! *** ROUTINE dia_hsb *** 356 !! 354 !! 357 355 !! ** Purpose: Initialization for the heat salt volume budgets 358 !! 356 !! 359 357 !! ** Method : Compute initial heat content, salt content and volume 360 358 !! … … 388 386 IF( .NOT. ln_diahsb ) RETURN 389 387 390 IF(lwxios) THEN391 ! define variables in restart file when writing with XIOS392 CALL iom_set_rstw_var_active('frc_v')393 CALL iom_set_rstw_var_active('frc_t')394 CALL iom_set_rstw_var_active('frc_s')395 CALL iom_set_rstw_var_active('surf_ini')396 CALL iom_set_rstw_var_active('ssh_ini')397 CALL iom_set_rstw_var_active('e3t_ini')398 CALL iom_set_rstw_var_active('hc_loc_ini')399 CALL iom_set_rstw_var_active('sc_loc_ini')400 IF( ln_linssh ) THEN401 CALL iom_set_rstw_var_active('ssh_hc_loc_ini')402 CALL iom_set_rstw_var_active('ssh_sc_loc_ini')403 CALL iom_set_rstw_var_active('frc_wn_t')404 CALL iom_set_rstw_var_active('frc_wn_s')405 ENDIF406 ENDIF407 388 ! ------------------- ! 408 389 ! 1 - Allocate memory ! … … 425 406 surf_tot = glob_sum( 'diahsb', surf(:,:) ) ! total ocean surface area 426 407 427 IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' ) 408 IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' ) 428 409 ! 429 410 ! ---------------------------------- ! … … 436 417 !!====================================================================== 437 418 END MODULE diahsb 438 #endif -
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/DIA_GPU/MY_SRC/stpctl.F90
r14091 r14771 26 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 27 USE lib_mpp ! distributed memory computing 28 USE eosbn2, ONLY: ln_SEOS, rn_b0 28 29 ! 29 30 USE netcdf ! NetCDF library … … 34 35 PUBLIC stp_ctl ! routine called by step.F90 35 36 36 INTEGER :: nrunid ! netcdf file id 37 INTEGER, DIMENSION(8) :: nvarid ! netcdf variable id 37 INTEGER, PARAMETER :: jpvar = 8 38 INTEGER :: nrunid ! netcdf file id 39 INTEGER, DIMENSION(jpvar) :: nvarid ! netcdf variable id 38 40 !!---------------------------------------------------------------------- 39 41 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 40 !! $Id $42 !! $Id: stpctl.F90 13616 2020-10-15 15:58:33Z smasson $ 41 43 !! Software governed by the CeCILL license (see ./LICENSE) 42 44 !!---------------------------------------------------------------------- … … 46 48 !!---------------------------------------------------------------------- 47 49 !! *** ROUTINE stp_ctl *** 48 !! 50 !! 49 51 !! ** Purpose : Control the run 50 52 !! … … 62 64 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 63 65 !! 66 INTEGER, PARAMETER :: jptst = 4 64 67 INTEGER :: ji ! dummy loop indices 65 68 INTEGER :: idtime, istatus 66 INTEGER , DIMENSION(9) :: iareasum, iareamin, iareamax 67 INTEGER , DIMENSION(3,4) :: iloc ! min/max loc indices 68 REAL(wp) :: zzz ! local real 69 REAL(wp), DIMENSION(9) :: zmax, zmaxlocal 69 INTEGER , DIMENSION(jptst) :: iareasum, iareamin, iareamax 70 INTEGER , DIMENSION(3,jptst) :: iloc ! min/max loc indices 71 REAL(wp) :: zzz, zminsal, zmaxsal ! local real 72 REAL(wp), DIMENSION(jpvar+1) :: zmax 73 REAL(wp), DIMENSION(jptst) :: zmaxlocal 70 74 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 71 75 LOGICAL, DIMENSION(jpi,jpj,jpk) :: llmsk … … 75 79 ! 76 80 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 77 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 81 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 78 82 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 79 83 ! … … 108 112 istatus = NF90_ENDDEF(nrunid) 109 113 ENDIF 110 ! 114 ! 111 115 ENDIF 112 116 ! … … 120 124 ! !== done by all processes at every time step ==! 121 125 ! 122 llmsk( 1:Nis1,:,:) = .FALSE.! exclude halos from the checked region123 llmsk(Nie 1:jpi,:,:) = .FALSE.124 llmsk(:, 1:Njs1,:) = .FALSE.125 llmsk(:,Nje 1:jpj,:) = .FALSE.126 llmsk( 1:nn_hls,:,:) = .FALSE. ! exclude halos from the checked region 127 llmsk(Nie0+1: jpi,:,:) = .FALSE. 128 llmsk(:, 1:nn_hls,:) = .FALSE. 129 llmsk(:,Nje0+1: jpj,:) = .FALSE. 126 130 ! 127 131 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0) == 1._wp ! define only the inner domain … … 152 156 zmax(5:8) = 0._wp 153 157 ENDIF 154 zmax( 9) = REAL( nstop, wp )! stop indicator158 zmax(jpvar+1) = REAL( nstop, wp ) ! stop indicator 155 159 ! 156 160 ! !== get global extrema ==! 157 161 ! !== done by all processes if writting run.stat ==! 158 162 IF( ll_colruns ) THEN 159 zmaxlocal(:) = zmax( :)163 zmaxlocal(:) = zmax(1:jptst) 160 164 CALL mpp_max( "stpctl", zmax ) ! max over the global domain: ok even of ll_0oce = .true. 161 nstop = NINT( zmax( 9) )! update nstop indicator (now sheared among all local domains)165 nstop = NINT( zmax(jpvar+1) ) ! update nstop indicator (now sheared among all local domains) 162 166 ELSE 163 167 ! if no ocean point: MAXVAL returns -HUGE => we must overwrite this value to avoid error handling bellow. 164 IF( ll_0oce ) zmax(1:4) = (/ 0._wp, 0._wp, -1._wp, 1._wp /) ! default "valid" values... 165 ENDIF 166 ! 167 zmax(3) = -zmax(3) ! move back from max(-zz) to min(zz) : easier to manage! 168 zmax(5) = -zmax(5) ! move back from max(-zz) to min(zz) : easier to manage! 169 IF( ll_colruns ) THEN 170 zmaxlocal(3) = -zmaxlocal(3) ! move back from max(-zz) to min(zz) : easier to manage! 171 zmaxlocal(5) = -zmaxlocal(5) ! move back from max(-zz) to min(zz) : easier to manage! 172 ENDIF 168 IF( ll_0oce ) zmax(1:jptst) = (/ 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 ) zmaxlocal(3) = -zmaxlocal(3) ! move back from max(-zz) to min(zz) : easier to manage! 173 174 ! 174 175 ! !== write "run.stat" files ==! 175 176 ! !== done only by 1st subdomain at writting timestep ==! 176 177 IF( ll_wrtruns ) THEN 177 WRITE(numrun,9500) kt, zmax(1 ), zmax(2), zmax(3), zmax(4)178 DO ji = 1, 6 + 2 * COUNT((/ln_zad_Aimp/) )178 WRITE(numrun,9500) kt, zmax(1:jptst) 179 DO ji = 1, jpvar - 2 * COUNT( .NOT. (/ln_zad_Aimp/) ) 179 180 istatus = NF90_PUT_VAR( nrunid, nvarid(ji), (/zmax(ji)/), (/kt/), (/1/) ) 180 181 END DO … … 184 185 ! !== done by all processes at every time step ==! 185 186 ! 186 IF( zmax(1) > 20._wp .OR. & ! too large sea surface height ( > 20 m ) 187 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 188 & zmax(3) <= 0._wp .OR. & ! negative or zero sea surface salinity 189 & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 190 & zmax(4) < 0._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 191 & IEEE_IS_NAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests 192 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 187 IF ( ln_SEOS.AND.(rn_b0==0._wp) ) THEN ! Discard checks on salinity 188 zmaxsal = HUGE(1._wp) ! if not used in eos 189 zminsal = -HUGE(1._wp) 190 ELSE 191 zmaxsal = 100._wp 192 zminsal = 0._wp 193 ENDIF 194 ! 195 IF( zmax(1) > 20._wp .OR. & ! too large sea surface height ( > 20 m ) 196 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 197 & zmax(3) <= zminsal .OR. & ! negative or zero sea surface salinity 198 & zmax(4) >= zmaxsal .OR. & ! too large sea surface salinity ( > 100 ) 199 & zmax(4) < zminsal .OR. & ! too large sea surface salinity (keep this line for sea-ice) 200 & IEEE_IS_NAN( SUM(zmax(1:jptst)) ) .OR. & ! NaN encounter in the tests 201 & ABS( SUM(zmax(1:jptst)) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 193 202 ! 194 203 iloc(:,:) = 0 … … 206 215 ! find which subdomain has the max. 207 216 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 208 DO ji = 1, 9217 DO ji = 1, jptst 209 218 IF( zmaxlocal(ji) == zmax(ji) ) THEN 210 219 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 … … 223 232 iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) ) 224 233 iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) ) 225 DO ji = 1, 4! local domain indices ==> global domain indices, excluding halos234 DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos 226 235 iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 227 236 END DO … … 242 251 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 243 252 ! 244 IF( ll_colruns . or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files253 IF( ll_colruns .OR. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 245 254 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 246 255 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop)
Note: See TracChangeset
for help on using the changeset viewer.
