source: trunk/LMDZ.COMMON/libf/evolution/output.F90 @ 4180

MODULE output
!-----------------------------------------------------------------------
! NAME
!     output
!
! DESCRIPTION
!     Tools to write PEM diagnostic outputs.
!
! AUTHORS & DATE
!     JB Clement, 12/2025
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use numerics, only: dp, di, k4, eps

! DECLARATION
! -----------
implicit none

! PARAMETERS
! ----------
character(12),                             parameter, private :: diagdef_name = 'diagevo.def'
integer(di),                               parameter          :: dim_ngrid = -1_di    ! Dimension ID to identify 'ngrid' for "diagevo.nc" logic
logical(k4),                               protected, private :: is_diagdef = .false. ! Flag to know if "diagevo.def" exists
logical(k4),                               protected, private :: is_diagevo = .false. ! Flag to know if "diagevo.nc" exists
character(256), dimension(:), allocatable, protected, private :: outputs_name         ! Names of output variables defined in "diagevo.def"
integer(di),                               protected, private :: n_outputs            ! Number of output variables defined in "diagevo.def"
integer(di),                               protected, private :: output_rate          ! Output rate
integer(di),                               protected, private :: writing_idt = -1_di  ! Current writing number of timestep
integer(di),                               protected          :: dim_nlon, dim_nlat, dim_nalt, dim_interlayer, dim_nsoil, dim_time ! Dimensions ID to write in "diagevo.nc"

contains
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

!=======================================================================
SUBROUTINE ini_output()
!-----------------------------------------------------------------------
! NAME
!     ini_output
!
! DESCRIPTION
!     Initialize the parameters of module 'output'.
!
! AUTHORS & DATE
!     JB Clement, 12/2025
!
! NOTES
!     At first call.
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! CODE
! ----
n_outputs = 0
allocate(outputs_name(0))
call read_diagdef()

END SUBROUTINE ini_output
!=======================================================================

!=======================================================================
SUBROUTINE end_output()
!-----------------------------------------------------------------------
! NAME
!     end_output
!
! DESCRIPTION
!     Deallocate output arrays.
!
! AUTHORS & DATE
!     JB Clement, 01/2026
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! CODE
! ----
if (allocated(outputs_name)) deallocate(outputs_name)

END SUBROUTINE end_output
!=======================================================================

!=======================================================================
SUBROUTINE set_output_config(output_rate_in)
!-----------------------------------------------------------------------
! NAME
!     set_output_config
!
! DESCRIPTION
!     Setter for "output" configuration parameters.
!
! AUTHORS & DATE
!     JB Clement, 02/2026
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use utility,  only: int2str
use display,  only: print_msg, LVL_NFO
use stoppage, only: stop_clean

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
integer(di), intent(in) :: output_rate_in

