!### macro's #####################################################
!
#define TRACEBACK write (logfu,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__
!
#define IF_NOT_OK_RETURN(action) if (status/=0) then; TRACEBACK; action; call Exit(status); end if
!
#include "cso.inc"
!
!#################################################################

program Tutorial_Oper_S5p

#ifdef _MPI
  use MPI_F08, only : MPI_Comm
  use MPI_F08, only : MPI_COMM_WORLD
  use MPI_F08, only : MPI_SUCCESS, MPI_Error_String
  use MPI_F08, only : MPI_Init, MPI_Finalize
  use MPI_F08, only : MPI_Comm_Size, MPI_Comm_Rank
#endif

  use CSO, only : T_CSO
  use CSO, only : T_CSO_RcFile
  use CSO, only : T_CSO_DateTime, T_CSO_TimeDelta, CSO_DateTime, CSO_TimeDelta, Pretty, &
                    operator(+), operator(-), operator(*), operator(>=)
  use CSO, only : T_CSO_Listing
  use CSO, only : T_CSO_Sat_Data
  use CSO, only : T_CSO_Sat_State
  use CSO, only : T_GridMapping
  
  implicit none


  ! --- const ----------------------------------------------------------

  character(len=*), parameter   ::  rname = 'Tutorial_Oper_S5p'
  
  ! gravity constant:
  real, parameter     ::  grav   = 9.80665 ! m/s2
  ! mole mass of air:
  real, parameter     ::  xm_air = 28.964e-3     ! kg/mol : ~80% N2, ~20% O2, ...

  ! --- local ----------------------------------------------------------
  
#ifdef _MPI
  type(MPI_Comm)                    ::  comm
  integer                           ::  errorcode
  integer                           ::  errorlen
  character(len=1024)               ::  errormsg
#endif
  integer                           ::  npes, id

  ! return status:
  integer                           ::  status
  
  ! main object for CSO data:  
  type(T_CSO)                       ::  csod
  
  ! logfile unit and filename:
  integer                           ::  logfu
  character(len=1024)               ::  logfile

  ! settings:
  character(len=1024)               ::  rcfile
  type(T_CSO_RcFile)                ::  rcf
  character(len=32)                 ::  rcbase

  ! time loop variables:
  type(T_CSO_DateTime)              ::  t1, t2
  type(T_CSO_DateTime)              ::  t
  type(T_CSO_TimeDelta)             ::  dt
  
  ! local domain definition:
  real                              ::  west, east, south, north
  real                              ::  dlon, dlat
  integer                           ::  nlon, nlat
  ! global domain:
  integer                           ::  gnlon, gnlat
  ! model layers:
  integer                           ::  nz
  
  ! decomposition:
  integer                           ::  ndomx, ndomy
  integer                           ::  idomx, idomy
  real                              ::  dom_west, dom_east, dom_south, dom_north
  integer                           ::  dom_ilon0, dom_ilat0

  ! "model" arrays:
  integer                           ::  ilon, ilat, iz
  real, allocatable                 ::  conc(:,:,:)  ! (nlon,nlat,nz)
  character(len=32)                 ::  conc_units
  real, allocatable                 ::  hp(:,:,:)    ! (nlon,nlat,0:nz)
  character(len=32)                 ::  hp_units
  real, allocatable                 ::  tcc(:,:)   ! (nlon,nlat)
  real, allocatable                 ::  cc(:,:,:)  ! (nlon,nlat,nz)
  character(len=32)                 ::  cc_units

  ! orbit listing:
  character(len=1024)               ::  listing_filename
  type(T_CSO_Listing)               ::  listing
  ! orbit files:
  character(len=1024)               ::  orbit_filename
  ! orbit data and state:
  type(T_CSO_Sat_Data)              ::  sdata
  type(T_CSO_Sat_State)             ::  sstate
  ! output filename:
  character(len=1024)               ::  output_filename
  
  ! global pixel arrays:
  integer                           ::  nglb
  real, pointer                     ::  glb_lon(:)       ! (nglb)
  real, pointer                     ::  glb_lat(:)       ! (nglb)
  real, pointer                     ::  glb_clons(:,:)   ! (nglb,4)
  real, pointer                     ::  glb_clats(:,:)   ! (nglb,4)
  logical, pointer                  ::  glb_select(:)    ! (nglb)
  integer                           ::  iglb
  
  ! horizontal mapping:
  integer                           ::  mapping_levels
  type(T_GridMapping)               ::  GridMapping
  ! mapping arrays:
  real, pointer                     ::  areas(:)
  integer, pointer                  ::  ii(:), jj(:)
  real, pointer                     ::  ww(:)
  integer, pointer                  ::  iw0(:), nw(:)
  ! mapping index:
  integer                           ::  iw
  
  ! user defined dimensions:
  integer                           ::  nudim
  integer                           ::  iudim
  character(len=32)                 ::  udimname

  ! user defined variables:
  integer                           ::  nuvar
  integer                           ::  iuvar
  character(len=64), allocatable    ::  uvarnames(:)  ! (nuvar)
  character(len=64), allocatable    ::  uvarunits(:)  ! (nuvar)

  ! pixel counter and index:
  integer                           ::  npix
  integer                           ::  ipix 
  ! pixel footprints:
  real, pointer                     ::  lons(:), lats(:)         ! (npix)
  real, pointer                     ::  clons(:,:), clats(:,:)   ! (ncorner,npix)
  ! pixel arrays:
  real, pointer                     ::  data0(:)          ! (npix)
  real, pointer                     ::  data1(:,:)        ! (:,npix)

  ! --- begin ----------------------------------------------------------
  
  ! logfile unit, initially write to stdout:
  logfu = 6

