SUBROUTINE ad_initial (ng) ! !git $Id$ !svn $Id: ad_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 adjoint model variables. ! ! ! !======================================================================= ! USE mod_param USE mod_parallel USE mod_coupling USE mod_forces USE mod_fourdvar USE mod_grid USE mod_iounits USE mod_mixing 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 set_depth_mod, ONLY : set_depth USE omega_mod, ONLY : omega USE rho_eos_mod, ONLY : rho_eos USE set_massflux_mod, ONLY : set_massflux USE obs_initial_mod, ONLY : obs_initial USE set_masks_mod, ONLY : set_masks USE stiffness_mod, ONLY : stiffness USE strings_mod, ONLY : FoundError ! implicit none ! ! Imported variable declarations. ! integer, intent(in) :: ng ! ! Local variable declarations. ! logical :: update = .FALSE. ! integer :: Fcount, IniRec, Tindex integer :: thread, tile ! real(dp) :: my_dstart ! character (len=*), parameter :: MyFile = & & "ROMS/Adjoint/ad_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) 'AD_INITIAL: Configuring and ', & & 'initializing adjoint 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)=3 knew(ng)=2 PREDICTOR_2D_STEP(ng)=.FALSE. ! iic(ng)=0 nstp(ng)=1 nnew(ng)=2 nrhs(ng)=nstp(ng) ! synchro_flag(ng)=.TRUE. first_time(ng)=0 ad_ubar_xs=0.0_r8 tdays(ng)=dstart+dt(ng)*REAL(ntimes(ng)-ntfirst(ng)+1,r8)*sec2day time(ng)=tdays(ng)*day2sec ntstart(ng)=ntimes(ng)+1 ntend(ng)=ntfirst(ng) ntfirst(ng)=ntend(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, iADM, 2, 205, MyFile) END DO ! !----------------------------------------------------------------------- ! If variational data assimilation, reset several IO switches and ! variables. !----------------------------------------------------------------------- ! ! Set switch to create adjoint NetCDF file or append to an existing ! adjoint NetCDF file. ! IF (Nrun.eq.ERstr) THEN LdefADJ(ng)=.TRUE. END IF ! ! Activate switch to write adjoint NetCDF file. ! LwrtADJ(ng)=.TRUE. ! !----------------------------------------------------------------------- ! 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, iADM) END DO ! !======================================================================= ! Initialize model state variables and forcing. This part is ! executed for each ensemble/perturbation/iteration pass. !======================================================================= ! !----------------------------------------------------------------------- ! Clear all adjoint variables. In variational data assimilation the ! initial condition are always zero and the forcing is only via the ! (model-observations) misfit terms. !----------------------------------------------------------------------- ! DO tile=first_tile(ng),last_tile(ng),+1 CALL initialize_ocean (ng, tile, iNLM) CALL initialize_forces (ng, tile, iNLM) CALL initialize_ocean (ng, tile, iADM) CALL initialize_coupling (ng, tile, iADM) CALL initialize_mixing (ng, tile, iADM) CALL initialize_forces (ng, tile, iADM) CALL initialize_grid (ng, tile, iADM) END DO ! !----------------------------------------------------------------------- ! Initialize various variables needed for processing observations ! backwards in time. 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, iADM, .TRUE.) IF (FoundError(exit_flag, NoError, 467, 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, iADM) CALL check_multifile (ng, iADM) CALL mp_bcasti (ng, iADM, exit_flag) IF (FoundError(exit_flag, NoError, 543, 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 ad_get_idata (ng) CALL ad_get_data (ng) CALL mp_bcasti (ng, iADM, exit_flag) IF (FoundError(exit_flag, NoError, 556, MyFile)) RETURN ! !----------------------------------------------------------------------- ! Set internal I/O mask arrays. !----------------------------------------------------------------------- ! DO tile=first_tile(ng),last_tile(ng),+1 CALL set_masks (ng, tile, iADM) END DO ! !----------------------------------------------------------------------- ! Compute grid stiffness. !----------------------------------------------------------------------- ! IF (Lstiffness) THEN Lstiffness=.FALSE. DO tile=first_tile(ng),last_tile(ng),+1 CALL stiffness (ng, tile, iADM) 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, iADM, 2, 663, MyFile) END DO RETURN END SUBROUTINE ad_initial