Changeset 14201 for NEMO/trunk/src/OCE/stpmlf.F90
- Timestamp:
- 2020-12-17T17:14:55+01:00 (4 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/stpmlf.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/stpmlf.F90
r14143 r14201 35 35 !! 4.x ! 2020-08 (S. Techene, G. Madec) quasi eulerian coordinate time stepping 36 36 !!---------------------------------------------------------------------- 37 38 37 #if defined key_qco || defined key_linssh 39 38 !!---------------------------------------------------------------------- … … 42 41 !! 'key_linssh Fixed in time vertical coordinate 43 42 !!---------------------------------------------------------------------- 44 43 !! 45 44 !!---------------------------------------------------------------------- 46 45 !! stp_MLF : NEMO modified Leap Frog time-stepping with qco or linssh … … 49 48 ! 50 49 USE domqco ! quasi-eulerian coordinate 51 USE traatf_qco ! time filtering 52 USE dynatf_qco ! time filtering 50 USE traatf_qco ! time filtering (tra_atf_qco routine) 51 USE dynatf_qco ! time filtering (dyn_atf_qco routine) 53 52 54 53 USE bdydyn ! ocean open boundary conditions (define bdy_dyn) … … 60 59 IMPLICIT NONE 61 60 PRIVATE 62 61 63 62 PUBLIC stp_MLF ! called by nemogcm.F90 64 63 … … 67 66 68 67 !! * Substitutions 68 # include "do_loop_substitute.h90" 69 69 # include "domzgr_substitute.h90" 70 70 !!---------------------------------------------------------------------- … … 98 98 !! -8- Outputs and diagnostics 99 99 !!---------------------------------------------------------------------- 100 INTEGER :: ji, jj, jk ! dummy loop indice 101 INTEGER :: indic ! error indicator if < 0 100 INTEGER :: ji, jj, jk, jtile ! dummy loop indice 102 101 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgdept 103 102 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zssh_f 104 103 !! --------------------------------------------------------------------- 105 104 #if defined key_agrif 105 IF( nstop > 0 ) RETURN ! avoid to go further if an error was detected during previous time step (child grid) 106 106 kstp = nit000 + Agrif_Nb_Step() 107 107 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices … … 130 130 ! update I/O and calendar 131 131 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 132 indic = 0 ! reset to no error condition 133 132 ! 134 133 IF( kstp == nit000 ) THEN ! initialize IOM context (must be done after nemo_init for AGRIF+XIOS+OASIS) 135 CALL iom_init( cxios_context, ld_closedef=.FALSE. ) ! for model grid (including p assible AGRIF zoom)134 CALL iom_init( cxios_context, ld_closedef=.FALSE. ) ! for model grid (including possible AGRIF zoom) 136 135 IF( lk_diamlr ) CALL dia_mlr_iom_init ! with additional setup for multiple-linear-regression analysis 137 136 CALL iom_init_closedef 138 137 IF( ln_crs ) CALL iom_init( TRIM(cxios_context)//"_crs" ) ! for coarse grid 139 138 ENDIF 139 IF( kstp == nitrst .AND. lwxios ) THEN 140 CALL iom_swap( cw_ocerst_cxt ) 141 CALL iom_init_closedef( cw_ocerst_cxt ) 142 CALL iom_setkt( kstp - nit000 + 1, cw_ocerst_cxt ) 143 #if defined key_top 144 CALL iom_swap( cw_toprst_cxt ) 145 CALL iom_init_closedef( cw_toprst_cxt ) 146 CALL iom_setkt( kstp - nit000 + 1, cw_toprst_cxt ) 147 #endif 148 ENDIF 149 #if defined key_si3 150 IF( kstp + nn_fsbc - 1 == nitrst .AND. lwxios ) THEN 151 CALL iom_swap( cw_icerst_cxt ) 152 CALL iom_init_closedef( cw_icerst_cxt ) 153 CALL iom_setkt( kstp - nit000 + 1, cw_icerst_cxt ) 154 ENDIF 155 #endif 140 156 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 141 157 CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! tell IOM we are at time step kstp … … 154 170 ! Update stochastic parameters and random T/S fluctuations 155 171 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 156 IF( ln_sto_eos ) CALL sto_par( kstp )! Stochastic parameters157 IF( ln_sto_eos ) CALL sto_pts( ts(:,:,:,:,Nnn) )! Random T/S fluctuations172 IF( ln_sto_eos ) CALL sto_par( kstp ) ! Stochastic parameters 173 IF( ln_sto_eos ) CALL sto_pts( ts(:,:,:,:,Nnn) ) ! Random T/S fluctuations 158 174 159 175 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 197 213 zgdept(:,:,jk) = gdept(:,:,jk,Nnn) 198 214 END DO 199 CALL ssh_nxt ( kstp, Nbb, Nnn, ssh, Naa ) ! after ssh (includes call to div_hor) 200 IF( .NOT.lk_linssh ) THEN 201 CALL dom_qco_r3c( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa) ) ! "after" ssh/h_0 ratio at t,u,v pts 202 IF( ln_dynspg_exp ) CALL dom_qco_r3c( ssh(:,:,Nnn), r3t(:,:,Nnn), r3u(:,:,Nnn), r3v(:,:,Nnn), r3f(:,:) ) ! spg_exp : needed only for "now" ssh/h_0 ratio at f point 203 ENDIF 204 CALL wzv ( kstp, Nbb, Nnn, Naa, ww ) ! Nnn cross-level velocity 205 IF( ln_zad_Aimp ) CALL wAimp ( kstp, Nnn ) ! Adaptive-implicit vertical advection partitioning 206 CALL eos ( ts(:,:,:,:,Nnn), rhd, rhop, zgdept ) ! now in situ density for hpg computation 215 CALL ssh_nxt ( kstp, Nbb, Nnn, ssh, Naa ) ! after ssh (includes call to div_hor) 216 IF( .NOT.lk_linssh ) THEN 217 CALL dom_qco_r3c( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa) ) ! "after" ssh/h_0 ratio at t,u,v pts 218 IF( ln_dynspg_exp ) & 219 & CALL dom_qco_r3c( ssh(:,:,Nnn), r3t(:,:,Nnn), r3u(:,:,Nnn), r3v(:,:,Nnn), r3f(:,:) ) ! spg_exp : needed only for "now" ssh/h_0 ratio at f point 220 ENDIF 221 CALL wzv ( kstp, Nbb, Nnn, Naa, ww ) ! Nnn cross-level velocity 222 IF( ln_zad_Aimp ) CALL wAimp ( kstp, Nnn ) ! Adaptive-implicit vertical advection partitioning 223 CALL eos ( ts(:,:,:,:,Nnn), rhd, rhop, zgdept ) ! now in situ density for hpg computation 207 224 208 225 … … 223 240 CALL dyn_hpg( kstp, Nnn , uu, vv, Nrhs ) ! horizontal gradient of Hydrostatic pressure 224 241 CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa ) ! surface pressure gradient 242 225 243 ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs) as well 226 227 244 IF( ln_dynspg_ts ) THEN ! vertical scale factors and vertical velocity need to be updated 228 245 CALL div_hor ( kstp, Nbb, Nnn ) ! Horizontal divergence (2nd call in time-split case) … … 270 287 ! Active tracers 271 288 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 272 ts(:,:,:,:,Nrhs) = 0._wp ! set tracer trends to zero 273 274 IF( lk_asminc .AND. ln_asmiau .AND. & 275 & ln_trainc ) CALL tra_asm_inc( kstp, Nbb, Nnn, ts, Nrhs ) ! apply tracer assimilation increment 276 CALL tra_sbc ( kstp, Nnn, ts, Nrhs ) ! surface boundary condition 277 IF( ln_traqsr ) CALL tra_qsr ( kstp, Nnn, ts, Nrhs ) ! penetrative solar radiation qsr 278 IF( ln_isf ) CALL tra_isf ( kstp, Nnn, ts, Nrhs ) ! ice shelf heat flux 279 IF( ln_trabbc ) CALL tra_bbc ( kstp, Nnn, ts, Nrhs ) ! bottom heat flux 280 IF( ln_trabbl ) CALL tra_bbl ( kstp, Nbb, Nnn, ts, Nrhs ) ! advective (and/or diffusive) bottom boundary layer scheme 281 IF( ln_tradmp ) CALL tra_dmp ( kstp, Nbb, Nnn, ts, Nrhs ) ! internal damping trends 282 IF( ln_bdy ) CALL bdy_tra_dmp( kstp, Nbb, ts, Nrhs ) ! bdy damping trends 283 #if defined key_agrif 284 IF(.NOT. Agrif_Root()) & 285 & CALL Agrif_Sponge_tra ! tracers sponge 286 #endif 287 CALL tra_adv ( kstp, Nbb, Nnn, ts, Nrhs ) ! hor. + vert. advection ==> RHS 288 IF( ln_zdfosm ) CALL tra_osm ( kstp, Nnn, ts, Nrhs ) ! OSMOSIS non-local tracer fluxes ==> RHS 289 IF( lrst_oce .AND. ln_zdfosm ) & 290 & CALL osm_rst ( kstp, Nnn, 'WRITE' ) ! write OSMOSIS outputs + ww (so must do here) to restarts 291 CALL tra_ldf ( kstp, Nbb, Nnn, ts, Nrhs ) ! lateral mixing 292 293 CALL tra_zdf ( kstp, Nbb, Nnn, Nrhs, ts, Naa ) ! vertical mixing and after tracer fields 294 IF( ln_zdfnpc ) CALL tra_npc ( kstp, Nnn, Nrhs, ts, Naa ) ! update after fields by non-penetrative convection 295 289 ! Loop over tile domains 290 DO jtile = 1, nijtile 291 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 292 293 DO_3D( 0, 0, 0, 0, 1, jpk ) 294 ts(ji,jj,jk,:,Nrhs) = 0._wp ! set tracer trends to zero 295 END_3D 296 297 IF( lk_asminc .AND. ln_asmiau .AND. & 298 & ln_trainc ) CALL tra_asm_inc( kstp, Nbb, Nnn, ts, Nrhs ) ! apply tracer assimilation increment 299 CALL tra_sbc ( kstp, Nnn, ts, Nrhs ) ! surface boundary condition 300 IF( ln_traqsr ) CALL tra_qsr ( kstp, Nnn, ts, Nrhs ) ! penetrative solar radiation qsr 301 IF( ln_isf ) CALL tra_isf ( kstp, Nnn, ts, Nrhs ) ! ice shelf heat flux 302 IF( ln_trabbc ) CALL tra_bbc ( kstp, Nnn, ts, Nrhs ) ! bottom heat flux 303 IF( ln_trabbl ) CALL tra_bbl ( kstp, Nbb, Nnn, ts, Nrhs ) ! advective (and/or diffusive) bottom boundary layer scheme 304 IF( ln_tradmp ) CALL tra_dmp ( kstp, Nbb, Nnn, ts, Nrhs ) ! internal damping trends 305 IF( ln_bdy ) CALL bdy_tra_dmp( kstp, Nbb, ts, Nrhs ) ! bdy damping trends 306 END DO 307 308 #if defined key_agrif 309 IF(.NOT. Agrif_Root()) THEN 310 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 311 CALL Agrif_Sponge_tra ! tracers sponge 312 ENDIF 313 #endif 314 315 ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling) 316 DO jtile = 1, nijtile 317 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 318 319 CALL tra_adv ( kstp, Nbb, Nnn, ts, Nrhs ) ! hor. + vert. advection ==> RHS 320 IF( ln_zdfmfc ) CALL tra_mfc ( kstp, Nbb, ts, Nrhs ) ! Mass Flux Convection 321 IF( ln_zdfosm ) CALL tra_osm ( kstp, Nnn, ts, Nrhs ) ! OSMOSIS non-local tracer fluxes ==> RHS 322 IF( lrst_oce .AND. ln_zdfosm ) & 323 & CALL osm_rst ( kstp, Nnn, 'WRITE' ) ! write OSMOSIS outputs + ww (so must do here) to restarts 324 CALL tra_ldf ( kstp, Nbb, Nnn, ts, Nrhs ) ! lateral mixing 325 326 CALL tra_zdf ( kstp, Nbb, Nnn, Nrhs, ts, Naa ) ! vertical mixing and after tracer fields 327 IF( ln_zdfnpc ) CALL tra_npc ( kstp, Nnn, Nrhs, ts, Naa ) ! update after fields by non-penetrative convection 328 END DO 329 330 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Revert to tile over full domain 296 331 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 297 332 ! Set boundary conditions, time filter and swap time levels … … 319 354 r3v(:,:,Nnn) = r3v_f(:,:) 320 355 ENDIF 321 322 356 ! 323 357 ! Swap time levels … … 340 374 #if defined key_agrif 341 375 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 342 ! AGRIF 376 ! AGRIF recursive integration 343 377 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 344 378 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 345 379 CALL Agrif_Integrate_ChildGrids( stp_MLF ) ! allows to finish all the Child Grids before updating 346 380 347 IF( Agrif_NbStepint() == 0 ) THEN 348 CALL Agrif_update_all( ) ! Update all components 349 ENDIF 350 #endif 351 IF( ln_diaobs ) CALL dia_obs ( kstp, Nnn ) ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 352 381 #endif 353 382 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 354 383 ! Control … … 356 385 CALL stp_ctl ( kstp, Nnn ) 357 386 387 #if defined key_agrif 388 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 389 ! AGRIF update 390 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 391 IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) & 392 & CALL Agrif_update_all( ) ! Update all components 393 ENDIF 394 395 #endif 396 IF( ln_diaobs .AND. nstop == 0 ) & 397 & CALL dia_obs( kstp, Nnn ) ! obs-minus-model (assimilation) diags (after dynamics update) 398 399 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 400 ! File manipulation at the end of the first time step 401 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 358 402 IF( kstp == nit000 ) THEN ! 1st time step only 359 403 CALL iom_close( numror ) ! close input ocean restart file 404 IF( lrxios ) CALL iom_context_finalize( cr_ocerst_cxt ) 360 405 IF(lwm) CALL FLUSH ( numond ) ! flush output namelist oce 361 406 IF(lwm .AND. numoni /= -1 ) CALL FLUSH ( numoni ) ! flush output namelist ice (if exist) … … 365 410 ! Coupled mode 366 411 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 367 !!gm why lk_oasis and not lk_cpl ???? 368 IF( lk_oasis ) CALL sbc_cpl_snd( kstp, Nbb, Nnn ) ! coupled mode : field exchanges 412 IF( lk_oasis .AND. nstop == 0 ) CALL sbc_cpl_snd( kstp, Nbb, Nnn ) ! coupled mode : field exchanges 369 413 ! 370 414 #if defined key_iomput 371 IF( kstp == nitend .OR. indic < 0 ) THEN 415 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 416 ! Finalize contextes if end of simulation or error detected 417 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 418 IF( kstp == nitend .OR. nstop > 0 ) THEN 372 419 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 373 420 IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) ! … … 376 423 ! 377 424 IF( l_1st_euler ) THEN ! recover Leap-frog timestep 378 rDt = 2._wp * rn_Dt 425 rDt = 2._wp * rn_Dt 379 426 r1_Dt = 1._wp / rDt 380 l_1st_euler = .FALSE. 427 l_1st_euler = .FALSE. 381 428 ENDIF 382 429 !
Note: See TracChangeset
for help on using the changeset viewer.