! CODE
! ----
output_rate = output_rate_in
call print_msg('output_rate = '//int2str(output_rate),LVL_NFO)
if (output_rate < 1) call stop_clean(__FILE__,__LINE__,'''output_rate'' must be positive!',1)

END SUBROUTINE set_output_config
!=======================================================================

!=======================================================================
SUBROUTINE append_name(var_name)
!-----------------------------------------------------------------------
! NAME
!     append_name
!
! DESCRIPTION
!     Append the variable name read in "diagevo.def" to 'outputs_name'.
!
! AUTHORS & DATE
!     JB Clement, 01/2026
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
character(*), intent(in) :: var_name

! LOCAL VARIABLES
! ---------------
character(256), dimension(:), allocatable :: tmp

! CODE
! ----
allocate(tmp(n_outputs + 1))
if (n_outputs > 0) tmp(1:n_outputs) = outputs_name
tmp(n_outputs + 1) = var_name

call move_alloc(tmp,outputs_name)
n_outputs = n_outputs + 1

END SUBROUTINE append_name
!=======================================================================

!=======================================================================
SUBROUTINE read_diagdef()
!-----------------------------------------------------------------------
! NAME
!     read_diagdef
!
! DESCRIPTION
!     Read the variables names defined in "diagevo.def" to ouput.
!
! AUTHORS & DATE
!     JB Clement, 01/2026
!
! NOTES
!     > If no "diagevo.def", then no output.
!     > If "diagevo.def" is empty, then all the possible coded outputs.
!     > If "diagevo.def" holds a list of variable names, then these are
!     outputted.
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use stoppage, only: stop_clean
use utility,  only: is_id_1st_char, is_id_char, int2str
use display,  only: print_msg, LVL_NFO, LVL_WRN

! DECLARATION
! -----------
implicit none

! LOCAL VARIABLES
! ---------------
integer(di)    :: i, iline, ierr, funit
character(256) :: line

! CODE
! ----
inquire(file = diagdef_name,exist = is_diagdef)
if (is_diagdef) then
    call print_msg('> Reading "'//diagdef_name//'"',LVL_NFO)
    open(newunit = funit,file = diagdef_name,status = 'old',form = 'formatted',action = 'read',iostat = ierr)
    if (ierr /= 0) call stop_clean(__FILE__,__LINE__,'error opening file "'//diagdef_name//'"!',ierr)
    iline = 1
    do
        ! Read the line
        read(funit,'(a)',iostat = ierr) line
        if (ierr /= 0) exit ! Empty file or end of file
        iline = iline + 1

        ! Examine the line
        line = trim(line)
        if (len(line) == 0) cycle ! Ignore empty lines
        if (.not. is_id_1st_char(line(1:1))) call print_msg('Invalid output name at line '//int2str(iline)//' in '//diagdef_name//'"!',LVL_WRN)
        do i = 2,len(line)
            if (.not. is_id_char(line(i:i))) call print_msg('Invalid output name at line '//int2str(iline)//' in '//diagdef_name//'"!',LVL_WRN)
        end do

        ! Fill in the table 'outputs_name'
        call append_name(line)
    end do
    close(funit)
    if (n_outputs == 0) call print_msg('There is a "'//diagdef_name//'" which is is empty. So all the possible coded variables are outputted.',LVL_WRN)
    ! Create the output file
    call create_diagevo()
else
    call print_msg('There is no "'//diagdef_name//'". So no variable is outputted.',LVL_WRN)
end if

END SUBROUTINE read_diagdef
!=======================================================================

!=======================================================================
FUNCTION is_output_selected(var_name) RESULT(output_var)
!-----------------------------------------------------------------------
! NAME
!     is_output_selected
!
! DESCRIPTION
!     Read the variables names to output defined in "diagevo.def".
!
! AUTHORS & DATE
!     JB Clement, 01/2026
!
! NOTES
!     > If no "diagevo.def", then no output.
!     > If "diagevo.def" is empty, then all the possible coded outputs.
!     > If "diagevo.def" holds a list of variable names, then these are
!     outputted.
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
character(*), intent(in) :: var_name
logical(k4)              :: output_var

! LOCAL VARIABLES
! ---------------
integer(di) :: i

! CODE
! ----
output_var = .false.

! If diagdef exists but is empty, output everything
if (n_outputs == 0) then
    output_var = .true.
    return
end if

do i = 1,n_outputs
    if (trim(outputs_name(i)) == trim(var_name)) then
        output_var = .true.
        return
    end if
end do

END FUNCTION is_output_selected
!=======================================================================

!=======================================================================
SUBROUTINE create_diagevo()
!-----------------------------------------------------------------------
! NAME
!     create_diagevo
!
! DESCRIPTION
!     Create a NetCDF file "diagevo.nc" containing the diagnostic
!     variables.
!
! AUTHORS & DATE
!     JB Clement, 01/2026
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use netcdf,     only: nf90_double, nf90_clobber, nf90_unlimited, nf90_global, &
                      nf90_create, nf90_enddef, nf90_def_dim, nf90_def_var, nf90_put_att
use io_netcdf,  only: check_nc, open_nc, close_nc, put_var_nc, diagevo_name, ncid_diagevo
use geometry,   only: dim_init, ngrid, nlon, nlat, nlayer, nsoil, cell_area, longitudes, latitudes, vect2dyngrd
use stoppage,   only: stop_clean
use soil,       only: mlayer
use atmosphere, only: ap, bp
use display,    only: print_msg, LVL_NFO

! DECLARATION
! -----------
implicit none

! LOCAL VARIABLES
! ---------------
integer(di)                           :: varid ! Variable ID
integer(di)                           :: nlon_loc
real(dp), dimension(:,:), allocatable :: var_dyn

! CODE
! ----
! Check if dimensions are well initialized
if (.not. dim_init) call stop_clean(__FILE__,__LINE__,'dimensions are not initilized in the PEM!',1)
if (ngrid == 1) then ! 1D
    nlon_loc = 1
else ! 3D
    nlon_loc = nlon + 1
end if

! Create file
call print_msg('> Creating "'//diagevo_name//'"',LVL_NFO)
call check_nc(nf90_create(diagevo_name,nf90_clobber,ncid_diagevo),'creating '//diagevo_name) ! Enter define mode

! Define dimensions
call check_nc(nf90_def_dim(ncid_diagevo,'Time',NF90_UNLIMITED,dim_time),'defining dimension Time')
call check_nc(nf90_def_dim(ncid_diagevo,'longitude',nlon_loc,dim_nlon),'defining dimension longitude')
call check_nc(nf90_def_dim(ncid_diagevo,'latitude',nlat,dim_nlat),'defining dimension latitude')
call check_nc(nf90_def_dim(ncid_diagevo,'altitude',nlayer,dim_nalt),'defining dimension altitude')
call check_nc(nf90_def_dim(ncid_diagevo,'interlayer',nlayer + 1,dim_interlayer),'defining dimension interlayer')
call check_nc(nf90_def_dim(ncid_diagevo,'subsurface_layers',nsoil,dim_nsoil),'defining dimension subsurface_layers')

! Define variables
call check_nc(nf90_def_var(ncid_diagevo,'Time',nf90_double,(/dim_time/),varid),'defining variable Time')
call check_nc(nf90_put_att(ncid_diagevo,varid,'title','Year of run'),'putting title attribute for Time')
call check_nc(nf90_put_att(ncid_diagevo,varid,'units','Planetary year'),'putting units attribute for Time')

call check_nc(nf90_def_var(ncid_diagevo,'longitude',nf90_double,(/dim_nlon/),varid),'defining variable longitude')
call check_nc(nf90_put_att(ncid_diagevo,varid,'title','Longitudes of the grid'),'putting title attribute for longitude')

call check_nc(nf90_def_var(ncid_diagevo,'latitude',nf90_double,(/dim_nlat/),varid),'defining variable latitude')
call check_nc(nf90_put_att(ncid_diagevo,varid,'title','Latitudes of the grid'),'putting title attribute for latitude')

call check_nc(nf90_def_var(ncid_diagevo,'ap',nf90_double,(/dim_interlayer/),varid),'defining variable ap')
call check_nc(nf90_put_att(ncid_diagevo,varid,'title','Hybrid pressure at interlayers'),'putting title attribute for ap')

call check_nc(nf90_def_var(ncid_diagevo,'bp',nf90_double,(/dim_interlayer/),varid),'defining variable bp')
call check_nc(nf90_put_att(ncid_diagevo,varid,'title','Hybrid sigma at interlayers'),'putting title attribute for bp')

call check_nc(nf90_def_var(ncid_diagevo,'soildepth',nf90_double,(/dim_nsoil/),varid),'defining variable soildepth')
call check_nc(nf90_put_att(ncid_diagevo,varid,'title','Depths of soil layers'),'putting title attribute for soildepth')

call check_nc(nf90_def_var(ncid_diagevo,'cell_area',nf90_double,(/dim_nlon,dim_nlat/),varid),'defining variable cell_area')
call check_nc(nf90_put_att(ncid_diagevo,varid,'title','Cell area'),'putting title attribute for cell_area')

! Global attributes
call check_nc(nf90_put_att(ncid_diagevo,nf90_global,'title','PEM diagnostic file'),'putting global attribute')

! Leave define mode and putting variables defining dimensions
call check_nc(nf90_enddef(ncid_diagevo),'leaving define mode')
allocate(var_dyn(nlon_loc,nlat))
call vect2dyngrd(longitudes,var_dyn)
call put_var_nc('longitude',var_dyn(:,1))
call vect2dyngrd(latitudes,var_dyn)
call put_var_nc('latitude',var_dyn(1,:))
call put_var_nc('ap',ap)
call put_var_nc('bp',bp)
call put_var_nc('soildepth',mlayer)
call vect2dyngrd(cell_area,var_dyn,extensive = .true.)
call put_var_nc('cell_area',var_dyn)
deallocate(var_dyn)
call close_nc(diagevo_name)

! File creation done
is_diagevo = .true.

END SUBROUTINE create_diagevo
!=======================================================================

!=======================================================================
SUBROUTINE write_diagevo(var_name,title,units,var,dimids,extensive)
!-----------------------------------------------------------------------
! NAME
!     write_diagevo
!
! DESCRIPTION
!     Write selected diagnostic variables to NetCDF file "diagevo.nc".
!
! AUTHORS & DATE
!     JB Clement, 01/2026
!
! NOTES
!     > Output rate controlled by 'output_rate' from "run.def" (PEM).
!     > Variable selection controlled by the file "diagevo.def".
!         - If no "diagevo.def", then no output.
!         - If "diagevo.def" is empty, then all the possible coded
!           outputs are done.
!         - If "diagevo.def" holds a list of variable names, then these
!           are outputted.
!     > If 'var' is an array, then the argument 'dimids' is mandatory.
!       'dimids' contains the dimension IDs of the variable in order.
!       If the variable holds a dimension 'ngrid', then it must appear
!       in the first position.
!     > For extensive variables, the values at the poles must be
!       averaged over the number of longitudes to be computed/outputted
!       on the dynamical grid.
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use io_netcdf, only: open_nc, close_nc, def_var_nc, put_var_nc, diagevo_name
use evolution, only: idt, n_yr_run
use stoppage,  only: stop_clean
use geometry,  only: vect2dyngrd, ngrid, nlon, nlat

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
character(*),               intent(in)           :: var_name, title, units
real(dp),    dimension(..), intent(in)           :: var ! Assumed-rank array
integer(di), dimension(:),  intent(in), optional :: dimids
logical(k4),                intent(in), optional :: extensive

! LOCAL VARIABLES
! ---------------
integer(di), dimension(:),       allocatable :: dimids_nc
integer(di)                                  :: idim_ngrid, nlon_loc, ndim, i, j
real(dp),    dimension(:,:),     allocatable :: var_dyn
real(dp),    dimension(:,:,:),   allocatable :: var1d_dyn
real(dp),    dimension(:,:,:,:), allocatable :: var2d_dyn
integer(di)                                  :: itime ! Current time index to record variables
logical(k4)                                  :: extensive_l


! CODE
! ----
! If no diagdef file, no output at all
if (.not. is_diagdef) return

! If variable not selected, return
! Empty diagdef file means all the variables are ouputted
if (.not. is_output_selected(var_name)) return

! If output timing not met, return
if (abs(mod(idt,output_rate)) > eps) return

! If it is the first writing of the current timestep
if (writing_idt /= idt) then
    writing_idt = idt
    call open_nc(diagevo_name,'write',itime) ! Get the current time index
    call put_var_nc('Time',n_yr_run,itime)
end if

! Write the variable
extensive_l = .false.
if (present(extensive)) extensive_l = extensive
call open_nc(diagevo_name,'write') ! Open diagevo_name only it is not done yet
select rank (var) ! Assumed-rank array removes compile-time rank information which is required by the following subroutines using generic interface overload
    rank(0) ! Scalar
        call def_var_nc(var_name,title,units,(/dim_time/)) ! Define the variable only it is not done yet
        call put_var_nc(var_name,var,itime)
    rank default ! Arrays
        if (.not. present(dimids)) call stop_clean(__FILE__,__LINE__,'The argument ''dimids'' must be present to output arrays!',1)
        ndim = size(dimids)
        if (any(dimids == dim_ngrid)) then
            idim_ngrid = findloc(dimids,dim_ngrid,dim = 1)
            if (idim_ngrid /= 1) call stop_clean(__FILE__,__LINE__,'The dimension ''ngrid'' must be the first one to output the array!',1)
            allocate(dimids_nc(ndim + 2))
            dimids_nc(1) = dim_nlon
            dimids_nc(2) = dim_nlat
            dimids_nc(3:ndim + 1) = dimids(2:ndim)
            dimids_nc(ndim + 2) = dim_time
            if (ngrid == 1) then ! 1D
                nlon_loc = 1
            else ! 3D
                nlon_loc = nlon + 1
            end if
            call def_var_nc(var_name,title,units,dimids_nc) ! Define the variable only it is not done yet
            select rank (var) ! Assumed-rank array removes compile-time rank information which is required by the following subroutines using generic interface overload
                rank(1)
                    allocate(var_dyn(nlon_loc,nlat))
                    call vect2dyngrd(var,var_dyn,extensive_l)
                    call put_var_nc(var_name,var_dyn,itime)
                    deallocate(var_dyn)
                rank(2)
                    allocate(var1d_dyn(nlon_loc,nlat,size(var,2)))
                    do i = 1,size(var,2)
                        call vect2dyngrd(var(:,i),var1d_dyn(:,:,i),extensive_l)
                    end do
                    call put_var_nc(var_name,var1d_dyn,itime)
                    deallocate(var1d_dyn)
                rank(3)
                    allocate(var2d_dyn(nlon_loc,nlat,size(var,2),size(var,3)))
                    do i = 1,size(var,2)
                        do j = 1,size(var,3)
                            call vect2dyngrd(var(:,i,j),var2d_dyn(:,:,i,j),extensive_l)
                        end do
                    end do
                    call put_var_nc(var_name,var2d_dyn,itime)
                    deallocate(var2d_dyn)
                rank default
                    call stop_clean(__FILE__,__LINE__,'unsupported rank for the input array!',1)
            end select
        else ! No 'ngrid' dimension
            allocate(dimids_nc(ndim + 1))
            dimids_nc(1:ndim) = dimids(:)
            dimids_nc(ndim + 1) = dim_time
            call def_var_nc(var_name,title,units,dimids_nc) ! Define the variable only it is not done yet
            select rank (var) ! Assumed-rank array removes compile-time rank information which is required by the following subroutines using generic interface overload
                rank(1)
                    call put_var_nc(var_name,var_dyn,itime)
                rank(2)
                    call put_var_nc(var_name,var1d_dyn,itime)
                rank(3)
                    call put_var_nc(var_name,var2d_dyn,itime)
                rank(4)
                    call put_var_nc(var_name,var2d_dyn,itime)
                rank default
                    call stop_clean(__FILE__,__LINE__,'unsupported rank for the input array!',1)
            end select
        end if
        deallocate(dimids_nc)
end select
call close_nc(diagevo_name)

END SUBROUTINE write_diagevo
!=================================================================

END MODULE output