#ifdef _MPI

  ! length of error messages:
  errorlen = len(errormsg)

  ! init MPI interface:
  call MPI_Init( ierror=status )
  if ( status /= MPI_SUCCESS ) then
    errorcode=status; call MPI_Error_String( errorcode, errormsg, errorlen, status ); write (logfu,'(a)') trim(errormsg)
    write (logfu,'("could not initialize MPI environment; exit code : ",i6)') status
    TRACEBACK; status=1; call Exit(status)
  end if
  ! use global communicator:
  comm = MPI_COMM_WORLD
  ! size and rank:
  call MPI_Comm_Size( comm, npes, ierror=status )
  if ( status /= MPI_SUCCESS ) then
    errorcode=status; call MPI_Error_String( errorcode, errormsg, errorlen, status ); write (logfu,'(a)') trim(errormsg)
    TRACEBACK; status=1; call Exit(status)
  end if
  call MPI_Comm_Rank( comm, id, ierror=status )
  if ( status /= MPI_SUCCESS ) then
    errorcode=status; call MPI_Error_String( errorcode, errormsg, errorlen, status ); write (logfu,'(a)') trim(errormsg)
    TRACEBACK; status=1; call Exit(status)
  end if

  ! init CSO module including MPI communication:
  call csod%Init( status, comm=comm )
  IF_NOT_OK_RETURN(status=1)
  
  ! OPTIONALLY: write messages to seperate files:
  write (logfile,'("tutorial.log.",i0)') id
  ! info ...
  write (logfu,'("write messages to: ",a)') trim(logfile)
  ! reset to "random" file unit:
  logfu = 123+id
  ! open:
  open( unit=logfu, file=trim(logfile), status='replace', iostat=status )
  if ( status/=0 ) then
    write (*,'("opening log file for output:")')
    write (*,'("  unit : ",i6)') logfu
    write (*,'("  file : ",a)') trim(logfile)
    TRACEBACK; status=1; call Exit(status)
  end if
  ! also write CSO messages to this unit:
  call csod%SetLogging( status, unit=logfu )
  IF_NOT_OK_RETURN(status=1)
  
  !! OPTIONALLY: write CSO messages to seperate file:
  !write (logfile,'("cso.log.",i0)') id
  !! redirect:
  !call csod%SetLogging( status, file=logfile )
  !IF_NOT_OK_RETURN(status=1)

