ad_output.F

Go to the documentation of this file.

#include "cppdefs.h"
#ifdef ADJOINT
      SUBROUTINE ad_output (ng)
!
!git $Id$
!================================================== Hernan G. Arango ===
!  Copyright (c) 2002-2025 The ROMS Group                              !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  This routine manages adjoint model output. It creates output NetCDF !
!  files and writes out data into NetCDF files.  If requested,  it can !
!  create several adjoint history files  to avoid generating too large !
!  files during a single model run.                                    !
!                                                                      !
!=======================================================================
!
      USE mod_param
      USE mod_parallel
      USE mod_iounits
      USE mod_ncparam
      USE mod_scalars
!
      USE ad_def_his_mod, ONLY : ad_def_his
      USE ad_wrt_his_mod, ONLY : ad_wrt_his
      USE close_io_mod,   ONLY : close_file
# ifdef AD_AVERAGES
      USE def_avg_mod,    ONLY : def_avg
# endif
# ifdef DISTRIBUTE
      USE distribute_mod, ONLY : mp_bcasts
# endif
      USE strings_mod,    ONLY : founderror
# ifdef AD_AVERAGES
      USE wrt_avg_mod,    ONLY : wrt_avg
# endif
!
      implicit none
!
!  Imported variables declarations.
!
      integer, intent(in) :: ng
!
!  Local variable declarations.
!
      logical :: Ldefine, Lupdate, NewFile, wrtHIS
 
      integer :: Fcount, ifile, status
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
      sourcefile=myfile
 
# ifdef PROFILE
!
!-----------------------------------------------------------------------
!  Turn on output data time wall clock.
!-----------------------------------------------------------------------
!
      CALL wclock_on (ng, iadm, 8, __line__, myfile)
# endif
!
!-----------------------------------------------------------------------
!  If appropriate, process adjoint 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.
!
#ifdef BIOLOGY
      lupdate=.true.
#else
      lupdate=.false.
