Changeset 9169 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA
- Timestamp:
- 2017-12-26T17:32:56+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r9168 r9169 231 231 232 232 SUBROUTINE dia_hsb_rst( kt, cdrw ) 233 !!---------------------------------------------------------------------234 !! *** ROUTINE dia_hsb_rst ***235 !!236 !! ** Purpose : Read or write DIA file in restart file237 !!238 !! ** Method : use of IOM library239 !!----------------------------------------------------------------------240 INTEGER , INTENT(in) :: kt ! ocean time-step241 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag242 !243 INTEGER :: ji, jj, jk ! dummy loop indices244 !!----------------------------------------------------------------------245 !246 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise247 IF( ln_rstart ) THEN !* Read the restart file248 !249 IF(lwp) WRITE(numout,*) '~~~~~~~'250 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp251 IF(lwp) WRITE(numout,*) '~~~~~~~'252 CALL iom_get( numror, 'frc_v', frc_v )253 CALL iom_get( numror, 'frc_t', frc_t )254 CALL iom_get( numror, 'frc_s', frc_s )255 IF( ln_linssh ) THEN256 CALL iom_get( numror, 'frc_wn_t', frc_wn_t )257 CALL iom_get( numror, 'frc_wn_s', frc_wn_s )258 ENDIF259 CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling260 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) )261 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) )262 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) )263 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) )264 IF( ln_linssh ) THEN265 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) )266 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) )267 ENDIF268 ELSE269 IF(lwp) WRITE(numout,*) '~~~~~~~'270 IF(lwp) WRITE(numout,*) ' dia_hsb at initial state '271 IF(lwp) WRITE(numout,*) '~~~~~~~'272 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface273 ssh_ini(:,:) = sshn(:,:) ! initial ssh274 DO jk = 1, jpk275 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).276 e3t_ini (:,:,jk) = e3t_n(:,:,jk) * tmask(:,:,jk) ! initial vertical scale factors277 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial heat content278 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial salt content279 END DO280 frc_v = 0._wp ! volume trend due to forcing281 frc_t = 0._wp ! heat content - - - -282 frc_s = 0._wp ! salt content - - - -283 IF( ln_linssh ) THEN284 IF( ln_isfcav ) THEN285 DO ji=1,jpi286 DO jj=1,jpj287 ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) ! initial heat content in ssh288 ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) ! initial salt content in ssh289 ENDDO290 ENDDO291 ELSE292 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh293 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh294 END IF295 frc_wn_t = 0._wp ! initial heat content misfit due to free surface296 frc_wn_s = 0._wp ! initial salt content misfit due to free surface297 ENDIF298 ENDIF299 300 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file301 ! ! -------------------302 IF(lwp) WRITE(numout,*) '~~~~~~~'303 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp304 IF(lwp) WRITE(numout,*) '~~~~~~~'305 306 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v )307 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t )308 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s )309 IF( ln_linssh ) THEN310 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t )311 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s )312 ENDIF313 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini ) ! ice sheet coupling314 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 IF( ln_linssh ) THEN319 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(:,:) )321 ENDIF322 !323 ENDIF324 !233 !!--------------------------------------------------------------------- 234 !! *** ROUTINE dia_hsb_rst *** 235 !! 236 !! ** Purpose : Read or write DIA file in restart file 237 !! 238 !! ** Method : use of IOM library 239 !!---------------------------------------------------------------------- 240 INTEGER , INTENT(in) :: kt ! ocean time-step 241 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 242 ! 243 INTEGER :: ji, jj, jk ! dummy loop indices 244 !!---------------------------------------------------------------------- 245 ! 246 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 247 IF( ln_rstart ) THEN !* Read the restart file 248 ! 249 IF(lwp) WRITE(numout,*) 250 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : read hsb restart at it= ', kt,' date= ', ndastp 251 IF(lwp) WRITE(numout,*) 252 CALL iom_get( numror, 'frc_v', frc_v ) 253 CALL iom_get( numror, 'frc_t', frc_t ) 254 CALL iom_get( numror, 'frc_s', frc_s ) 255 IF( ln_linssh ) THEN 256 CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 257 CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 258 ENDIF 259 CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 260 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) ) 261 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) ) 262 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 263 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 264 IF( ln_linssh ) THEN 265 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 266 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 267 ENDIF 268 ELSE 269 IF(lwp) WRITE(numout,*) 270 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : initialise hsb at initial state ' 271 IF(lwp) WRITE(numout,*) 272 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface 273 ssh_ini(:,:) = sshn(:,:) ! initial ssh 274 DO jk = 1, jpk 275 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 276 e3t_ini (:,:,jk) = e3t_n(:,:,jk) * tmask(:,:,jk) ! initial vertical scale factors 277 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial heat content 278 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial salt content 279 END DO 280 frc_v = 0._wp ! volume trend due to forcing 281 frc_t = 0._wp ! heat content - - - - 282 frc_s = 0._wp ! salt content - - - - 283 IF( ln_linssh ) THEN 284 IF( ln_isfcav ) THEN 285 DO ji = 1, jpi 286 DO jj = 1, jpj 287 ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) ! initial heat content in ssh 288 ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) ! initial salt content in ssh 289 END DO 290 END DO 291 ELSE 292 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh 293 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh 294 END IF 295 frc_wn_t = 0._wp ! initial heat content misfit due to free surface 296 frc_wn_s = 0._wp ! initial salt content misfit due to free surface 297 ENDIF 298 ENDIF 299 ! 300 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 301 ! ! ------------------- 302 IF(lwp) WRITE(numout,*) 303 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : write restart at it= ', kt,' date= ', ndastp 304 IF(lwp) WRITE(numout,*) 305 ! 306 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v ) 307 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t ) 308 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s ) 309 IF( ln_linssh ) THEN 310 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 311 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 312 ENDIF 313 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini ) ! ice sheet coupling 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 IF( ln_linssh ) 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(:,:) ) 321 ENDIF 322 ! 323 ENDIF 324 ! 325 325 END SUBROUTINE dia_hsb_rst 326 326 … … 338 338 !! - Compute coefficients for conversion 339 339 !!--------------------------------------------------------------------------- 340 INTEGER :: ierror ! local integer 341 INTEGER :: ios 340 INTEGER :: ierror, ios ! local integer 342 341 !! 343 342 NAMELIST/namhsb/ ln_diahsb 344 343 !!---------------------------------------------------------------------- 345 344 ! 345 IF(lwp) THEN 346 WRITE(numout,*) 347 WRITE(numout,*) 'dia_hsb_init : heat and salt budgets diagnostics' 348 WRITE(numout,*) '~~~~~~~~~~~~ ' 349 ENDIF 346 350 REWIND( numnam_ref ) ! Namelist namhsb in reference namelist 347 351 READ ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) … … 350 354 READ ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 ) 351 355 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp ) 352 IF(lwm) WRITE 356 IF(lwm) WRITE( numond, namhsb ) 353 357 354 358 IF(lwp) THEN 355 WRITE(numout,*)356 WRITE(numout,*) 'dia_hsb_init : heat and salt budgets diagnostics'357 WRITE(numout,*) '~~~~~~~~~~~~ '358 359 WRITE(numout,*) ' Namelist namhsb :' 359 360 WRITE(numout,*) ' check the heat and salt budgets (T) or not (F) ln_diahsb = ', ln_diahsb
Note: See TracChangeset
for help on using the changeset viewer.
