ROMS
Loading...
Searching...
No Matches
tl_main3d.F
Go to the documentation of this file.
1#include "cppdefs.h"
2#if defined TANGENT && defined SOLVE3D
3 SUBROUTINE tl_main3d (RunInterval)
4!
5!git $Id$
6!================================================== Hernan G. Arango ===
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md !
10!=======================================================================
11! !
12! This routine is the main driver for tangent linear ROMS when !
13! configurated as a full 3D baroclinic ocean model. It advances !
14! forward the tangent linear model equations for all nested grids, !
15! if any, by the specified time interval (seconds), RunInterval. !
16! !
17!=======================================================================
18!
19 USE mod_param
20 USE mod_parallel
21# if defined MODEL_COUPLING && defined MCT_LIB
22 USE mod_coupler
23# endif
24 USE mod_iounits
25# ifdef NESTING
26 USE mod_nesting
27# endif
28 USE mod_scalars
29 USE mod_stepping
30!
31# ifdef ANA_VMIX
32 USE analytical_mod, ONLY : ana_vmix
33# endif
34 USE dateclock_mod, ONLY : time_string
35# ifdef TLM_CHECK
37# endif
38# ifdef TIDE_GENERATING_FORCES
39 USE equilibrium_tide_mod, ONLY : equilibrium_tide
40# endif
41# if defined ATM_COUPLING_NOT_YET && defined MCT_LIB
42 USE mct_coupler_mod, ONLY : ocn2atm_coupling
43# endif
44# if defined WAV_COUPLING_NOT_YET && defined MCT_LIB
45 USE mct_coupler_mod, ONLY : ocn2wav_coupling
46# endif
47# if defined FORWARD_READ || defined JEDI
48 USE omega_mod, ONLY : omega
49 USE set_depth_mod, ONLY : set_depth
51# endif
52 USE strings_mod, ONLY : founderror
53# ifdef BIOLOGY
54 USE tl_biology_mod, ONLY : tl_biology
55# endif
56# ifdef BBL_MODEL_NOT_YET
57!! USE tl_bbl_mod, ONLY : tl_bblm
58# endif
59# if defined BULK_FLUXES_NOT_YET && !defined PRIOR_BULK_FLUXES
60!! USE tl_bulk_flux_mod, ONLY : tl_bulk_flux
61# endif
62# ifdef BVF_MIXING_NOT_YET
63!! USE tl_bvf_mix_mod, ONLY : tl_bvf_mix
64# endif
65 USE tl_diag_mod, ONLY : tl_diag
66# if defined WEAK_CONSTRAINT || defined FORCING_SV
67 USE tl_forcing_mod, ONLY : tl_forcing
68# endif
69# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
71# endif
72# ifdef GLS_MIXING_NOT_YET
73!! USE tl_gls_corstep_mod, ONLY : tl_gls_corstep
74!! USE tl_gls_prestep_mod, ONLY : tl_gls_prestep
75# endif
76# ifdef LMD_MIXING_NOT_YET
77!! USE tl_lmd_vmix_mod, ONLY : tl_lmd_vmix
78# endif
79# ifdef MY25_MIXING_NOT_YET
80!! USE tl_my25_corstep_mod, ONLY : tl_my25_corstep
81!! USE tl_my25_prestep_mod, ONLY : tl_my25_prestep
82# endif
83# ifdef NESTING
84 USE nesting_mod, ONLY : nesting
85 USE tl_nesting_mod, ONLY : tl_nesting
86# ifndef ONE_WAY
87 USE nesting_mod, ONLY : do_twoway
88# endif
89# endif
90# ifdef ADJUST_BOUNDARY
94# endif
95 USE tl_omega_mod, ONLY : tl_omega
96# if !(defined FORCING_SV || defined JEDI)
98# endif
99# ifdef NEARSHORE_MELLOR_NOT_YET
100!! USE tl_radiation_stress_mod, ONLY : tl_radiation_stress
101# endif
102# ifndef TS_FIXED
103 USE tl_rho_eos_mod, ONLY : tl_rho_eos
104# endif
105 USE tl_rhs3d_mod, ONLY : tl_rhs3d
106# ifdef SEDIMENT_NOT_YET
107!! USE tl_sediment_mod, ONLY : tl_sediment
108# endif
109# ifdef TL_AVERAGES
110 USE tl_set_avg_mod, ONLY : tl_set_avg
111# endif
114# if defined SSH_TIDES_NOT_YET || defined UV_TIDES_NOT_YET
115!! USE tl_set_tides_mod, ONLY : tl_set_tides
116# endif
117 USE tl_set_vbc_mod, ONLY : tl_set_vbc
118 USE tl_set_zeta_mod, ONLY : tl_set_zeta
119 USE tl_step2d_mod, ONLY : tl_step2d
120# ifndef TS_FIXED
121 USE tl_step3d_t_mod, ONLY : tl_step3d_t
122# endif
124# ifdef FLOATS_NOT_YET
125!! USE tl_step_floats_mod, ONLY : tl_step_floats
126# endif
127!! USE wvelocity_mod, ONLY : wvelocity
128!
129 implicit none
130!
131! Imported variable declarations.
132!
133 real(dp), intent(in) :: RunInterval
134!
135! Local variable declarations.
136!
137 logical :: DoNestLayer, Time_Step
138
139 integer :: Nsteps, Rsteps
140 integer :: ig, il, istep, ng, nl, tile
141 integer :: my_iif, next_indx1
142# ifdef FLOATS_NOT_YET
143 integer :: Lend, Lstr, chunk_size
144# endif
145!
146 real(r8) :: MaxDT, my_StepTime
147!
148 character (len=*), parameter :: MyFile = &
149 & __FILE__
150!
151!=======================================================================
152! Time-step tangent linear 3D primitive equations.
153!=======================================================================
154!
155! Time-step the 3D kernel for the specified time interval (seconds),
156! RunInterval.
157!
158 time_step=.true.
159 donestlayer=.true.
160!
161 kernel_loop : DO WHILE (time_step)
162!
163! In nesting applications, the number of nesting layers (NestLayers) is
164! used to facilitate refinement grids and composite/refinament grids
165! combinations. Otherwise, the solution it is looped once for a single
166! grid application (NestLayers = 1).
167!
168 nl=0
169#ifdef NESTING
170 twowayinterval(1:ngrids)=0.0_r8
171#endif
172!
173 nest_layer : DO WHILE (donestlayer)
174!
175! Determine number of time steps to compute in each nested grid layer
176! based on the specified time interval (seconds), RunInterval. Non
177! nesting applications have NestLayers=1. Notice that RunInterval is
178! set in the calling driver. Its value may span the full period of the
179! simulation, a multi-model coupling interval (RunInterval > ifac*dt),
180! or just a single step (RunInterval=0).
181!
182 CALL ntimesteps (itlm, runinterval, nl, nsteps, rsteps)
183 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
184 IF ((nl.le.0).or.(nl.gt.nestlayers)) EXIT
185!
186! Time-step governing equations for Nsteps.
187!
188 step_loop : DO istep=1,nsteps
189!
190! Set time indices and time clock.
191!
192 DO ig=1,gridsinlayer(nl)
193 ng=gridnumber(ig,nl)
194 nstp(ng)=1+mod(iic(ng)-ntstart(ng),2)
195 nnew(ng)=3-nstp(ng)
196 nrhs(ng)=nstp(ng)
197# ifdef JEDI
198 jic(ng)=jic(ng)+1
199 time4jedi(ng)=time4jedi(ng)+dt(ng)
200# endif
201 tdays(ng)=time(ng)*sec2day
202 IF (step_counter(ng).eq.rsteps) time_step=.false.
203 END DO
204!
205!-----------------------------------------------------------------------
206! Read in required data, if any, from input NetCDF files.
207!-----------------------------------------------------------------------
208!
209 DO ig=1,gridsinlayer(nl)
210 ng=gridnumber(ig,nl)
211!$OMP MASTER
212 IF (processinputdata(ng)) THEN
213 CALL tl_get_data (ng)
214 END IF
215!$OMP END MASTER
216!$OMP BARRIER
218 & __line__, myfile)) RETURN
219 END DO
220!
221!-----------------------------------------------------------------------
222! If applicable, process input data: time interpolate between data
223! snapshots. Compute BASIC STATE depths and thickness.
224!-----------------------------------------------------------------------
225!
226 DO ig=1,gridsinlayer(nl)
227 ng=gridnumber(ig,nl)
228 DO tile=first_tile(ng),last_tile(ng),+1
229 IF (processinputdata(ng)) THEN
230 CALL tl_set_data (ng, tile)
231 END IF
232# if defined FORWARD_READ || defined JEDI
233 CALL set_depth (ng, tile, itlm)
234# endif
235 END DO
236!$OMP BARRIER
237 END DO
238 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
239
240# if defined FORWARD_READ || defined JEDI
241!
242!-----------------------------------------------------------------------
243! Compute BASIC STATE horizontal mass fluxes (Hz*u/n and Hz*v/m).
244!-----------------------------------------------------------------------
245!
246 DO ig=1,gridsinlayer(nl)
247 ng=gridnumber(ig,nl)
248 DO tile=last_tile(ng),first_tile(ng),-1
249 CALL set_massflux (ng, tile, itlm)
250 END DO
251!$OMP BARRIER
252 END DO
253# endif
254
255# if (defined WEAK_CONSTRAINT || defined FORCING_SV) && \
256 !defined SP4DVAR
257!
258!-----------------------------------------------------------------------
259! If appropriate, add convolved adjoint solution impulse forcing to
260! the representer model solution. Notice that the forcing is only
261! needed after finishing all inner loops. The forcing is continuous.
262! That is, it is time interpolated at every time-step from available
263! snapshots (FrequentImpulse=TRUE).
264!-----------------------------------------------------------------------
265!
266 DO ig=1,gridsinlayer(nl)
267 ng=gridnumber(ig,nl)
268# ifdef WEAK_CONSTRAINT
269# ifdef WEAK_NOINTERP
270 IF ((iic(ng).gt.1).and.(iic(ng).ne.ntend(ng)+1).and. &
271 & (mod(iic(ng)-1,nadj(ng)).eq.0)) THEN
272 IF (master) THEN
273 WRITE (stdout,*) ' FORCING TLM at iic = ',iic(ng)
274 END IF
275# endif
276 IF (frequentimpulse(ng)) THEN
277 DO tile=first_tile(ng),last_tile(ng),+1
278 CALL tl_forcing (ng, tile, kstp(ng), nstp(ng))
279 CALL tl_set_depth (ng, tile, itlm)
280 END DO
281!$OMP BARRIER
282 END IF
283# ifdef WEAK_NOINTERP
284 END IF
285# endif
286# else
287 DO tile=first_tile(ng),last_tile(ng),+1
288 CALL tl_forcing (ng, tile, kstp(ng), nstp(ng))
289 CALL tl_set_depth (ng, tile, itlm)
290 END DO
291!$OMP BARRIER
292# endif
293 END DO
294# endif
295
296# if !(defined FORCING_SV || defined JEDI)
297!
298!-----------------------------------------------------------------------
299! On the first timestep, it computes the initial depths and level
300! thicknesses from the initial free-surface field. Additionally, it
301! initializes the tangent linear state variables for all time levels
302! and applies lateral boundary conditions.
303!-----------------------------------------------------------------------
304!
305 DO ig=1,gridsinlayer(nl)
306 ng=gridnumber(ig,nl)
307 IF (iic(ng).eq.ntstart(ng)) THEN
308 CALL tl_post_initial (ng, itlm)
309 END IF
310 END DO
311# endif
312!
313!-----------------------------------------------------------------------
314! Compute horizontal mass fluxes (Hz*u/n and Hz*v/m), density related
315! quatities and report global diagnostics. Compute BASIC STATE omega
316! vertical velocity.
317!-----------------------------------------------------------------------
318!
319 DO ig=1,gridsinlayer(nl)
320 ng=gridnumber(ig,nl)
321 DO tile=first_tile(ng),last_tile(ng),+1
322 CALL tl_set_massflux (ng, tile, itlm)
323# ifndef TS_FIXED
324 CALL tl_rho_eos (ng, tile, itlm)
325# endif
326# ifdef TIDE_GENERATING_FORCES
327 CALL equilibrium_tide (ng, tile, itlm)
328# endif
329 CALL tl_diag (ng, tile)
330# if defined FORWARD_READ || defined JEDI
331 CALL omega (ng, tile, itlm)
332# endif
333# ifdef TLM_CHECK
334 CALL tl_dotproduct (ng, tile, lnew(ng))
335# endif
336 END DO
337!$OMP BARRIER
338 END DO
339 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
340
341# if defined ATM_COUPLING_NOT_YET && defined MCT_LIB
342!
343!-----------------------------------------------------------------------
344! Couple to atmospheric model every CoupleSteps(Iatmos) timesteps: get
345! air/sea fluxes.
346!-----------------------------------------------------------------------
347!
348 DO ig=1,gridsinlayer(nl)
349 ng=gridnumber(ig,nl)
350 IF ((iic(ng).ne.ntstart(ng)).and. &
351 & mod(iic(ng)-1,couplesteps(iatmos,ng)).eq.0) THEN
352 DO tile=last_tile(ng),first_tile(ng),-1
353 CALL ocn2atm_coupling (ng, tile)
354 END DO
355!$OMP BARRIER
356 END IF
357 END DO
358# endif
359
360# if defined WAV_COUPLING_NOT_YET && defined MCT_LIB
361!
362!-----------------------------------------------------------------------
363! Couple to waves model every CoupleSteps(Iwaves) timesteps: get
364! waves/sea fluxes.
365!-----------------------------------------------------------------------
366!
367 DO ig=1,gridsinlayer(nl)
368 ng=gridnumber(ig,nl)
369 IF ((iic(ng).ne.ntstart(ng)).and. &
370 & mod(iic(ng)-1,couplesteps(iwaves,ng)).eq.0) THEN
371 DO tile=first_tile(ng),last_tile(ng),+1
372 CALL ocn2wav_coupling (ng, tile)
373 END DO
374!$OMP BARRIER
375 END IF
376 END DO
377# endif
378
379# ifdef NEARSHORE_MELLOR_NOT_YET
380!
381!-----------------------------------------------------------------------
382! Compute radiation stress terms.
383!-----------------------------------------------------------------------
384!
385 DO ig=1,gridsinlayer(nl)
386 ng=gridnumber(ig,nl)
387 DO tile=last_tile(ng),first_tile(ng),-1
388 CALL tl_radiation_stress (ng, tile)
389 END DO
390!$OMP BARRIER
391 END DO
392# endif
393!
394!-----------------------------------------------------------------------
395! Set fields for vertical boundary conditions. Process tidal forcing,
396! if any.
397!-----------------------------------------------------------------------
398!
399 DO ig=1,gridsinlayer(nl)
400 ng=gridnumber(ig,nl)
401 DO tile=first_tile(ng),last_tile(ng),+1
402# if defined BULK_FLUXES_NOT_YET && !defined PRIOR_BULK_FLUXES
403 CALL tl_bulk_flux (ng, tile)
404# endif
405# ifdef BBL_MODEL_NOT_YET
406 CALL tl_bblm (ng, tile)
407# endif
408 CALL tl_set_vbc (ng, tile)
409# if defined SSH_TIDES_NOT_YET || defined UV_TIDES_NOT_YET
410 CALL tl_set_tides (ng, tile)
411# endif
412 END DO
413!$OMP BARRIER
414 END DO
415
416# ifdef NESTING
417!
418! If composite or mosaic grids, process additional points in the
419! contact zone between connected grids for bottom stress variables.
420!
421 DO ig=1,gridsinlayer(nl)
422 ng=gridnumber(ig,nl)
423 IF (any(compositegrid(:,ng))) THEN
424 CALL tl_nesting (ng, itlm, nbstr)
425 END IF
426 END DO
427# endif
428
429# ifdef ADJUST_BOUNDARY
430!
431!-----------------------------------------------------------------------
432! Interpolate open boundary increments and adjust open boundaries.
433! Skip the last output timestep.
434!-----------------------------------------------------------------------
435!
436 DO ig=1,gridsinlayer(nl)
437 ng=gridnumber(ig,nl)
438 IF (iic(ng).lt.(ntend(ng)+1)) THEN
439 DO tile=first_tile(ng),last_tile(ng),+1
440 CALL tl_obc_adjust (ng, tile, lbinp(ng))
441 CALL tl_set_depth_bry (ng, tile, itlm)
442 CALL tl_obc2d_adjust (ng, tile, lbinp(ng))
443 END DO
444!$OMP BARRIER
445 END IF
446 END DO
447# endif
448
449# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
450!
451!-----------------------------------------------------------------------
452! Interpolate surface forcing increments and adjust surface forcing.
453! Skip the last output timestep.
454!-----------------------------------------------------------------------
455!
456 DO ig=1,gridsinlayer(nl)
457 ng=gridnumber(ig,nl)
458 IF (iic(ng).lt.(ntend(ng)+1)) THEN
459 DO tile=first_tile(ng),last_tile(ng),+1
460 CALL tl_frc_adjust (ng, tile, lfinp(ng))
461 END DO
462!$OMP BARRIER
463 END IF
464 END DO
465# endif
466!
467!-----------------------------------------------------------------------
468! Compute tangent linear vertical mixing coefficients for momentum and
469! tracers. Compute S-coordinate vertical velocity, diagnostically from
470! horizontal mass divergence.
471!-----------------------------------------------------------------------
472!
473 DO ig=1,gridsinlayer(nl)
474 ng=gridnumber(ig,nl)
475 DO tile=last_tile(ng),first_tile(ng),-1
476# if defined ANA_VMIX_NOT_YET
477 CALL tl_ana_vmix (ng, tile)
478# elif defined LMD_MIXING_NOT_YET
479 CALL tl_lmd_vmix (ng, tile)
480# elif defined BVF_MIXING_NOT_YET
481 CALL tl_bvf_mix (ng, tile)
482# endif
483 CALL tl_omega (ng, tile, itlm)
484!! CALL wvelocity (ng, tile, nstp(ng))
485 END DO
486!$OMP BARRIER
487 END DO
488!
489!-----------------------------------------------------------------------
490! Set free-surface to it time-averaged value. If applicable,
491! accumulate time-averaged output data which needs a irreversible
492! loop in shared-memory jobs.
493!-----------------------------------------------------------------------
494!
495 DO ig=1,gridsinlayer(nl)
496 ng=gridnumber(ig,nl)
497 DO tile=first_tile(ng),last_tile(ng),+1 ! irreversible
498 CALL tl_set_zeta (ng, tile)
499# ifdef DIAGNOSTICS
500!! CALL set_diags (ng, tile)
501# endif
502# ifdef TL_AVERAGES
503 CALL tl_set_avg (ng, tile)
504# endif
505 END DO
506!$OMP BARRIER
507 END DO
508
509# ifdef NESTING
510!
511! If composite or mosaic grids, process additional points in the
512! contact zone between connected grids for 3D kernel free-surface.
513!
514 DO ig=1,gridsinlayer(nl)
515 ng=gridnumber(ig,nl)
516 IF (any(compositegrid(:,ng))) THEN
517 CALL tl_nesting (ng, itlm, nzeta)
518 END IF
519 END DO
520# endif
521!
522!-----------------------------------------------------------------------
523! If appropriate, write out fields into output NetCDF files. Notice
524! that IO data is written in delayed and serial mode. Exit if last
525! time step.
526!-----------------------------------------------------------------------
527!
528 DO ig=1,gridsinlayer(nl)
529 ng=gridnumber(ig,nl)
530!$OMP MASTER
531 CALL tl_output (ng)
532!$OMP END MASTER
533!$OMP BARRIER
534 IF ((founderror(exit_flag, noerror, __line__, myfile)).or.&
535 & ((iic(ng).eq.(ntend(ng)+1)).and.(ng.eq.ngrids))) THEN
536 RETURN
537 END IF
538 END DO
539
540# ifdef NESTING
541!
542!-----------------------------------------------------------------------
543! If refinement grid, interpolate (space, time) state variables
544! contact points from donor grid extracted data.
545# ifdef NESTING_DEBUG
546!
547! Also, fill BRY_CONTACT(:,:)%Mflux to check for mass conservation
548! between coarse and fine grids. This is only done for diagnostic
549! purposes. Also, debugging is possible with very verbose output
550! to fort.300 is allowed by activating uppercase(nesting_debug).
551# endif
552!-----------------------------------------------------------------------
553!
554 DO ig=1,gridsinlayer(nl)
555 ng=gridnumber(ig,nl)
556 IF (refinedgrid(ng).and.(refinescale(ng).gt.0)) THEN
557 CALL tl_nesting (ng, itlm, nputd)
558# ifdef NESTING_DEBUG
559 CALL tl_nesting (ng, itlm, nmflx)
560# endif
561 END IF
562 END DO
563# endif
564!
565!-----------------------------------------------------------------------
566! Compute right-hand-side terms for 3D equations.
567!-----------------------------------------------------------------------
568!
569 DO ig=1,gridsinlayer(nl)
570 ng=gridnumber(ig,nl)
571 DO tile=last_tile(ng),first_tile(ng),-1
572 CALL tl_rhs3d (ng, tile)
573# ifdef MY25_MIXING_NOT_YET
574 CALL tl_my25_prestep (ng, tile)
575# elif defined GLS_MIXING_NOT_YET
576 CALL tl_gls_prestep (ng, tile)
577# endif
578 END DO
579!$OMP BARRIER
580 END DO
581
582# ifdef NESTING
583!
584! If composite or mosaic grids, process additional points in the
585! contact zone between connected grids for right-hand-side terms
586! (tracers).
587!
588 DO ig=1,gridsinlayer(nl)
589 ng=gridnumber(ig,nl)
590 IF (any(compositegrid(:,ng))) THEN
591 CALL tl_nesting (ng, itlm, nrhst)
592 END IF
593 END DO
594# endif
595!
596!-----------------------------------------------------------------------
597! Solve the vertically integrated primitive equations for the
598! free-surface and barotropic momentum components.
599!-----------------------------------------------------------------------
600!
601 loop_2d : DO my_iif=1,maxval(nfast)+1
602!
603! Set time indices for predictor step. The PREDICTOR_2D_STEP switch
604! it is assumed to be false before the first time-step.
605!
606 DO ig=1,gridsinlayer(nl)
607 ng=gridnumber(ig,nl)
608 next_indx1=3-indx1(ng)
609 IF (.not.predictor_2d_step(ng).and. &
610 & my_iif.le.(nfast(ng)+1)) THEN
611 predictor_2d_step(ng)=.true.
612 iif(ng)=my_iif
613 IF (first_2d_step) THEN
614 kstp(ng)=indx1(ng)
615 ELSE
616 kstp(ng)=3-indx1(ng)
617 END IF
618 knew(ng)=3
619 krhs(ng)=indx1(ng)
620 END IF
621!
622! Predictor step - Advance barotropic equations using 2D time-step
623! ============== predictor scheme. No actual time-stepping is
624! performed during the auxiliary (nfast+1) time-step. It is needed
625! to finalize the fast-time averaging of 2D fields, if any, and
626! compute the new time-evolving depths.
627!
628 IF (my_iif.le.(nfast(ng)+1)) THEN
629 DO tile=last_tile(ng),first_tile(ng),-1
630 CALL tl_step2d (ng, tile)
631 END DO
632!$OMP BARRIER
633 END IF
634 END DO
635
636# ifdef NESTING
637!
638! If composite or mosaic grids, process additional points in the
639! contact zone between connected grids for the state variables
640! associated with the 2D engine Predictor Step section.
641! If refinement, check mass flux conservation between coarse and
642! fine grids during debugging.
643# ifdef NESTING_DEBUG
644! Warning: very verbose output to fort.300 ascii file to check
645! mass flux conservation.
646# endif
647!
648 DO ig=1,gridsinlayer(nl)
649 ng=gridnumber(ig,nl)
650 IF (any(compositegrid(:,ng))) THEN
651 CALL tl_nesting (ng, itlm, n2dps)
652 END IF
653 IF (refinedgrid(ng).and.(refinescale(ng).gt.0)) THEN
654 CALL tl_nesting (ng, itlm, nmflx)
655 END IF
656 END DO
657# endif
658!
659! Set time indices for corrector step.
660!
661 DO ig=1,gridsinlayer(nl)
662 ng=gridnumber(ig,nl)
663 IF (predictor_2d_step(ng)) THEN
664 predictor_2d_step(ng)=.false.
665 knew(ng)=next_indx1
666 kstp(ng)=3-knew(ng)
667 krhs(ng)=3
668 IF (iif(ng).lt.(nfast(ng)+1)) indx1(ng)=next_indx1
669 END IF
670!
671! Corrector step - Apply 2D time-step corrector scheme. Notice that
672! ============== there is not need for a corrector step during the
673! auxiliary (nfast+1) time-step.
674!
675 IF (iif(ng).lt.(nfast(ng)+1)) THEN
676 DO tile=first_tile(ng),last_tile(ng),+1
677 CALL tl_step2d (ng, tile)
678 END DO
679!$OMP BARRIER
680 END IF
681 END DO
682
683# ifdef NESTING
684!
685! If composite or mosaic grids, process additional points in the
686! contact zone between connected grids for the state variables
687! associated with the 2D engine Corrector step section.
688! If refinement, check mass flux conservation between coarse and
689! fine grids during debugging.
690# ifdef NESTING_DEBUG
691! Warning: very verbose output to fort.300 ascii file to check
692! mass flux conservation.
693# endif
694!
695 DO ig=1,gridsinlayer(nl)
696 ng=gridnumber(ig,nl)
697 IF (any(compositegrid(:,ng))) THEN
698 CALL tl_nesting (ng, itlm, n2dcs)
699 END IF
700 IF (refinedgrid(ng).and.(refinescale(ng).gt.0)) THEN
701 CALL tl_nesting (ng, itlm, nmflx)
702 END IF
703 END DO
704# endif
705 END DO loop_2d
706
707# ifdef NESTING
708# if defined MASKING && defined WET_DRY
709!
710! If nesting and wetting and drying, scale horizontal interpolation
711! weights to account for land/sea masking in contact areas. This needs
712! to be done at very time-step since the Land/Sea masking is time
713! dependent.
714!
715 DO ig=1,gridsinlayer(nl)
716 ng=gridnumber(ig,nl)
717 CALL tl_nesting (ng, itlm, nmask)
718 END DO
719# endif
720!
721! If composite or mosaic grids, process additional points in the
722! contact zone between connected grids for the time-averaged
723! momentum fluxes (DU_avg1, DV_avg1) and free-surface (Zt_avg).
724!
725 DO ig=1,gridsinlayer(nl)
726 ng=gridnumber(ig,nl)
727 IF (any(compositegrid(:,ng))) THEN
728 CALL tl_nesting (ng, itlm, n2dfx)
729 END IF
730 END DO
731# endif
732!
733!-----------------------------------------------------------------------
734! Recompute depths and thicknesses using the new time filtered
735! free-surface.
736!-----------------------------------------------------------------------
737!
738 DO ig=1,gridsinlayer(nl)
739 ng=gridnumber(ig,nl)
740 DO tile=last_tile(ng),first_tile(ng),-1
741 CALL tl_set_depth (ng, tile, itlm)
742 END DO
743!$OMP BARRIER
744 END DO
745
746# ifdef NESTING
747!
748! If nesting, determine vertical indices and vertical interpolation
749! weights in the contact zone using new depth arrays.
750!
751 DO ig=1,gridsinlayer(nl)
752 ng=gridnumber(ig,nl)
753 CALL tl_nesting (ng, itlm, nzwgt)
754 END DO
755# endif
756!
757!-----------------------------------------------------------------------
758! Time-step 3D momentum equations.
759!-----------------------------------------------------------------------
760!
761! Time-step 3D momentum equations and couple with vertically
762! integrated equations.
763!
764 DO ig=1,gridsinlayer(nl)
765 ng=gridnumber(ig,nl)
766 DO tile=last_tile(ng),first_tile(ng),-1
767 CALL tl_step3d_uv (ng, tile)
768 END DO
769!$OMP BARRIER
770 END DO
771
772# ifdef NESTING
773!
774! If composite or mosaic grids, process additional points in the
775! contact zone between connected grids for 3D momentum (u,v),
776! adjusted 2D momentum (ubar,vbar), and fluxes (Huon, Hvom).
777!
778 DO ig=1,gridsinlayer(nl)
779 ng=gridnumber(ig,nl)
780 IF (any(compositegrid(:,ng))) THEN
781 CALL tl_nesting (ng, itlm, n3duv)
782 END IF
783 END DO
784# endif
785!
786!-----------------------------------------------------------------------
787! Time-step vertical mixing turbulent equations and passive tracer
788! source and sink terms, if applicable.
789!-----------------------------------------------------------------------
790!
791 DO ig=1,gridsinlayer(nl)
792 ng=gridnumber(ig,nl)
793 DO tile=first_tile(ng),last_tile(ng),+1
794 CALL tl_omega (ng, tile, itlm)
795# ifdef MY25_MIXING_NOT_YET
796 CALL tl_my25_corstep (ng, tile)
797# elif defined GLS_MIXING_NOT_YET
798 CALL tl_gls_corstep (ng, tile)
799# endif
800# ifdef BIOLOGY
801 CALL tl_biology (ng, tile)
802# endif
803# ifdef SEDIMENT_NOT_YET
804 CALL tl_sediment (ng, tile)
805# endif
806 END DO
807!$OMP BARRIER
808 END DO
809
810# ifndef TS_FIXED
811!
812!-----------------------------------------------------------------------
813! Time-step tracer equations.
814!-----------------------------------------------------------------------
815!
816 DO ig=1,gridsinlayer(nl)
817 ng=gridnumber(ig,nl)
818 DO tile=last_tile(ng),first_tile(ng),-1
819 CALL tl_step3d_t (ng, tile)
820 END DO
821!$OMP BARRIER
822 END DO
823
824# ifdef NESTING
825!
826! If composite or mosaic grids, process additional points in the
827! contact zone between connected grids for Tracer Variables.
828!
829 DO ig=1,gridsinlayer(nl)
830 ng=gridnumber(ig,nl)
831 IF (any(compositegrid(:,ng))) THEN
832 CALL tl_nesting (ng, itlm, n3dtv)
833 END IF
834 END DO
835# endif
836# endif
837
838# ifdef NESTING
839# ifndef ONE_WAY
840!
841!-----------------------------------------------------------------------
842! If refinement grids, perform two-way coupling between fine and
843! coarse grids. Correct coarse grid tracers values at the refinement
844! grid with refined accumulated fluxes. Then, replace coarse grid
845! state variable with averaged refined grid values (two-way nesting).
846! Update coarse grid depth variables.
847!
848! The two-way exchange of infomation between nested grids needs to be
849! done at the correct time-step and in the right sequence.
850!-----------------------------------------------------------------------
851!
852 DO il=nestlayers,1,-1
853 DO ig=1,gridsinlayer(il)
854 ng=gridnumber(ig,il)
855 IF (do_twoway(itlm, nl, il, ng, istep)) THEN
856 CALL tl_nesting (ng, itlm, n2way)
857 END IF
858 END DO
859 END DO
860# endif
861!
862!-----------------------------------------------------------------------
863! If donor to a finer grid, extract data for the external contact
864! points. This is the latest solution for the coarser grid.
865!
866! It is stored in the REFINED structure so it can be used for the
867! space-time interpolation when "nputD" argument is used above.
868!-----------------------------------------------------------------------
869!
870 DO ig=1,gridsinlayer(nl)
871 ng=gridnumber(ig,nl)
872 IF (donortofiner(ng)) THEN
873 CALL tl_nesting (ng, itlm, ngetd)
874 END IF
875 END DO
876# endif
877
878# ifdef FLOATS_NOT_YET
879!
880!-----------------------------------------------------------------------
881! Compute Lagrangian drifters trajectories: Split all the drifters
882! between all the computational threads, except in distributed-memory
883! and serial configurations. In distributed-memory, the parallel node
884! containing the drifter is selected internally since the state
885! variables do not have a global scope.
886!-----------------------------------------------------------------------
887!
888 DO ig=1,gridsinlayer(nl)
889 ng=gridnumber(ig,nl)
890 IF (lfloats(ng)) THEN
891# ifdef _OPENMP
892 chunk_size=(nfloats(ng)+numthreads-1)/numthreads
893 lstr=1+mythread*chunk_size
894 lend=min(nfloats(ng),lstr+chunk_size-1)
895# else
896 lstr=1
897 lend=nfloats(ng)
898# endif
899 CALL tl_step_floats (ng, lstr, lend)
900!$OMP BARRIER
901!
902! Shift floats time indices.
903!
904 nfp1(ng)=mod(nfp1(ng)+1,nft+1)
905 nf(ng)=mod(nf(ng)+1,nft+1)
906 nfm1(ng)=mod(nfm1(ng)+1,nft+1)
907 nfm2(ng)=mod(nfm2(ng)+1,nft+1)
908 nfm3(ng)=mod(nfm3(ng)+1,nft+1)
909 END IF
910 END DO
911# endif
912!
913!-----------------------------------------------------------------------
914! Advance time index and time clock.
915!-----------------------------------------------------------------------
916!
917 DO ig=1,gridsinlayer(nl)
918 ng=gridnumber(ig,nl)
919 iic(ng)=iic(ng)+1
920 time(ng)=time(ng)+dt(ng)
921 step_counter(ng)=step_counter(ng)-1
922 CALL time_string (time(ng), time_code(ng))
923 END DO
924
925 END DO step_loop
926
927 END DO nest_layer
928
929 END DO kernel_loop
930
931 RETURN
932 END SUBROUTINE tl_main3d
933#else
934 SUBROUTINE tl_main3d
935 RETURN
936 END SUBROUTINE tl_main3d
937#endif
subroutine ana_vmix(ng, tile, model)
Definition ana_vmix.h:3
subroutine, public time_string(mytime, date_string)
Definition dateclock.F:1272
subroutine, public tl_dotproduct(ng, tile, linp)
integer, dimension(:,:), allocatable couplesteps
integer iatmos
integer iwaves
integer stdout
integer, parameter nrhst
Definition mod_nesting.F:87
integer, parameter ngetd
Definition mod_nesting.F:77
integer, parameter n2dfx
Definition mod_nesting.F:92
integer, parameter nputd
Definition mod_nesting.F:79
integer, parameter nzeta
Definition mod_nesting.F:88
real(r8), dimension(:), allocatable twowayinterval
integer, parameter nzwgt
Definition mod_nesting.F:89
integer, parameter nmask
Definition mod_nesting.F:78
logical, dimension(:), allocatable donortofiner
integer, parameter n2way
Definition mod_nesting.F:80
integer, parameter n3duv
Definition mod_nesting.F:93
integer, parameter n2dps
Definition mod_nesting.F:90
integer, parameter n3dtv
Definition mod_nesting.F:94
integer, parameter nbstr
Definition mod_nesting.F:86
integer, parameter nmflx
Definition mod_nesting.F:75
integer, parameter n2dcs
Definition mod_nesting.F:91
integer numthreads
integer, dimension(:), allocatable first_tile
integer mythread
logical master
integer, dimension(:), allocatable last_tile
integer, dimension(:), allocatable nfloats
Definition mod_param.F:543
integer, dimension(:,:), allocatable gridnumber
Definition mod_param.F:127
integer nestlayers
Definition mod_param.F:118
integer, parameter nft
Definition mod_param.F:539
integer ngrids
Definition mod_param.F:113
integer, parameter itlm
Definition mod_param.F:663
integer, dimension(:), allocatable gridsinlayer
Definition mod_param.F:122
logical, dimension(:), allocatable lfloats
integer, dimension(:), allocatable iic
real(dp), dimension(:), allocatable dt
logical, dimension(:), allocatable predictor_2d_step
integer, dimension(:), allocatable jic
real(dp), dimension(:), allocatable tdays
logical, dimension(:), allocatable frequentimpulse
integer, dimension(:), allocatable nfast
real(dp), parameter sec2day
integer, dimension(:), allocatable ntend
character(len=22), dimension(:), allocatable time_code
integer exit_flag
real(dp), dimension(:), allocatable time4jedi
integer, dimension(:), allocatable indx1
logical, dimension(:,:), allocatable compositegrid
real(dp), dimension(:), allocatable time
logical, dimension(:), allocatable refinedgrid
integer, dimension(:), allocatable refinescale
integer, dimension(:), allocatable ntstart
integer, dimension(:), allocatable step_counter
logical, dimension(:), allocatable processinputdata
integer, dimension(:), allocatable nadj
integer, dimension(:), allocatable iif
integer noerror
integer, dimension(:), allocatable nfm2
integer, dimension(:), allocatable kstp
integer, dimension(:), allocatable knew
integer, dimension(:), allocatable nfm1
integer, dimension(:), allocatable nrhs
integer, dimension(:), allocatable lfinp
integer, dimension(:), allocatable lbinp
integer, dimension(:), allocatable nf
integer, dimension(:), allocatable nfm3
integer, dimension(:), allocatable nnew
integer, dimension(:), allocatable nfp1
integer, dimension(:), allocatable lnew
integer, dimension(:), allocatable krhs
integer, dimension(:), allocatable nstp
subroutine, public nesting(ng, model, isection)
Definition nesting.F:140
subroutine, public omega(ng, tile, model)
Definition omega.F:42
subroutine, public set_depth(ng, tile, model)
Definition set_depth.F:34
subroutine, public set_massflux(ng, tile, model)
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
subroutine, public tl_biology(ng, tile)
subroutine, public tl_diag(ng, tile)
Definition tl_diag.F:25
subroutine, public tl_forcing(ng, tile, kfrc, nfrc)
Definition tl_forcing.F:26
subroutine, public tl_frc_adjust(ng, tile, linp)
subroutine, public tl_nesting(ng, model, isection)
Definition tl_nesting.F:114
subroutine, public tl_obc2d_adjust(ng, tile, linp)
subroutine, public tl_obc_adjust(ng, tile, linp)
subroutine, public tl_omega(ng, tile, model)
Definition tl_omega.F:35
subroutine, public tl_post_initial(ng, model)
subroutine, public tl_rho_eos(ng, tile, model)
Definition tl_rho_eos.F:48
subroutine, public tl_rhs3d(ng, tile)
Definition tl_rhs3d.F:29
subroutine, public tl_set_avg(ng, tile)
Definition tl_set_avg.F:27
subroutine, public tl_set_depth_bry(ng, tile, model)
subroutine, public tl_set_depth(ng, tile, model)
subroutine, public tl_set_massflux(ng, tile, model)
subroutine, public tl_set_vbc(ng, tile)
Definition tl_set_vbc.F:33
subroutine, public tl_set_zeta(ng, tile)
Definition tl_set_zeta.F:27
subroutine, public tl_step2d(ng, tile)
subroutine, public tl_step3d_t(ng, tile)
Definition tl_step3d_t.F:47
subroutine, public tl_step3d_uv(ng, tile)
subroutine ntimesteps(model, runinterval, nl, nsteps, rsteps)
Definition ntimestep.F:3
subroutine tl_get_data(ng)
Definition tl_get_data.F:4
subroutine tl_main3d(runinterval)
Definition tl_main3d.F:4
subroutine tl_output(ng)
Definition tl_output.F:4
subroutine tl_set_data(ng, tile)
Definition tl_set_data.F:4