- Timestamp:
- 2016-09-30T14:40:04+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r5628 r6963 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 ! … … 174 174 ENDDO 175 175 176 ! Substract forcing from heat content, salt content and volume variations 176 ! ------------------------ ! 177 ! 3 - Drifts ! 178 ! ------------------------ ! 177 179 zdiff_v1 = zdiff_v1 - frc_v 178 180 IF( lk_vvl ) zdiff_v2 = zdiff_v2 - frc_v … … 187 189 188 190 ! ----------------------- ! 189 ! 3- Diagnostics writing !191 ! 4 - Diagnostics writing ! 190 192 ! ----------------------- ! 191 193 zvol_tot = 0._wp ! total ocean volume (calculated with scale factors) … … 200 202 !!gm end 201 203 204 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 205 CALL iom_put( 'bgfrctem' , frc_t * rau0 * rcp * 1.e-20 ) ! hc - surface forcing (1.e20 J) 206 CALL iom_put( 'bgfrchfx' , frc_t * rau0 * rcp / & ! hc - surface forcing (W/m2) 207 & ( surf_tot * kt * rdt ) ) 208 CALL iom_put( 'bgfrcsal' , frc_s * 1.e-9 ) ! sc - surface forcing (psu*km3) 209 202 210 IF( lk_vvl ) THEN 203 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature variation (C) 204 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity variation (psu) 205 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J) 206 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content variation (psu*km3) 207 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3) 208 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t variation (km3) 209 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 210 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C) 211 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu) 211 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature drift (C) 212 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity drift (pss) 213 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp ) ! Heat content drift (1.e20 J) 214 CALL iom_put( 'bgheatfx' , zdiff_hc * rau0 * rcp / & ! Heat flux drift (W/m2) 215 & ( surf_tot * kt * rdt ) ) 216 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content drift (psu*km3) 217 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 218 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t drift (km3) 212 219 ELSE 213 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content variation (C) 214 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content variation (psu) 215 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J) 216 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content variation (psu*km3) 217 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3) 218 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 219 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C) 220 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu) 220 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content drift (C) 221 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content drift (pss) 222 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp ) ! Heat content drift (1.e20 J) 223 CALL iom_put( 'bgheatfx' , zdiff_hc1 * rau0 * rcp / & ! Heat flux drift (W/m2) 224 & ( surf_tot * kt * rdt ) ) 225 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content drift (psu*km3) 226 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 221 227 CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot ) ! hc - error due to free surface (C) 222 228 CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot ) ! sc - error due to free surface (psu) … … 244 250 ! 245 251 INTEGER :: ji, jj, jk ! dummy loop indices 246 INTEGER :: id1 ! local integers247 252 !!---------------------------------------------------------------------- 248 253 ! 249 254 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 250 255 IF( ln_rstart ) THEN !* Read the restart file 251 !id1 = iom_varid( numror, 'frc_vol' , ldstop = .FALSE. )252 256 ! 253 257 IF(lwp) WRITE(numout,*) '~~~~~~~' … … 261 265 CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 262 266 ENDIF 263 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini )264 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini )265 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini )266 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini )267 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) ) 268 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) ) 269 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 270 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 267 271 IF( .NOT. lk_vvl ) THEN 268 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini )269 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini )272 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 273 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 270 274 ENDIF 271 275 ELSE … … 312 316 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 313 317 ENDIF 314 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini )315 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini )316 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini )317 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini )318 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini(:,:) ) 319 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini(:,:,:) ) 320 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 321 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 318 322 IF( .NOT. lk_vvl ) THEN 319 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini )320 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini )323 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 324 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 321 325 ENDIF 326 322 327 ! 323 328 ENDIF … … 338 343 !! - Compute coefficients for conversion 339 344 !!--------------------------------------------------------------------------- 340 INTEGER :: jk ! dummy loop indice341 345 INTEGER :: ierror ! local integer 342 346 INTEGER :: ios … … 344 348 NAMELIST/namhsb/ ln_diahsb 345 349 !!---------------------------------------------------------------------- 346 347 IF(lwp) THEN348 WRITE(numout,*)349 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets'350 WRITE(numout,*) '~~~~~~~~ '351 ENDIF352 350 353 351 REWIND( numnam_ref ) ! Namelist namhsb in reference namelist … … 360 358 IF(lwm) WRITE ( numond, namhsb ) 361 359 362 ! 363 IF(lwp) THEN ! Control print 360 IF(lwp) THEN 364 361 WRITE(numout,*) 365 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 366 WRITE(numout,*) '~~~~~~~~~~~~' 367 WRITE(numout,*) ' Namelist namhsb : set hsb parameters' 368 WRITE(numout,*) ' Switch for hsb diagnostic (T) or not (F) ln_diahsb = ', ln_diahsb 369 WRITE(numout,*) 370 ENDIF 371 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 ! 372 367 IF( .NOT. ln_diahsb ) RETURN 373 368 ! IF( .NOT. lk_mpp_rep ) & … … 382 377 & e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), STAT=ierror ) 383 378 IF( ierror > 0 ) THEN 384 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 385 ENDIF 386 387 IF(.NOT. lk_vvl ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 388 IF( ierror > 0 ) THEN 389 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 379 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) 380 RETURN 381 ENDIF 382 383 IF( .NOT. lk_vvl ) THEN 384 ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj), STAT=ierror ) 385 IF( ierror > 0 ) THEN 386 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) 387 RETURN 388 ENDIF 390 389 ENDIF 391 390 … … 393 392 ! 2 - Time independant variables and file opening ! 394 393 ! ----------------------------------------------- ! 395 IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated"396 IF(lwp) WRITE(numout,*) '~~~~~~~'397 394 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area 398 surf_tot = glob_sum( surf(:,:) ) 395 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 399 396 400 397 IF( lk_bdy ) CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )
Note: See TracChangeset
for help on using the changeset viewer.