#endif
!
!  Create output adjoint 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 (ldefadj(ng)) THEN
        IF (ndefadj(ng).gt.0) THEN
          IF (idefadj(ng).lt.0) THEN
            idefadj(ng)=((ntstart(ng)-1)/ndefadj(ng))*ndefadj(ng)
            IF (idefadj(ng).lt.iic(ng)-1) THEN
              idefadj(ng)=idefadj(ng)+ndefadj(ng)
            END IF
          END IF
          IF ((nrrec(ng).ne.0).and.(iic(ng).eq.ntstart(ng))) THEN
            IF ((iic(ng)-1).eq.idefadj(ng)) THEN
              adm(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
            idefadj(ng)=idefadj(ng)+nadj(ng)  ! restart offset
          ELSE IF ((iic(ng)-1).eq.idefadj(ng)) THEN
            idefadj(ng)=idefadj(ng)+ndefadj(ng)
            IF (nadj(ng).ne.ndefadj(ng).and.iic(ng).eq.ntstart(ng)) THEN
              idefadj(ng)=idefadj(ng)+nadj(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
              adm(ng)%load=0                    ! reset filename counter
            END IF
            ifile=(iic(ng)-1)/ndefadj(ng)+1     ! next filename suffix
            adm(ng)%load=adm(ng)%load+1
            IF (adm(ng)%load.gt.adm(ng)%Nfiles) THEN
              IF (master) THEN
                WRITE (stdout,10) 'TLM(ng)%load = ', adm(ng)%load,      &
     &                            adm(ng)%Nfiles, trim(adm(ng)%base),   &
     &                            ifile
              END IF
              exit_flag=4
              IF (founderror(exit_flag, noerror,                        &
     &                       __line__, myfile)) RETURN
            END IF
            fcount=adm(ng)%load
            adm(ng)%Nrec(fcount)=0
            IF (master) THEN
              WRITE (adm(ng)%name,20) trim(adm(ng)%base), ifile
            END IF
# ifdef DISTRIBUTE
            CALL mp_bcasts (ng, iadm, adm(ng)%name)
# endif
            adm(ng)%files(fcount)=trim(adm(ng)%name)
            CALL close_file (ng, iadm, adm(ng), adm(ng)%name, lupdate)
            CALL ad_def_his (ng, newfile)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
          IF ((iic(ng).eq.ntstart(ng)).and.(nrrec(ng).ne.0)) THEN
            lwrtadj(ng)=.false.                 ! avoid writing initial
          ELSE                                  ! fields during restart
            lwrtadj(ng)=.true.
          END IF
        ELSE
          IF (iic(ng).eq.ntstart(ng)) THEN
            CALL ad_def_his (ng, ldefout(ng))
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
            lwrtadj(ng)=.true.
            ldefadj(ng)=.false.
          END IF
        END IF
      END IF
!
!  Write out data into adjoint NetCDF file.
!
      IF (lwrtadj(ng)) THEN
        IF (lwrtper(ng)) THEN
          IF ((iic(ng).ne.ntstart(ng)).and.                             &
     &        (mod(iic(ng)-1,nadj(ng)).eq.0)) THEN
# ifdef DISTRIBUTE
            CALL ad_wrt_his (ng, myrank)
# else
            CALL ad_wrt_his (ng, -1)
# endif
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        ELSE
# ifdef HESSIAN_SO
          wrthis=(mod(iic(ng)-1,nadj(ng)).eq.0)   ! otherwise
# else
          IF (nadj(ng).eq.ntimes(ng)) THEN
            wrthis=(iic(ng).ne.ntstart(ng)).and.                        &
     &             (mod(iic(ng)-1,nadj(ng)).eq.0) ! avoid ntstart rec
          ELSE
#  if defined WEAK_CONSTRAINT && !defined WEAK_NOINTERP
#   ifdef SP4DVAR
            wrthis=(mod(iic(ng)-1,nadj(ng)).eq.0)
#   endif
            wrthis=(iic(ng).ne.ntstart(ng)).and.                        &
     &             (mod(iic(ng)-1,nadj(ng)).eq.0) ! avoid ntstart-1 rec
#  else
            wrthis=(mod(iic(ng)-1,nadj(ng)).eq.0) ! otherwise
#  endif
          END IF
# endif
          IF (wrthis) THEN
# ifdef DISTRIBUTE
            CALL ad_wrt_his (ng, myrank)
# else
            CALL ad_wrt_his (ng, -1)
# endif
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
          END IF
        END IF
      END IF
 
# ifdef AD_AVERAGES
!
!-----------------------------------------------------------------------
!  If appropriate, process time-averaged NetCDF file.
!-----------------------------------------------------------------------
!
!  Create output time-averaged 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 (ldefavg(ng)) THEN
        IF (ndefavg(ng).gt.0) THEN
          IF (idefavg(ng).lt.0) THEN
            idefavg(ng)=((ntstart(ng)-1)/ndefavg(ng))*ndefavg(ng)
            IF ((ndefavg(ng).eq.navg(ng)).and.(idefavg(ng).le.0)) THEN
              idefavg(ng)=ndefavg(ng)         ! one file per record
            ELSE IF (idefavg(ng).lt.iic(ng)-1) THEN
              idefavg(ng)=idefavg(ng)+ndefavg(ng)
            END IF
          END IF
          IF ((nrrec(ng).ne.0).and.(iic(ng).eq.ntstart(ng))) THEN
            IF ((iic(ng)-1).eq.idefavg(ng)) THEN
              ldefine=.false.                 ! finished file, delay
            ELSE                              ! creation of next file
              newfile=.false.
              ldefine=.true.                  ! unfinished file, inquire
            END IF                            ! content for appending
            idefavg(ng)=idefavg(ng)+navg(ng)  ! restart offset
          ELSE IF ((iic(ng)-1).eq.idefavg(ng)) THEN
            idefavg(ng)=idefavg(ng)+ndefavg(ng)
            IF (navg(ng).ne.ndefavg(ng).and.iic(ng).eq.ntstart(ng)) THEN
              idefavg(ng)=idefavg(ng)+navg(ng)
            END IF
            ldefine=.true.
            newfile=.true.
          ELSE
            ldefine=.false.
          END IF
          IF (ldefine) THEN
            IF (iic(ng).eq.ntstart(ng)) THEN
              avg(ng)%load=0                  ! reset filename counter
            END IF
            IF (ndefavg(ng).eq.navg(ng)) THEN ! next filename suffix
              ifile=(iic(ng)-1)/ndefavg(ng)
            ELSE
              ifile=(iic(ng)-1)/ndefavg(ng)+1
            END IF
            avg(ng)%load=avg(ng)%load+1
            IF (avg(ng)%load.gt.avg(ng)%Nfiles) THEN
              IF (master) THEN
                WRITE (stdout,10) 'AVG(ng)%load = ', avg(ng)%load,      &
     &                            avg(ng)%Nfiles, trim(avg(ng)%base),   &
     &                            ifile
              END IF
              exit_flag=4
              IF (founderror(exit_flag, noerror,                        &
     &                       __line__, myfile)) RETURN
            END IF
            fcount=avg(ng)%load
            avg(ng)%Nrec(fcount)=0
            IF (master) THEN
              WRITE (avg(ng)%name,20) trim(avg(ng)%base), ifile
            END IF
#  ifdef DISTRIBUTE
            CALL mp_bcasts (ng, iadm, avg(ng)%name)
#  endif
            avg(ng)%files(fcount)=trim(avg(ng)%name)
            CALL close_file (ng, iadm, adm(ng), adm(ng)%name, lupdate)
            CALL def_avg (ng, newfile)
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
            lwrtavg(ng)=.true.
          END IF
        ELSE
          IF (iic(ng).eq.ntstart(ng)) THEN
            CALL def_avg (ng, ldefout(ng))
            IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
            lwrtavg(ng)=.true.
            ldefavg(ng)=.false.
          END IF
        END IF
      END IF
!
!  Write out data into time-averaged NetCDF file.
!
      IF (lwrtavg(ng)) THEN
        IF ((iic(ng).ne.ntstart(ng)).and.                               &
     &      (mod(iic(ng),navg(ng)).eq.1)) THEN
#  ifdef DISTRIBUTE
          CALL wrt_avg (ng, myrank)
#  else
          CALL wrt_avg (ng, -1)
#  endif
          IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
        END IF
      END IF
# endif
 
# ifdef PROFILE
!
!-----------------------------------------------------------------------
!  Turn off output data time wall clock.
!-----------------------------------------------------------------------
!
      CALL wclock_off (ng, iadm, 8, __line__, myfile)
# endif
!
 10   FORMAT (/,' AD_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 ad_output
#else
      SUBROUTINE ad_output
      RETURN
      END SUBROUTINE ad_output
#endif