#else

  ! serial:
  npes = 1
  id   = 0

  ! init CSO module:
  call csod%Init( status )
  IF_NOT_OK_RETURN(status=1)
  
  !! OPTIONALLY: write messages to file:
  !logfile = 'tutorial.log'
  !! info ...
  !write (logfu,'("write messages to: ",a)') trim(logfile)
  !! reset to "random" file unit:
  !logfu = 123
  !! open:
  !open( unit=logfu, file=trim(logfile), status='replace', iostat=status )
  !if ( status/=0 ) then
  !  write (*,'("opening log file for output:")')
  !  write (*,'("  unit : ",i6)') logfu
  !  write (*,'("  file : ",a)') trim(logfile)
  !  TRACEBACK; status=1; call Exit(status)
  !end if
  !! also write CSO messages to this unit:
  !call csod%SetLogging( status, unit=logfu )
  !IF_NOT_OK_RETURN(status=1)
  
  !! OPTIONALLY: write CSO messages to seperate file:
  !logfile = 'cso.log'
  !! redirect:
  !call csod%SetLogging( status, file=logfile )
  !IF_NOT_OK_RETURN(status=1)

#endif

  ! info ...
  write (logfu,'(a,":")') rname
  write (logfu,'(a,": ** CSO Tutorial S5p **")') rname
  write (logfu,'(a,":")') rname


  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ! settings
  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  ! input settings:
  rcfile = 'tutorial_oper_S5p.rc'
  ! base of keywords in rcfile:
  rcbase = 'tutorial.S5p.no2'
  
  !!~ input settings for synthetic S4/NO2
  !rcfile = 'tutorial_oper_S4-syn.rc'
  !! base of keywords in rcfile:
  !rcbase = 'tutorial.S4-syn.no2'
  
  ! info ...
  write (logfu,'(a,": settings file: ",a)') rname, trim(rcfile)
  ! read:
  call rcf%Init( rcfile, status )
  IF_NOT_OK_RETURN(status=1)

  ! time range:
  call rcf%Get( 'tutorial.timerange.start', t1, status )
  IF_NOT_OK_RETURN(status=1)
  call rcf%Get( 'tutorial.timerange.end', t2, status )
  IF_NOT_OK_RETURN(status=1)

  ! timestep of 1 hour:
  dt = CSO_TimeDelta( hour=1 )
  
  ! domain:
  call rcf%Get( 'tutorial.domain.west', west, status )
  IF_NOT_OK_RETURN(status=1)
  call rcf%Get( 'tutorial.domain.east', east, status )
  IF_NOT_OK_RETURN(status=1)
  call rcf%Get( 'tutorial.domain.south', south, status )
  IF_NOT_OK_RETURN(status=1)
  call rcf%Get( 'tutorial.domain.north', north, status )
  IF_NOT_OK_RETURN(status=1)
  ! resolution:
  call rcf%Get( 'tutorial.grid.dlon', dlon, status )
  IF_NOT_OK_RETURN(status=1)
  call rcf%Get( 'tutorial.grid.dlat', dlat, status )
  IF_NOT_OK_RETURN(status=1)
  ! global grid size:
  gnlon = nint( ( east  - west  )/dlon )
  gnlat = nint( ( north - south )/dlat )
  ! info ...
  write (logfu,'(a,": global domain             : [",f8.2,",",f8.2,"] x [",f8.2,",",f8.2,"]")') rname, west, east, south, north
  write (logfu,'(a,":   grid resolution         : ",f8.2," x ",f8.2)') rname, dlon, dlat
  write (logfu,'(a,":   grid shape              : ",i6," x ",i6)') rname, gnlon, gnlat

  ! info ...
  write (logfu,'(a,": number of processors      : ",i0)') rname, npes
  write (logfu,'(a,": processor id (0-based)    : ",i0)') rname, id

  ! define domain decomposition:
  select case ( npes ) 
    case ( 1 )
      ndomx = 1
      ndomy = 1
    case ( 2 )
      ndomx = 2
      ndomy = 1
    case ( 4 )
      ndomx = 2
      ndomy = 2
    case default
      write (logfu,'(a,": unsupported number of domains ",i0)') npes
      TRACEBACK; status=1; call Exit(status)
  end select
  ! info ...
  write (logfu,'(a,": decompostion              : ",i0," x ",i0)') rname, ndomx, ndomy

  ! zero-based location of this cpu within decomposition:
  idomx = mod( id, ndomx )
  idomy = id / ndomx
  ! info ...
  write (logfu,'(a,": domain id (0-based)       : ",i0," , ",i0)') rname, idomx, idomy

  ! sub-domain:
  dom_west  = west  +  idomx    * (east -west )/ndomx
  dom_east  = west  + (idomx+1) * (east -west )/ndomx
  dom_south = south +  idomy    * (north-south)/ndomy
  dom_north = south + (idomy+1) * (north-south)/ndomy
  ! info ...
  write (logfu,'(a,": local domain              : [",f8.2,",",f8.2,"] x [",f8.2,",",f8.2,"]")') &
                   rname, dom_west, dom_east, dom_south, dom_north

  ! local grid size:
  nlon = nint( ( dom_east  - dom_west  )/dlon )
  nlat = nint( ( dom_north - dom_south )/dlat )
  ! offset in global grid:
  dom_ilon0 = nint( ( dom_west  - west  )/dlon )
  dom_ilat0 = nint( ( dom_south - south )/dlat )
  ! info ...
  write (logfu,'(a,": grid resolution           : ",f8.2," x ",f8.2)') rname, dlon, dlat
  write (logfu,'(a,": grid shape                : ",i6," x ",i6)') rname, nlon, nlat
  write (logfu,'(a,": domain offset             : ",i6," x ",i6)') rname, dom_ilon0, dom_ilat0

  ! mapping level:
  call rcf%Get( 'tutorial.mapping.levels', mapping_levels, status )
  IF_NOT_OK_RETURN(status=1)
  
  ! init grid mapping using:
  ! - west and south bound of global(!) grid;
  ! - grid spacing;
  ! - local grid cell offset in global grid;
  ! - local grid shape
  ! - recursion level
  call GridMapping%Init( west , dlon, dom_ilon0, nlon, &
                         south, dlat, dom_ilat0, nlat, &
                         mapping_levels, status )
  IF_NOT_OK_RETURN(status=1)
    
  ! number of layers:
  nz = 10

  ! listing file:
  call rcf%Get( trim(rcbase)//'.listing', listing_filename, status )
  IF_NOT_OK_RETURN(status=1)
  
  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ! begin
  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  ! info ...
  write (logfu,'(a,": read listing file: ",a)') rname, trim(listing_filename)
  ! read listing file:
  call listing%Init( listing_filename, status )
  IF_NOT_OK_RETURN(status=1)
  !! show content:
  !call listing%Show( status )
  !IF_NOT_OK_RETURN(status=1)
  
  ! model concentration array:
  allocate( conc(nlon,nlat,nz), stat=status )
  IF_NOT_OK_RETURN(status=1)
  ! loop over cells:
  do ilat = 1, nlat
    do ilon = 1, nlon
      do iz = 1, nz
        ! fill with gradient from south-west to north-east,
        ! decreasing to top, zero in top layer:
        conc(ilon,ilat,iz) = ( real(dom_ilon0+ilon)/real(gnlon) + &
                               real(dom_ilat0+ilat)/real(gnlat)   ) * 0.2 &
                             * real(nz-iz)/real(nz)
      end do
    end do
  end do
  ! assume volume mixing ratio ..
  conc_units = 'ppb'
  
  ! model half-level pressures:
  allocate( hp(nlon,nlat,0:nz), stat=status )
  IF_NOT_OK_RETURN(status=1)
  ! from surface 1000 hPa to zero top:
  do iz = 0, nz
    hp(:,:,iz) = 1000e2 * real(nz-iz)/real(nz)  ! Pa
  end do
  ! pressure units ..
  hp_units = 'Pa'
  
  ! cloud cover with single layer
  allocate( cc(nlon,nlat,nz), stat=status )
  IF_NOT_OK_RETURN(status=1)
  cc = 0.0
  cc(:,:,4) = 1.0
  cc(:,:,5) = 0.2
  ! total cloud cover:
  allocate( tcc(nlon,nlat), stat=status )
  IF_NOT_OK_RETURN(status=1)
  tcc = maxval( cc, dim=3 )
  cc_units = '1'
  
  ! info ...
  write (logfu,'(a,": time range : [",a,",",a,"]")') rname, trim(Pretty(t1)), trim(Pretty(t2))
  
  ! time loop:
  t = t1
  do
    ! info ...
    write (logfu,'(a,": time : ",a)') rname, trim(Pretty(t))
    
    ! get name of CSO file for orbit with time average
    ! in interval around current time:
    call listing%SearchFile( t-0.5*dt, t+0.5*dt, 'aver', orbit_filename, status )
    IF_NOT_OK_RETURN(status=1)

    !! testing ...
    !if ( t%hour /= 11 ) orbit_filename = ''

    ! defined?
    if ( len_trim(orbit_filename) > 0 ) then
    
      ! info ..
      write (logfu,'(a,":  orbit file : ",a)') rname, trim(orbit_filename)
      
      ! ~ orbit data
      
      ! inititalize orbit data,
      ! read all footprints available in file:
      call sdata%Init( rcF, rcbase, orbit_filename, status )
      IF_NOT_OK_RETURN(status=1)
      
      ! obtain from the orbit:
      ! - number of footprints (global, all pixels in file)
      ! - pointers to arrays with footprint centers
      ! - pointers to arrays with footprint corners
      ! - pointer to to selection flags, should be used to select pixels overlapping with local domain
      call sdata%Get( status, nglb=nglb, &
                               glb_lon=glb_lon, glb_lat=glb_lat, &
                               glb_clons=glb_clons, glb_clats=glb_clats, &
                               glb_select=glb_select )
      IF_NOT_OK_RETURN(status=1)
      
      ! select pixels that overlap with local domain;
      ! loop over global pixels:
      do iglb = 1, nglb
        !!~ testing, select all:
        !glb_select(1:nglb) = .true.
        !!~ deceide if pixel center is part of local domain:
        !glb_select(iglb) = (glb_lon(iglb) >= dom_west ) .and. (glb_lon(iglb) <= dom_east ) .and. &
        !                   (glb_lat(iglb) >= dom_south) .and. (glb_lat(iglb) <= dom_north)
        !~ check if footprint overlaps (partly) with domain,
        !  and if it is entirely in global domain;
        !  use bounding box of footprint to check:
        glb_select(iglb) = (maxval(glb_clons(:,iglb)) >= dom_west ) .and. (minval(glb_clons(:,iglb)) <= dom_east ) .and. &
                           (maxval(glb_clats(:,iglb)) >= dom_south) .and. (minval(glb_clats(:,iglb)) <= dom_north) .and. &
                           (minval(glb_clons(:,iglb)) >=     west ) .and. (maxval(glb_clons(:,iglb)) <=     east ) .and. &
                           (minval(glb_clats(:,iglb)) >=     south) .and. (maxval(glb_clats(:,iglb)) <=     north)
      end do ! iglb
      
      ! read orbit, locally store only pixels that are flagged in 'glb_select'
      ! as having overlapping with this domain:
      call sdata%Read( rcF, rcbase, status )
      IF_NOT_OK_RETURN(status=1)
      
      ! ~ simulation
      
      ! obtain info on track:
      !  - number of local pixels
      call sdata%Get( status, npix=npix )
      IF_NOT_OK_RETURN(status=1)
      
      ! initialize simulation state;
      ! optional arguments:
      !   description='long name'    : used for output attributes
      call sstate%Init( sdata, rcF, rcbase, status, &
                           description='simulated retrievals' )
      IF_NOT_OK_RETURN(status=1)

      ! number of user defined dimensions:
      call sstate%Get( status, nudim=nudim )
      IF_NOT_OK_RETURN(status=1)
      ! loop:
      do iudim = 1, nudim
        ! get dimension name to be defined:
        call sstate%GetDim( iudim, status, name=udimname )
        IF_NOT_OK_RETURN(status=1)
        ! switch:
        select case ( trim(udimname) )
          !~ model layers:
          case ( 'model_layer' )
            ! define:
            call sstate%SetDim( udimname, nz, status )
            IF_NOT_OK_RETURN(status=1)
          !~ model layer interfaces:
          case ( 'model_layeri' )
            ! define:
            call sstate%SetDim( udimname, nz+1, status )
            IF_NOT_OK_RETURN(status=1)
          !~ unknown ...
          case default
            write (logfu,'("unsupported dimension `",a,"`")') trim(udimname)
            TRACEBACK; status=1; call Exit(status)
        end select
      end do ! idim

      ! dimension defined, allocate storage:
      call sstate%EndDef( status )
      IF_NOT_OK_RETURN(status=1)

      ! any pixels?
      if ( npix > 0 ) then
      
        ! pointers to (*,pixel) arrays:
        ! - footprint centers  (not used, for inspiration ..)
        ! - footprint corners
        call sdata%Get( status, lons=lons, lats=lats, clons=clons, clats=clats )
        IF_NOT_OK_RETURN(status=1)

        ! info ...
        write (logfu,'(a,": compute mapping weights ...")') rname
        ! get pointers to mapping arrays for all pixels:
        ! - areas(1:npix)            : pixel area [m2]
        ! - iw0(1:npix), nw(1:npix)  : offset and number of elements in ii/jj/ww
        ! - ii(:), jj(:), ww(:)      : cell and weight arrays for mapping to footprint,
        call GridMapping%GetWeights( clons, clats, &
                                       areas, iw0, nw, ii, jj, ww, status )
        IF_NOT_OK_RETURN(status=1)

        ! info ...
        write (logfu,'(a,":   store ...")') rname
        ! store mapping weights, might be saved and used to create gridded averages;
        ! cell indices ii/jj need to be the global index numbers!
        call sdata%SetMapping( areas, nw, dom_ilon0+ii, dom_ilat0+jj, ww, status )
        IF_NOT_OK_RETURN(status=1)

        ! number of user defined variables:
        call sstate%Get( status, nuvar=nuvar )
        IF_NOT_OK_RETURN(status=1)
        ! any user defined?
        if ( nuvar > 0 ) then

          ! storage for variable names and units:
          allocate( uvarnames(nuvar), stat=status )
          IF_NOT_OK_RETURN(status=1)
          allocate( uvarunits(nuvar), stat=status )
          IF_NOT_OK_RETURN(status=1)
          ! fill:
          call sstate%Get( status, uvarnames=uvarnames, uvarunits=uvarunits )
          IF_NOT_OK_RETURN(status=1)

          ! loop over variables:
          do iuvar = 1, nuvar
            ! info ..
            write (logfu,'(a,": user defined variable: ",a)') rname, trim(uvarnames(iuvar))
            ! switch:
            select case ( trim(uvarnames(iuvar)) )

              !~ model concentrations
              case ( 'mod_conc' )
                ! check units:
                if ( trim(uvarunits(iuvar)) /= trim(conc_units) ) then
                  write (logfu,'("ERROR - variable `",a,"` requires conversion to `",a,"` from `",a,"`")') &
                           trim(uvarnames(iuvar)), trim(uvarunits(iuvar)), trim(conc_units)
                  TRACEBACK; status=1; call Exit(status)
                end if
                ! get pointer to target array with shape (nz,npix):
                call sstate%GetData( status, name=uvarnames(iuvar), data1=data1 )
                IF_NOT_OK_RETURN(status=1)
                ! loop over pixels:
                do ipix = 1, npix
                  ! any source contributions?
                  if ( nw(ipix) > 0 ) then
                    ! init sum:
                    data1(:,ipix) = 0.0
                    ! loop over source contributions:
                    do iw = iw0(ipix)+1, iw0(ipix)+nw(ipix)
                      ! add contribution:
                      data1(:,ipix) = data1(:,ipix) + conc(ii(iw),jj(iw),:) * ww(iw)/areas(ipix)
                    end do ! iw
                  end if ! nw > 0
                end do ! ipix

              !~ model half-level pressures:
              case ( 'mod_hp' )
                ! check units:
                if ( trim(uvarunits(iuvar)) /= trim(hp_units) ) then
                  write (logfu,'("ERROR - variable `",a,"` requires conversion to `",a,"` from `",a,"`")') &
                           trim(uvarnames(iuvar)), trim(uvarunits(iuvar)), trim(hp_units)
                  TRACEBACK; status=1; call Exit(status)
                end if
                ! get pointer to target array with shape (nz,npix):
                call sstate%GetData( status, name=uvarnames(iuvar), data1=data1 )
                IF_NOT_OK_RETURN(status=1)
                ! loop over pixels:
                do ipix = 1, npix
                  ! any source contributions?
                  if ( nw(ipix) > 0 ) then
                    ! init sum:
                    data1(:,ipix) = 0.0
                    ! loop over source contributions:
                    do iw = iw0(ipix)+1, iw0(ipix)+nw(ipix)
                      ! add contribution:
                      data1(:,ipix) = data1(:,ipix) + hp(ii(iw),jj(iw),:) * ww(iw)/areas(ipix)
                    end do ! iw
                  end if ! nw > 0
                end do ! ipix

              !~ cloud cover: total:
              case ( 'mod_tcc' )
                ! check units:
                if ( trim(uvarunits(iuvar)) /= trim(cc_units) ) then
                  write (logfu,'("ERROR - variable `",a,"` requires conversion to `",a,"` from `",a,"`")') &
                           trim(uvarnames(iuvar)), trim(uvarunits(iuvar)), trim(cc_units)
                  TRACEBACK; status=1; call Exit(status)
                end if
                ! get pointer to target array with shape (npix):
                call sstate%GetData( status, name=uvarnames(iuvar), data0=data0 )
                IF_NOT_OK_RETURN(status=1)
                ! loop over pixels:
                do ipix = 1, npix
                  ! any source contributions?
                  if ( nw(ipix) > 0 ) then
                    ! init sum:
                    data0(ipix) = 0.0
                    ! loop over source contributions:
                    do iw = iw0(ipix)+1, iw0(ipix)+nw(ipix)
                      ! add contribution:
                      data0(ipix) = data0(ipix) + tcc(ii(iw),jj(iw)) * ww(iw)/areas(ipix)
                    end do ! iw
                  end if ! nw > 0
                end do ! ipix

              !~ cloud cover: profile:
              case ( 'mod_cc' )
                ! check units:
                if ( trim(uvarunits(iuvar)) /= trim(cc_units) ) then
                  write (logfu,'("ERROR - variable `",a,"` requires conversion to `",a,"` from `",a,"`")') &
                           trim(uvarnames(iuvar)), trim(uvarunits(iuvar)), trim(cc_units)
                  TRACEBACK; status=1; call Exit(status)
                end if
                ! get pointer to target array with shape (nz,npix):
                call sstate%GetData( status, name=uvarnames(iuvar), data1=data1 )
                IF_NOT_OK_RETURN(status=1)
                ! loop over pixels:
                do ipix = 1, npix
                  ! any source contributions?
                  if ( nw(ipix) > 0 ) then
                    ! init sum:
                    data1(:,ipix) = 0.0
                    ! loop over source contributions:
                    do iw = iw0(ipix)+1, iw0(ipix)+nw(ipix)
                      ! add contribution:
                      data1(:,ipix) = data1(:,ipix) + cc(ii(iw),jj(iw),:) * ww(iw)/areas(ipix)
                    end do ! iw
                  end if ! nw > 0
                end do ! ipix

              !~
              case default
                write (logfu,'("unsupported variable name `",a,"`")') trim(uvarnames(iuvar))
                TRACEBACK; status=1; call Exit(status)
            end select

          end do ! user defined variables

          ! info ...
          write (logfu,'(a,": end ...")') rname

          ! clear:
          deallocate( uvarnames, stat=status )
          IF_NOT_OK_RETURN(status=1)
          deallocate( uvarunits, stat=status )
          IF_NOT_OK_RETURN(status=1)

        end if ! nuvar > 0

      end if ! npix > 0
      
      ! ~ formula
      
      ! inquire info on pixels covering multiple domains,
      ! setup exchange parameters:
      call sdata%SetupExchange( status )
      IF_NOT_OK_RETURN(status=1)
      ! exchange simulations:
      call sstate%Exchange( sdata, status )
      IF_NOT_OK_RETURN(status=1)
      
      ! apply formula: kernel convolution etc:
      call sstate%ApplyFormulas( sdata, status )
      IF_NOT_OK_RETURN(status=1)
      
      ! ~ put out
      
      ! target file for selected data:
      write (output_filename,'("CSO_output_",i4.4,2i2.2,"_",2i2.2,"_data.nc")') &
                 t%year, t%month, t%day, t%hour, t%minute
      ! setup gathering information, gather output arrays, write:
      call sdata%PutOut( output_filename, status )
      IF_NOT_OK_RETURN(status=1)
      
      ! target file for simulation state:
      write (output_filename,'("CSO_output_",i4.4,2i2.2,"_",2i2.2,"_state.nc")') &
                 t%year, t%month, t%day, t%hour, t%minute
      ! gether output arrays, write:
      call sstate%PutOut( sdata, output_filename, status )
      IF_NOT_OK_RETURN(status=1)
      
      ! ~ clear
      
      ! clear:
      nullify( glb_lon )
      nullify( glb_lat )
      nullify( glb_select )
      
      ! done with state:
      call sstate%Done( sdata, status )
      IF_NOT_OK_RETURN(status=1)
      
      ! done with data:
      call sdata%Done( status )
      IF_NOT_OK_RETURN(status=1)
      
      !! testing ...
      !write (logfu,'("break after first orbit")')
      !exit

    end if  ! orbit found in listing
    
    ! end?
    if ( t >= t2 ) exit
    ! next:
    t = t + dt
  end do ! time loop

  ! done with listing:
  call listing%Done( status )
  IF_NOT_OK_RETURN(status=1)
  
  ! done with grid mapping:
  call GridMapping%Done( status )
  IF_NOT_OK_RETURN(status=1)
  
  ! done with model arrays:
  deallocate( conc, stat=status )
  IF_NOT_OK_RETURN(status=1)
  deallocate( hp, stat=status )
  IF_NOT_OK_RETURN(status=1)
  
  ! clear:
  deallocate( cc, stat=status )
  IF_NOT_OK_RETURN(status=1)
  deallocate( tcc, stat=status )
  IF_NOT_OK_RETURN(status=1)

  
  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ! done with settings
  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  ! done with settings:
  call rcf%Done( status )
  IF_NOT_OK_RETURN(status=1)

  
  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ! done
  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  ! done with CSO:
  call csod%Done( status )
  IF_NOT_OK_RETURN(status=1)

#ifdef _MPI
  ! done with MPI interface:
  call MPI_Finalize( ierror=status )
  if ( status /= MPI_SUCCESS ) then
    write (logfu,'("could not finalize MPI environment; exit code : ",i6)') status
    TRACEBACK; status=1; call Exit(status)
  end if
#endif

  ! info ...
  write (logfu,'(a,":")') rname
  write (logfu,'(a,": ** end **")') rname
  write (logfu,'(a,":")') rname

end program Tutorial_Oper_S5p


