Changeset 14771 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/DIA_GPU/MY_SRC/diahsb.F90
- Timestamp:
- 2021-04-30T12:20:05+02:00 (3 years ago)
- File:
-
- 1 edited
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
Note: See TracChangeset
for help on using the changeset viewer.