SUBROUTINE tl_output (ng)
!
!git $Id$
!svn $Id: tl_output.F 1151 2023-02-09 03:08:53Z 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 manages tangent linear model output. It creates output !
! NetCDF files and writes out data into NetCDF files. If requested, !
! it can create several tangent history files to avoid generating too !
! large files during a single model run. !
! !
!=======================================================================
!
USE mod_param
USE mod_parallel
USE mod_fourdvar
USE mod_iounits
USE mod_ncparam
USE mod_scalars
!
USE close_io_mod, ONLY : close_file
USE distribute_mod, ONLY : mp_bcasts
USE obs_read_mod, ONLY : obs_read
USE obs_write_mod, ONLY : obs_write
USE strings_mod, ONLY : FoundError
USE tl_def_his_mod, ONLY : tl_def_his
USE tl_wrt_his_mod, ONLY : tl_wrt_his
!
implicit none
!
! Imported variable declarations.
!
integer, intent(in) :: ng
!
! Local variable declarations.
!
logical :: Ldefine, Lupdate, NewFile
!
integer :: Fcount, ifile, status, tile
!
character (len=*), parameter :: MyFile = &
& "ROMS/Tangent/tl_output.F"
!
SourceFile=MyFile
!
!-----------------------------------------------------------------------
! Turn on output data time wall clock.
!-----------------------------------------------------------------------
!
CALL wclock_on (ng, iTLM, 8, 70, MyFile)
!
!-----------------------------------------------------------------------
! If appropriate, process tangent linear history NetCDF file.
!-----------------------------------------------------------------------
!
! Turn off checking for analytical header files.
!
IF (Lanafile) THEN
Lanafile=.FALSE.
END IF
!
! If appropriate, set switch for updating biology header file global
! attribute in output NetCDF files.
!
Lupdate=.FALSE.
!
! Create output tangent NetCDF file or prepare existing file to
! append new data to it. Also, notice that it is possible to
! create several files during a single model run.
!
IF (LdefTLM(ng)) THEN
IF (ndefTLM(ng).gt.0) THEN
IF (idefTLM(ng).lt.0) THEN
idefTLM(ng)=((ntstart(ng)-1)/ndefTLM(ng))*ndefTLM(ng)
IF (idefTLM(ng).lt.iic(ng)-1) THEN
idefTLM(ng)=idefTLM(ng)+ndefTLM(ng)
END IF
END IF
IF ((nrrec(ng).ne.0).and.(iic(ng).eq.ntstart(ng))) THEN
IF ((iic(ng)-1).eq.idefTLM(ng)) THEN
TLM(ng)%load=0 ! restart, reset counter
Ldefine=.FALSE. ! finished file, delay
ELSE ! creation of next file
Ldefine=.TRUE.
NewFile=.FALSE. ! unfinished file, inquire
END IF ! content for appending
idefTLM(ng)=idefTLM(ng)+nTLM(ng) ! restart offset
ELSE IF ((iic(ng)-1).eq.idefTLM(ng)) THEN
idefTLM(ng)=idefTLM(ng)+ndefTLM(ng)
IF (nTLM(ng).ne.ndefTLM(ng).and.iic(ng).eq.ntstart(ng)) THEN
idefTLM(ng)=idefTLM(ng)+nTLM(ng) ! multiple record offset
END IF
Ldefine=.TRUE.
NewFile=.TRUE.
ELSE
Ldefine=.FALSE.
END IF
IF (Ldefine) THEN ! create new file or
IF (iic(ng).eq.ntstart(ng)) THEN ! inquire existing file
TLM(ng)%load=0 ! reset filename counter
END IF
ifile=(iic(ng)-1)/ndefTLM(ng)+1 ! next filename suffix
TLM(ng)%load=TLM(ng)%load+1
IF (TLM(ng)%load.gt.TLM(ng)%Nfiles) THEN
IF (Master) THEN
WRITE (stdout,10) 'TLM(ng)%load = ', TLM(ng)%load, &
& TLM(ng)%Nfiles, TRIM(TLM(ng)%base), &
& ifile
END IF
exit_flag=4
IF (FoundError(exit_flag, NoError, &
& 137, MyFile)) RETURN
END IF
Fcount=TLM(ng)%load
TLM(ng)%Nrec(Fcount)=0
IF (Master) THEN
WRITE (TLM(ng)%name,20) TRIM(TLM(ng)%base), ifile
END IF
CALL mp_bcasts (ng, iTLM, TLM(ng)%name)
TLM(ng)%files(Fcount)=TRIM(TLM(ng)%name)
CALL close_file (ng, iTLM, TLM(ng), TLM(ng)%name, Lupdate)
CALL tl_def_his (ng, NewFile)
IF (FoundError(exit_flag, NoError, 150, MyFile)) RETURN
END IF
IF ((iic(ng).eq.ntstart(ng)).and.(nrrec(ng).ne.0)) THEN
LwrtTLM(ng)=.FALSE. ! avoid writing initial
ELSE ! fields during restart
LwrtTLM(ng)=.TRUE.
END IF
ELSE
IF (iic(ng).eq.ntstart(ng)) THEN
CALL tl_def_his (ng, ldefout(ng))
IF (FoundError(exit_flag, NoError, 160, MyFile)) RETURN
LwrtTLM(ng)=.TRUE.
LdefTLM(ng)=.FALSE.
END IF
END IF
END IF
!
! Write out data into tangent NetCDF file. Avoid writing initial
! conditions in perturbation mode computations.
!
IF (LwrtTLM(ng)) THEN
IF (LwrtPER(ng)) THEN
IF ((iic(ng).gt.ntstart(ng)).and. &
& (MOD(iic(ng)-1,nTLM(ng)).eq.0)) THEN
CALL tl_wrt_his (ng, MyRank)
IF (FoundError(exit_flag, NoError, 193, MyFile)) RETURN
END IF
ELSE
IF ((MOD(iic(ng)-1,nTLM(ng)).eq.0).and. &
& ((nrrec(ng).eq.0).or.(iic(ng).ne.ntstart(ng)))) THEN
CALL tl_wrt_his (ng, MyRank)
IF (FoundError(exit_flag, NoError, 203, MyFile)) RETURN
END IF
END IF
END IF
!
!-----------------------------------------------------------------------
! If appropriate, process and write model state at observation
! locations. Compute misfit (model-observations) cost function.
!-----------------------------------------------------------------------
!
IF (((time(ng)-0.5_r8*dt(ng)).le.ObsTime(ng)).and. &
& (ObsTime(ng).lt.(time(ng)+0.5_r8*dt(ng)))) THEN
ProcessObs(ng)=.TRUE.
tile=MyRank
CALL obs_read (ng, iTLM, .FALSE.)
CALL obs_write (ng, tile, iTLM)
ELSE
ProcessObs(ng)=.FALSE.
END IF
!
!-----------------------------------------------------------------------
! Turn off output data time wall clock.
!-----------------------------------------------------------------------
!
CALL wclock_off (ng, iTLM, 8, 348, MyFile)
!
10 FORMAT (/,' TL_OUTPUT - multi-file counter ',a,i0, &
& ', is greater than Nfiles = ',i0,1x,'dimension', &
& /,13x,'in structure when creating next file: ', &
& a,'_',i4.4,'.nc', &
& /,13x,'Incorrect OutFiles logic in ''read_phypar''.')
20 FORMAT (a,'_',i4.4,'.nc')
!
RETURN
END SUBROUTINE tl_output