Changeset 4977 for branches/2014/dev_MERGE_2014
- Timestamp:
- 2014-12-06T09:40:23+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r4967 r4977 9 9 10 10 !!---------------------------------------------------------------------- 11 !! dia_hsb : Diagnose the conservation of ocean heat and salt contents, and volume 12 !! dia_hsb_rst : Read or write DIA file in restart file 13 !! dia_hsb_init : Initialization of the conservation diagnostic 14 !!---------------------------------------------------------------------- 11 15 USE oce ! ocean dynamics and tracers 12 16 USE dom_oce ! ocean space and time domain 13 17 USE phycst ! physical constants 14 18 USE sbc_oce ! surface thermohaline fluxes 15 USE in_out_manager ! I/O manager 19 USE sbcrnf ! river runoff 20 USE sbcisf ! ice shelves 16 21 USE domvvl ! vertical scale factors 17 22 USE traqsr ! penetrative solar radiation 18 23 USE trabbc ! bottom boundary condition 19 USE lib_mpp ! distributed memory computing library20 24 USE trabbc ! bottom boundary condition 21 25 USE bdy_par ! (for lk_bdy) 26 USE restart ! ocean restart 27 ! 28 USE iom ! I/O manager 29 USE in_out_manager ! I/O manager 30 USE lib_fortran ! glob_sum 31 USE lib_mpp ! distributed memory computing library 22 32 USE timing ! preformance summary 23 USE iom ! I/O manager24 USE lib_fortran ! glob_sum25 USE restart ! ocean restart26 33 USE wrk_nemo ! work arrays 27 USE sbcrnf ! river runoff28 USE sbcisf ! ice shelves29 34 30 35 IMPLICIT NONE … … 37 42 LOGICAL, PUBLIC :: ln_diahsb !: check the heat and salt budgets 38 43 39 real(wp) :: surf_tot ! 40 real(wp) :: frc_t , frc_s , frc_v ! global forcing trends 41 real(wp) :: frc_wn_t , frc_wn_s ! global forcing trends 42 real(wp), DIMENSION(:,:) , ALLOCATABLE :: surf , ssh_ini ! 43 real(wp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini, sc_loc_ini, e3t_ini ! 44 real(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini 44 REAL(wp) :: surf_tot ! ocean surface 45 REAL(wp) :: frc_t, frc_s, frc_v ! global forcing trends 46 REAL(wp) :: frc_wn_t, frc_wn_s ! global forcing trends 47 ! 48 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf , ssh_ini ! 49 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini ! 50 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini, sc_loc_ini, e3t_ini ! 45 51 46 52 !! * Substitutions 47 53 # include "domzgr_substitute.h90" 48 54 # include "vectopt_loop_substitute.h90" 49 50 55 !!---------------------------------------------------------------------- 51 56 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 53 58 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 54 59 !!---------------------------------------------------------------------- 55 56 60 CONTAINS 57 61 … … 68 72 !!--------------------------------------------------------------------------- 69 73 INTEGER, INTENT(in) :: kt ! ocean time-step index 70 ! !71 INTEGER :: j k, ji, jj! dummy loop indice72 real(wp) :: zdiff_hc , zdiff_sc ! heat and salt content variations73 real(wp) :: zdiff_hc1 , zdiff_sc1 ! - - - - - - --74 real(wp) :: zdiff_v1 , zdiff_v2 ! volume variation75 real(wp) :: zerr_hc1 , zerr_sc1! heat and salt content misfit76 real(wp) :: zvol_tot ! volume77 real(wp) :: z_frc_trd_t , z_frc_trd_s ! - -78 real(wp) :: z_frc_trd_v ! - -79 real(wp) :: z_wn_trd_t , z_wn_trd_s! - -80 real(wp) :: z_ssh_hc , z_ssh_sc! - -81 real(wp), DIMENSION(:,:), POINTER:: z2d0, z2d174 ! 75 INTEGER :: ji, jj, jk ! dummy loop indice 76 REAL(wp) :: zdiff_hc , zdiff_sc ! heat and salt content variations 77 REAL(wp) :: zdiff_hc1 , zdiff_sc1 ! - - - - 78 REAL(wp) :: zdiff_v1 , zdiff_v2 ! volume variation 79 REAL(wp) :: zerr_hc1 , zerr_sc1 ! heat and salt content misfit 80 REAL(wp) :: zvol_tot ! volume 81 REAL(wp) :: z_frc_trd_t , z_frc_trd_s ! - - 82 REAL(wp) :: z_frc_trd_v ! - - 83 REAL(wp) :: z_wn_trd_t , z_wn_trd_s ! - - 84 REAL(wp) :: z_ssh_hc , z_ssh_sc ! - - 85 REAL(wp), DIMENSION(:,:), POINTER :: z2d0, z2d1 82 86 !!--------------------------------------------------------------------------- 83 87 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') 84 CALL wrk_alloc( jpi,jpj, z2d0, z2d1 ) 88 CALL wrk_alloc( jpi,jpj, z2d0, z2d1 ) 89 ! 85 90 tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ; 86 91 tsn(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ; … … 130 135 ! 2 - Content variations ! 131 136 ! ------------------------ ! 132 zdiff_v2 = 0. d0133 zdiff_hc = 0. d0134 zdiff_sc = 0. d0137 zdiff_v2 = 0._wp 138 zdiff_hc = 0._wp 139 zdiff_sc = 0._wp 135 140 136 141 ! volume variation (calculated with ssh) … … 139 144 ! heat & salt content variation (associated with ssh) 140 145 IF( .NOT. lk_vvl ) THEN 141 z2d0 =0.0_wp ; z2d1=0.0_wp142 DO ji =1,jpi143 DO jj =1,jpj146 z2d0 = 0._wp ; z2d1 = 0._wp 147 DO ji = 1, jpi 148 DO jj = 1, jpj 144 149 z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) ) 145 150 z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) ) 146 END DO147 END DO151 END DO 152 END DO 148 153 z_ssh_hc = glob_sum( z2d0 ) 149 154 z_ssh_sc = glob_sum( z2d1 ) … … 177 182 ! 3 - Diagnostics writing ! 178 183 ! ----------------------- ! 179 zvol_tot = 0.d0 ! total ocean volume184 zvol_tot = 0._wp ! total ocean volume (calculated with scale factors) 180 185 DO jk = 1, jpkm1 181 186 zvol_tot = zvol_tot + glob_sum( surf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) ) 182 187 END DO 188 189 !!gm to be added ? 190 ! IF( .NOT. lk_vvl ) THEN ! fixed volume, add the ssh contribution 191 ! zvol_tot = zvol_tot + glob_sum( surf(:,:) * sshn(:,:) ) 192 ! ENDIF 193 !!gm end 194 183 195 184 196 IF( lk_vvl ) THEN … … 207 219 IF( lrst_oce ) CALL dia_hsb_rst( kt, 'WRITE' ) 208 220 221 CALL wrk_dealloc( jpi,jpj, z2d0, z2d1 ) 222 209 223 IF( nn_timing == 1 ) CALL timing_stop('dia_hsb') 210 !224 ! 211 225 END SUBROUTINE dia_hsb 212 226 213 214 SUBROUTINE dia_hsb_init215 !!---------------------------------------------------------------------------216 !! *** ROUTINE dia_hsb ***217 !!218 !! ** Purpose: Initialization for the heat salt volume budgets219 !!220 !! ** Method : Compute initial heat content, salt content and volume221 !!222 !! ** Action : - Compute initial heat content, salt content and volume223 !! - Initialize forcing trends224 !! - Compute coefficients for conversion225 !!---------------------------------------------------------------------------226 INTEGER :: jk ! dummy loop indice227 INTEGER :: ierror ! local integer228 !!229 NAMELIST/namhsb/ ln_diahsb230 !231 INTEGER :: ios232 !!----------------------------------------------------------------------233 234 IF(lwp) THEN235 WRITE(numout,*)236 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets'237 WRITE(numout,*) '~~~~~~~~ '238 ENDIF239 240 REWIND( numnam_ref ) ! Namelist namhsb in reference namelist241 READ ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901)242 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in reference namelist', lwp )243 244 REWIND( numnam_cfg ) ! Namelist namhsb in configuration namelist245 READ ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 )246 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp )247 IF(lwm) WRITE ( numond, namhsb )248 249 !250 IF(lwp) THEN ! Control print251 WRITE(numout,*)252 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets'253 WRITE(numout,*) '~~~~~~~~~~~~'254 WRITE(numout,*) ' Namelist namhsb : set hsb parameters'255 WRITE(numout,*) ' Switch for hsb diagnostic (T) or not (F) ln_diahsb = ', ln_diahsb256 WRITE(numout,*)257 ENDIF258 259 IF( .NOT. ln_diahsb ) RETURN260 ! IF( .NOT. lk_mpp_rep ) &261 ! CALL ctl_stop (' Your global mpp_sum if performed in single precision - 64 bits -', &262 ! & ' whereas the global sum to be precise must be done in double precision ',&263 ! & ' please add key_mpp_rep')264 265 ! ------------------- !266 ! 1 - Allocate memory !267 ! ------------------- !268 ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), &269 & e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), STAT=ierror )270 IF( ierror > 0 ) THEN271 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN272 ENDIF273 274 IF(.NOT. lk_vvl ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror )275 IF( ierror > 0 ) THEN276 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN277 ENDIF278 279 ! ----------------------------------------------- !280 ! 2 - Time independant variables and file opening !281 ! ----------------------------------------------- !282 IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated"283 IF(lwp) WRITE(numout,*) '~~~~~~~'284 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area285 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area286 287 IF( lk_bdy ) CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )288 !289 ! ---------------------------------- !290 ! 4 - initial conservation variables !291 ! ---------------------------------- !292 CALL dia_hsb_rst( nit000, 'READ' ) !* read or initialize all required files293 !294 END SUBROUTINE dia_hsb_init295 227 296 228 SUBROUTINE dia_hsb_rst( kt, cdrw ) … … 305 237 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 306 238 ! 307 INTEGER :: j k,ji,jj !308 INTEGER :: id1 ! local integers239 INTEGER :: ji, jj, jk ! dummy loop indices 240 INTEGER :: id1 ! local integers 309 241 !!---------------------------------------------------------------------- 310 242 ! … … 341 273 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk) ! initial salt content 342 274 END DO 343 frc_v = 0. d0! volume trend due to forcing344 frc_t = 0. d0! heat content - - - -345 frc_s = 0. d0! salt content - - - -275 frc_v = 0._wp ! volume trend due to forcing 276 frc_t = 0._wp ! heat content - - - - 277 frc_s = 0._wp ! salt content - - - - 346 278 IF( .NOT. lk_vvl ) THEN 347 279 DO ji=1,jpi … … 351 283 ENDDO 352 284 ENDDO 353 frc_wn_t = 0. d0! initial heat content misfit due to free surface354 frc_wn_s = 0. d0! initial salt content misfit due to free surface285 frc_wn_t = 0._wp ! initial heat content misfit due to free surface 286 frc_wn_s = 0._wp ! initial salt content misfit due to free surface 355 287 ENDIF 356 288 ENDIF … … 382 314 END SUBROUTINE dia_hsb_rst 383 315 316 317 SUBROUTINE dia_hsb_init 318 !!--------------------------------------------------------------------------- 319 !! *** ROUTINE dia_hsb *** 320 !! 321 !! ** Purpose: Initialization for the heat salt volume budgets 322 !! 323 !! ** Method : Compute initial heat content, salt content and volume 324 !! 325 !! ** Action : - Compute initial heat content, salt content and volume 326 !! - Initialize forcing trends 327 !! - Compute coefficients for conversion 328 !!--------------------------------------------------------------------------- 329 INTEGER :: jk ! dummy loop indice 330 INTEGER :: ierror ! local integer 331 INTEGER :: ios 332 ! 333 NAMELIST/namhsb/ ln_diahsb 334 !!---------------------------------------------------------------------- 335 336 IF(lwp) THEN 337 WRITE(numout,*) 338 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 339 WRITE(numout,*) '~~~~~~~~ ' 340 ENDIF 341 342 REWIND( numnam_ref ) ! Namelist namhsb in reference namelist 343 READ ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) 344 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in reference namelist', lwp ) 345 346 REWIND( numnam_cfg ) ! Namelist namhsb in configuration namelist 347 READ ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 ) 348 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp ) 349 IF(lwm) WRITE ( numond, namhsb ) 350 351 ! 352 IF(lwp) THEN ! Control print 353 WRITE(numout,*) 354 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 355 WRITE(numout,*) '~~~~~~~~~~~~' 356 WRITE(numout,*) ' Namelist namhsb : set hsb parameters' 357 WRITE(numout,*) ' Switch for hsb diagnostic (T) or not (F) ln_diahsb = ', ln_diahsb 358 WRITE(numout,*) 359 ENDIF 360 361 IF( .NOT. ln_diahsb ) RETURN 362 ! IF( .NOT. lk_mpp_rep ) & 363 ! CALL ctl_stop (' Your global mpp_sum if performed in single precision - 64 bits -', & 364 ! & ' whereas the global sum to be precise must be done in double precision ',& 365 ! & ' please add key_mpp_rep') 366 367 ! ------------------- ! 368 ! 1 - Allocate memory ! 369 ! ------------------- ! 370 ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), & 371 & e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), STAT=ierror ) 372 IF( ierror > 0 ) THEN 373 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 374 ENDIF 375 376 IF(.NOT. lk_vvl ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 377 IF( ierror > 0 ) THEN 378 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 379 ENDIF 380 381 ! ----------------------------------------------- ! 382 ! 2 - Time independant variables and file opening ! 383 ! ----------------------------------------------- ! 384 IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 385 IF(lwp) WRITE(numout,*) '~~~~~~~' 386 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area 387 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 388 389 IF( lk_bdy ) CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' ) 390 ! 391 ! ---------------------------------- ! 392 ! 4 - initial conservation variables ! 393 ! ---------------------------------- ! 394 CALL dia_hsb_rst( nit000, 'READ' ) !* read or initialize all required files 395 ! 396 END SUBROUTINE dia_hsb_init 397 384 398 !!====================================================================== 385 399 END MODULE diahsb
Note: See TracChangeset
for help on using the changeset viewer.
