- Timestamp:
- 2016-11-21T11:40:00+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r6140 r7280 230 230 231 231 SUBROUTINE dia_hsb_rst( kt, cdrw ) 232 !!---------------------------------------------------------------------233 !! *** ROUTINE limdia_rst ***234 !!235 !! ** Purpose : Read or write DIA file in restart file236 !!237 !! ** Method : use of IOM library238 !!----------------------------------------------------------------------239 INTEGER , INTENT(in) :: kt ! ocean time-step240 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag241 !242 INTEGER :: ji, jj, jk ! dummy loop indices243 INTEGER :: id1 ! local integers244 !!----------------------------------------------------------------------245 !246 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise247 IF( ln_rstart ) THEN !* Read the restart file248 !id1 = iom_varid( numror, 'frc_vol' , ldstop = .FALSE. )249 !250 IF(lwp) WRITE(numout,*) '~~~~~~~'251 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp252 IF(lwp) WRITE(numout,*) '~~~~~~~'253 CALL iom_get( numror, 'frc_v', frc_v )254 CALL iom_get( numror, 'frc_t', frc_t )255 CALL iom_get( numror, 'frc_s', frc_s )256 IF( ln_linssh ) THEN257 CALL iom_get( numror, 'frc_wn_t', frc_wn_t )258 CALL iom_get( numror, 'frc_wn_s', frc_wn_s )259 ENDIF260 CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling261 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 IF( ln_linssh ) THEN266 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 )268 ENDIF269 ELSE270 IF(lwp) WRITE(numout,*) '~~~~~~~'271 IF(lwp) WRITE(numout,*) ' dia_hsbat initial state '272 IF(lwp) WRITE(numout,*) '~~~~~~~'273 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface274 ssh_ini(:,:) = sshn(:,:) ! initial ssh275 DO jk = 1, jpk276 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).277 e3t_ini (:,:,jk) = e3t_n(:,:,jk) * tmask(:,:,jk) ! initial vertical scale factors278 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial heat content279 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial salt content280 END DO281 frc_v = 0._wp ! volume trend due to forcing282 frc_t = 0._wp ! heat content - - - -283 frc_s = 0._wp ! salt content - - - -284 IF( ln_linssh ) THEN285 IF( ln_isfcav ) THEN286 DO ji=1,jpi287 DO jj=1,jpj288 ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) ! initial heat content in ssh289 ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) ! initial salt content in ssh290 ENDDO291 ENDDO292 ELSE293 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh294 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh295 END IF296 frc_wn_t = 0._wp ! initial heat content misfit due to free surface297 frc_wn_s = 0._wp ! initial salt content misfit due to free surface298 ENDIF299 ENDIF300 301 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file302 ! ! -------------------303 IF(lwp) WRITE(numout,*) '~~~~~~~'304 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp305 IF(lwp) WRITE(numout,*) '~~~~~~~'306 307 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v )308 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t )309 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s )310 IF( ln_linssh ) THEN311 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t )312 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s )313 ENDIF314 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini ) ! ice sheet coupling315 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 IF( ln_linssh ) THEN320 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 )322 ENDIF323 !324 ENDIF325 !232 !!--------------------------------------------------------------------- 233 !! *** ROUTINE limdia_rst *** 234 !! 235 !! ** Purpose : Read or write DIA file in restart file 236 !! 237 !! ** Method : use of IOM library 238 !!---------------------------------------------------------------------- 239 INTEGER , INTENT(in) :: kt ! ocean time-step 240 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 241 ! 242 INTEGER :: ji, jj, jk ! dummy loop indices 243 INTEGER :: id1 ! local integers 244 !!---------------------------------------------------------------------- 245 ! 246 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 247 IF( ln_rstart ) THEN !* Read the restart file 248 !id1 = iom_varid( numror, 'frc_vol' , ldstop = .FALSE. ) 249 ! 250 IF(lwp) WRITE(numout,*) 251 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : read restart at it= ', kt,' date= ', ndastp 252 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 253 CALL iom_get( numror, 'frc_v', frc_v ) 254 CALL iom_get( numror, 'frc_t', frc_t ) 255 CALL iom_get( numror, 'frc_s', frc_s ) 256 IF( ln_linssh ) THEN 257 CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 258 CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 259 ENDIF 260 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 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 ) 268 ENDIF 269 ELSE 270 IF(lwp) WRITE(numout,*) 271 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : no restart, set value at initial state ' 272 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 273 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface 274 ssh_ini(:,:) = sshn(:,:) ! initial ssh 275 DO jk = 1, jpk 276 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 277 e3t_ini (:,:,jk) = e3t_n(:,:,jk) * tmask(:,:,jk) ! initial vertical scale factors 278 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial heat content 279 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial salt content 280 END DO 281 frc_v = 0._wp ! volume trend due to forcing 282 frc_t = 0._wp ! heat content - - - - 283 frc_s = 0._wp ! salt content - - - - 284 IF( ln_linssh ) THEN 285 IF( ln_isfcav ) THEN 286 DO ji=1,jpi 287 DO jj=1,jpj 288 ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) ! initial heat content in ssh 289 ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) ! initial salt content in ssh 290 END DO 291 END DO 292 ELSE 293 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh 294 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh 295 END IF 296 frc_wn_t = 0._wp ! initial heat content misfit due to free surface 297 frc_wn_s = 0._wp ! initial salt content misfit due to free surface 298 ENDIF 299 ENDIF 300 ! 301 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 302 ! ! ------------------- 303 IF(lwp) WRITE(numout,*) 304 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : write restart at it= ', kt,' date= ', ndastp 305 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 306 307 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v ) 308 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t ) 309 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s ) 310 IF( ln_linssh ) THEN 311 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 312 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 313 ENDIF 314 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 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 ) 322 ENDIF 323 ! 324 ENDIF 325 ! 326 326 END SUBROUTINE dia_hsb_rst 327 327 … … 342 342 INTEGER :: ierror ! local integer 343 343 INTEGER :: ios 344 ! 344 !! 345 345 NAMELIST/namhsb/ ln_diahsb 346 346 !!---------------------------------------------------------------------- 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 347 ! 354 348 REWIND( numnam_ref ) ! Namelist namhsb in reference namelist 355 349 READ ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) … … 368 362 WRITE(numout,*) ' Namelist namhsb : set hsb parameters' 369 363 WRITE(numout,*) ' Switch for hsb diagnostic (T) or not (F) ln_diahsb = ', ln_diahsb 370 WRITE(numout,*)371 364 ENDIF 372 365 373 366 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 367 379 368 ! ------------------- ! … … 383 372 & e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), STAT=ierror ) 384 373 IF( ierror > 0 ) THEN 385 CALL ctl_stop( 'dia_hsb : unable to allocate hc_loc_ini' ) ; RETURN374 CALL ctl_stop( 'dia_hsb_init: unable to allocate hc_loc_ini' ) ; RETURN 386 375 ENDIF 387 376 388 377 IF( ln_linssh ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 389 378 IF( ierror > 0 ) THEN 390 CALL ctl_stop( 'dia_hsb : unable to allocate hc_loc_ini' ) ; RETURN379 CALL ctl_stop( 'dia_hsb_init: unable to allocate hc_loc_ini' ) ; RETURN 391 380 ENDIF 392 381 … … 394 383 ! 2 - Time independant variables and file opening ! 395 384 ! ----------------------------------------------- ! 396 IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated"397 IF(lwp) WRITE(numout,*) '~~~~~~~'385 IF(lwp) WRITE(numout,*) 386 IF(lwp) WRITE(numout,*) " heat salt volume budgets activated" 398 387 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area 399 388 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 400 389 401 IF( lk_bdy ) CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )390 IF( lk_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' ) 402 391 ! 403 392 ! ---------------------------------- !
Note: See TracChangeset
for help on using the changeset viewer.
