Changeset 7646 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
- Timestamp:
- 2017-02-06T10:25:03+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r6140 r7646 23 23 USE trabbc ! bottom boundary condition 24 24 USE trabbc ! bottom boundary condition 25 USE bdy_par ! (for lk_bdy)26 25 USE restart ! ocean restart 26 USE bdy_oce , ONLY: ln_bdy 27 27 ! 28 28 USE iom ! I/O manager … … 38 38 PUBLIC dia_hsb ! routine called by step.F90 39 39 PUBLIC dia_hsb_init ! routine called by nemogcm.F90 40 PUBLIC dia_hsb_rst ! routine called by step.F9041 40 42 41 LOGICAL, PUBLIC :: ln_diahsb !: check the heat and salt budgets … … 86 85 !!--------------------------------------------------------------------------- 87 86 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') 87 ! 88 88 CALL wrk_alloc( jpi,jpj, z2d0, z2d1 ) 89 89 ! … … 171 171 ENDDO 172 172 173 ! Substract forcing from heat content, salt content and volume variations 173 ! ------------------------ ! 174 ! 3 - Drifts ! 175 ! ------------------------ ! 174 176 zdiff_v1 = zdiff_v1 - frc_v 175 177 IF( .NOT.ln_linssh ) zdiff_v2 = zdiff_v2 - frc_v … … 184 186 185 187 ! ----------------------- ! 186 ! 3- Diagnostics writing !188 ! 4 - Diagnostics writing ! 187 189 ! ----------------------- ! 188 190 zvol_tot = 0._wp ! total ocean volume (calculated with scale factors) … … 197 199 !!gm end 198 200 199 IF( ln_linssh ) THEN 200 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content variation (C) 201 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content variation (psu) 202 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J) 203 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content variation (psu*km3) 204 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3) 205 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 206 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C) 207 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu) 201 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 202 CALL iom_put( 'bgfrctem' , frc_t * rau0 * rcp * 1.e-20 ) ! hc - surface forcing (1.e20 J) 203 CALL iom_put( 'bgfrchfx' , frc_t * rau0 * rcp / & ! hc - surface forcing (W/m2) 204 & ( surf_tot * kt * rdt ) ) 205 CALL iom_put( 'bgfrcsal' , frc_s * 1.e-9 ) ! sc - surface forcing (psu*km3) 206 207 IF( .NOT. ln_linssh ) THEN 208 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature drift (C) 209 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity drift (pss) 210 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp ) ! Heat content drift (1.e20 J) 211 CALL iom_put( 'bgheatfx' , zdiff_hc * rau0 * rcp / & ! Heat flux drift (W/m2) 212 & ( surf_tot * kt * rdt ) ) 213 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content drift (psu*km3) 214 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 215 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t drift (km3) 216 ELSE 217 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content drift (C) 218 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content drift (pss) 219 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp ) ! Heat content drift (1.e20 J) 220 CALL iom_put( 'bgheatfx' , zdiff_hc1 * rau0 * rcp / & ! Heat flux drift (W/m2) 221 & ( surf_tot * kt * rdt ) ) 222 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content drift (psu*km3) 223 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 208 224 CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot ) ! hc - error due to free surface (C) 209 225 CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot ) ! sc - error due to free surface (psu) 210 ELSE211 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature variation (C)212 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity variation (psu)213 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J)214 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content variation (psu*km3)215 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3)216 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t variation (km3)217 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3)218 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C)219 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu)220 226 ENDIF 221 227 ! … … 231 237 SUBROUTINE dia_hsb_rst( kt, cdrw ) 232 238 !!--------------------------------------------------------------------- 233 !! *** ROUTINE limdia_rst ***239 !! *** ROUTINE dia_hsb_rst *** 234 240 !! 235 241 !! ** Purpose : Read or write DIA file in restart file … … 241 247 ! 242 248 INTEGER :: ji, jj, jk ! dummy loop indices 243 INTEGER :: id1 ! local integers244 249 !!---------------------------------------------------------------------- 245 250 ! 246 251 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 247 252 IF( ln_rstart ) THEN !* Read the restart file 248 !id1 = iom_varid( numror, 'frc_vol' , ldstop = .FALSE. )249 253 ! 250 254 IF(lwp) WRITE(numout,*) '~~~~~~~' … … 259 263 ENDIF 260 264 CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 261 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini )262 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini )263 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini )264 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini )265 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) ) 266 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) ) 267 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 268 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 265 269 IF( ln_linssh ) THEN 266 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini )267 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini )270 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 271 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 268 272 ENDIF 269 273 ELSE … … 313 317 ENDIF 314 318 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini ) ! ice sheet coupling 315 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini )316 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini )317 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini )318 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini )319 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini(:,:) ) 320 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini(:,:,:) ) 321 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 322 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 319 323 IF( ln_linssh ) THEN 320 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini )321 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini )324 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 325 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 322 326 ENDIF 323 327 ! … … 339 343 !! - Compute coefficients for conversion 340 344 !!--------------------------------------------------------------------------- 341 INTEGER :: jk ! dummy loop indice342 345 INTEGER :: ierror ! local integer 343 346 INTEGER :: ios 344 ! 347 !! 345 348 NAMELIST/namhsb/ ln_diahsb 346 349 !!---------------------------------------------------------------------- 347 348 IF(lwp) THEN 349 WRITE(numout,*) 350 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 351 WRITE(numout,*) '~~~~~~~~ ' 352 ENDIF 353 350 ! 354 351 REWIND( numnam_ref ) ! Namelist namhsb in reference namelist 355 352 READ ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) … … 361 358 IF(lwm) WRITE ( numond, namhsb ) 362 359 363 ! 364 IF(lwp) THEN ! Control print 360 IF(lwp) THEN 365 361 WRITE(numout,*) 366 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 367 WRITE(numout,*) '~~~~~~~~~~~~' 368 WRITE(numout,*) ' Namelist namhsb : set hsb parameters' 369 WRITE(numout,*) ' Switch for hsb diagnostic (T) or not (F) ln_diahsb = ', ln_diahsb 370 WRITE(numout,*) 371 ENDIF 372 362 WRITE(numout,*) 'dia_hsb_init' 363 WRITE(numout,*) '~~~~~~~~ ' 364 WRITE(numout,*) ' check the heat and salt budgets (T) or not (F) ln_diahsb = ', ln_diahsb 365 ENDIF 366 ! 373 367 IF( .NOT. ln_diahsb ) RETURN 374 ! IF( .NOT. lk_mpp_rep ) &375 ! CALL ctl_stop (' Your global mpp_sum if performed in single precision - 64 bits -', &376 ! & ' whereas the global sum to be precise must be done in double precision ',&377 ! & ' please add key_mpp_rep')378 368 379 369 ! ------------------- ! … … 383 373 & e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), STAT=ierror ) 384 374 IF( ierror > 0 ) THEN 385 CALL ctl_stop( 'dia_hsb : unable to allocate hc_loc_ini' ) ; RETURN375 CALL ctl_stop( 'dia_hsb_init: unable to allocate hc_loc_ini' ) ; RETURN 386 376 ENDIF 387 377 388 378 IF( ln_linssh ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 389 379 IF( ierror > 0 ) THEN 390 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN380 CALL ctl_stop( 'dia_hsb: unable to allocate ssh_hc_loc_ini' ) ; RETURN 391 381 ENDIF 392 382 … … 394 384 ! 2 - Time independant variables and file opening ! 395 385 ! ----------------------------------------------- ! 396 IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated"397 IF(lwp) WRITE(numout,*) '~~~~~~~'398 386 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area 399 surf_tot = glob_sum( surf(:,:) ) 400 401 IF( l k_bdy ) CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )387 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 388 389 IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' ) 402 390 ! 403 391 ! ---------------------------------- !
Note: See TracChangeset
for help on using the changeset viewer.