SUBROUTINE tl_initial (ng) ! !git $Id$ !svn $Id: tl_initial.F 1180 2023-07-13 02:42:10Z arango $ !================================================== Hernan G. Arango === ! Copyright (c) 2002-2023 The ROMS/TOMS Group ! ! Licensed under a MIT/X style license ! ! See License_ROMS.md ! !======================================================================= ! ! ! This routine initializes all tangent linear model variables. ! ! ! !======================================================================= ! USE mod_param USE mod_parallel USE mod_coupling USE mod_fourdvar USE mod_grid USE mod_iounits USE mod_ncparam USE mod_ocean USE mod_scalars USE mod_stepping ! ! USE analytical_mod USE close_io_mod, ONLY : close_inp USE dateclock_mod, ONLY : time_string USE distribute_mod, ONLY : mp_bcasti USE get_state_mod, ONLY : get_state USE ini_hmixcoef_mod, ONLY : ini_hmixcoef USE obs_initial_mod, ONLY : obs_initial USE set_depth_mod, ONLY : set_depth USE set_masks_mod, ONLY : set_masks USE stiffness_mod, ONLY : stiffness USE strings_mod, ONLY : FoundError USE tl_set_depth_mod, ONLY : tl_bath USE tl_def_ini_mod, ONLY : tl_def_ini USE tl_omega_mod, ONLY : tl_omega USE tl_rho_eos_mod, ONLY : tl_rho_eos USE tl_set_depth_mod, ONLY : tl_set_depth USE tl_set_massflux_mod, ONLY : tl_set_massflux USE tl_wrt_ini_mod, ONLY : tl_wrt_ini ! implicit none ! ! Imported variable declarations. ! integer, intent(in) :: ng ! ! Local variable declarations. ! logical :: update = .FALSE. ! integer :: Fcount, IniRec, Tindex, wrtRec integer :: thread, tile ! real(dp) :: my_dstart ! character (len=*), parameter :: MyFile = & & "ROMS/Tangent/tl_initial.F" ! !======================================================================= ! Initialize model variables. !======================================================================= ! IF (Master) THEN WRITE (stdout,10) outer, inner 10 FORMAT (/,' <<<< 4D Variational Data Assimilation, ', & & 'Outer = ',i3.3, ', Inner = ',i3.3,' >>>>',/) WRITE (stdout,20) 'TL_INITIAL: Configuring and ', & & 'initializing tangent linear model ...' 20 FORMAT (/,1x,a,a,/) END IF ! !----------------------------------------------------------------------- ! Initialize time stepping indices and counters. !----------------------------------------------------------------------- ! iif(ng)=1 indx1(ng)=1 next_kstp(ng)=1 kstp(ng)=1 krhs(ng)=1 knew(ng)=1 PREDICTOR_2D_STEP(ng)=.FALSE. ! iic(ng)=0 nstp(ng)=1 nrhs(ng)=1 nnew(ng)=1 ! synchro_flag(ng)=.TRUE. first_time(ng)=0 IF (ANY(tl_VolCons(:,ng))) THEN tl_ubar_xs=0.0_r8 END IF tdays(ng)=dstart time(ng)=tdays(ng)*day2sec ntstart(ng)=INT((time(ng)-dstart*day2sec)/dt(ng))+1 ntend(ng)=ntstart(ng)+ntimes(ng)-1 ntfirst(ng)=ntstart(ng) step_counter(ng)=0 ! IniRec=nrrec(ng) Tindex=1 ! ! Initialize global diagnostics variables. ! avgke=0.0_dp avgpe=0.0_dp avgkp=0.0_dp volume=0.0_dp ! !----------------------------------------------------------------------- ! Start time wall clocks. !----------------------------------------------------------------------- ! DO thread=MyRank,MyRank CALL wclock_on (ng, iTLM, 2, 212, MyFile) END DO ! !----------------------------------------------------------------------- ! If variational data assimilation, reset several IO switches and ! variables. !----------------------------------------------------------------------- ! ! Set record to read from initial tangent linear NetCDF file. ! IniRec=ITL(ng)%Rindex ! !----------------------------------------------------------------------- ! Set application grid, metrics, and associated variables and ! parameters. !----------------------------------------------------------------------- ! IF (SetGridConfig(ng)) THEN CALL set_grid (ng, iTLM) SetGridConfig(ng)=.FALSE. END IF ! !----------------------------------------------------------------------- ! Initialize horizontal mixing coefficients. If applicable, scale ! mixing coefficients according to the grid size (smallest area). ! Also increase their values in sponge areas using the "visc_factor" ! and/or "diff_factor" read from input Grid NetCDF file. !----------------------------------------------------------------------- ! DO tile=first_tile(ng),last_tile(ng),+1 CALL ini_hmixcoef (ng, tile, iTLM) END DO ! !======================================================================= ! Initialize model state variables and forcing. This part is ! executed for each ensemble/perturbation/iteration pass. !======================================================================= ! ! Clear tangent linear state variables. ! DO tile=first_tile(ng),last_tile(ng),+1 CALL initialize_ocean (ng, tile, iTLM) CALL initialize_coupling (ng, tile, 0) END DO ! !----------------------------------------------------------------------- ! Initialize tangent linear bathymetry to zero. !----------------------------------------------------------------------- ! DO tile=first_tile(ng),last_tile(ng),+1 CALL tl_bath (ng, tile) END DO ! !----------------------------------------------------------------------- ! Set tangent linear model state variables initial conditions. !----------------------------------------------------------------------- ! ! Read in initial conditions for initial or restart NetCDF file. ! CALL get_state (ng, iTLM, 1, ITL(ng), IniRec, Tindex) IF (FoundError(exit_flag, NoError, 492, MyFile)) RETURN time(ng)=io_time ! needed for shared-memory ! !----------------------------------------------------------------------- ! Open observations NetCDF file and initialize various variables ! needed for processing the tangent linear state solution at ! observation locations. Need to be done after processing initial ! conditions since the correct initial time is needed to determine ! the first "ObsTime" to process. !----------------------------------------------------------------------- ! CALL obs_initial (ng, iTLM, .FALSE.) IF (FoundError(exit_flag, NoError, 537, MyFile)) RETURN ! !----------------------------------------------------------------------- ! If applicable, close all input boundary, climatology, and forcing ! NetCDF files and set associated parameters to the closed state. This ! step is essential in iterative algorithms that run the full TLM ! repetitively. Then, Initialize several parameters in their file ! structure, so the appropriate input single or multi-file is selected ! during initialization/restart. !----------------------------------------------------------------------- ! CALL close_inp (ng, iTLM) CALL check_multifile (ng, iTLM) CALL mp_bcasti (ng, iTLM, exit_flag) IF (FoundError(exit_flag, NoError, 626, MyFile)) RETURN ! !----------------------------------------------------------------------- ! Read in initial forcing, climatology and assimilation data from ! input NetCDF files. It loads the first relevant data record for ! the time-interpolation between snapshots. !----------------------------------------------------------------------- ! CALL tl_get_idata (ng) CALL tl_get_data (ng) CALL mp_bcasti (ng, iTLM, exit_flag) IF (FoundError(exit_flag, NoError, 639, MyFile)) RETURN ! !----------------------------------------------------------------------- ! Set internal I/O mask arrays. !----------------------------------------------------------------------- ! DO tile=first_tile(ng),last_tile(ng),+1 CALL set_masks (ng, tile, iTLM) END DO ! !----------------------------------------------------------------------- ! If available, read in first TLM impulse forcing and its application ! time. In true weak constraint applications, the impulse records ! after the initial are associated with the model error and are ! processed with different statistics. If there is only one (initial) ! impulse forcing available, the assimilation tis similar to strong ! constraint but in observation space. !----------------------------------------------------------------------- ! IF (nADJ(ng).lt.ntimes(ng)) THEN IniRec=1 CALL get_state (ng, 7, 7, TLF(ng), IniRec, 1) IF (FoundError(exit_flag, NoError, 679, MyFile)) RETURN END IF ! !----------------------------------------------------------------------- ! Compute grid stiffness. !----------------------------------------------------------------------- ! IF (Lstiffness) THEN Lstiffness=.FALSE. DO tile=first_tile(ng),last_tile(ng),+1 CALL stiffness (ng, tile, iTLM) END DO END IF ! !----------------------------------------------------------------------- ! Initialize time-stepping counter. !----------------------------------------------------------------------- ! iic(ng)=ntstart(ng) CALL time_string (time(ng), time_code(ng)) ! !----------------------------------------------------------------------- ! Turn off initiialization time wall clock. !----------------------------------------------------------------------- ! DO thread=MyRank,MyRank CALL wclock_off (ng, iTLM, 2, 742, MyFile) END DO ! RETURN END SUBROUTINE tl_initial