c     Copyright (C)
c     2010-2013 Université Bordeaux 1
c     2010-2013 Ecole des Mines d'Albi
c     2014-2018 - Mesostar
c     
c     This program is free software; you can redistribute it and/or modify
c     it under the terms of the GNU General Public License as published by
c     the Free Software Foundation; either version 2, or (at your option)
c     any later version.

c     This program is distributed in the hope that it will be useful,
c     but WITHOUT ANY WARRANTY; without even the implied warranty of
c     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
c     GNU General Public License for more details.

c     You should have received a copy of the GNU General Public License
c     along with this program; if not, write to the Free Software
c     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
c     USA.
c
      subroutine set_chunks(Nq,np,nchunks)
      implicit none
c
c     Purpose: to set the number of computational chunks
c
c     Inputs:
c       + Nq: quadrature index
c       + np: total number of processes
c
c     Output:
c       + nchunks: number of chunks
c
      include 'max.inc'
      integer Nq,np
      integer nchunks
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine set_chunks'

c     This one is really easy :)
      nchunks=Nq
c      nchunks=1

      return
      end



      subroutine find_free_process(free,nproc,fpf,proc)
      implicit none
      include 'max.inc'
c
c     Purpose: to find 'proc', the index of a free child process
c
c     Input:
c       + free: T/F value, process is free or not
c       + nproc: number of child processes
c
c     Output:
c       + fpf: T if no free child process found; 1 otherwise
c       + proc: index of the free child process found, if fpf=1
c
c     I/O
      logical free(1:Nproc_mx)
      integer nproc
      logical fpf
      integer proc
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine find_free_process'

      fpf=.false.
      do proc=1,nproc
         if (free(proc)) then
            fpf=.true.
            goto 123
         endif
      enddo
 123  continue

      return
      end



      subroutine stopped_processes(stopped,nproc,nsp)
      implicit none
      include 'max.inc'
c
c     Purpose: to identify the number of child processes that have been stopped
c
c     Input:
c       + stopped: array of stopped processes
c       + nproc: number of child processes
c     
c     Output:
c       + nsp: number of child processes that have been stopped
c     
c     I/O
      logical stopped(1:Nproc_mx)
      integer nproc,nsp
c     temp
      integer proc
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine stopped_processes'

      nsp=0
      do proc=1,nproc
         if (stopped(proc)) then
            nsp=nsp+1
         endif
      enddo

      return
      end



      subroutine send_global_data_mpibcast(ref_choice,ai,fullRT,Nlay,
     &     lambda_lo,lambda_hi,epsilon_ground,mu,z,temp,Tground,Tspace,
     &     toa_sw)
      implicit none
      include 'mpif.h'
      include 'max.inc'
c
c     Purpose: to send data to all slave processes
c
c     Input:
c       + ref_choice: 1 for a specular reflexion at ground
c                     2 for a diffuse reflexion at ground
c       + ai: true if angular integration is enabled
c       + fullRT: if true, full NER are computed; if false, only gas-space NERs are computed
c       + Nlay: number of atmospheric layers
c       + lambda_lo: lower limit of each spectral band (Âµm)
c       + lambda_hi: higher limit of each spectral band (Âµm)
c       + epsilon_ground: emissivity of the ground
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + z: altitude at the top of each layer (m)
c       + temp: temperature at the top of each layer (K)
c       + Tground: temperature of the ground
c       + Tspace: temperature of space
c       + toa_sw: incoming SW flux @ TOA in each interval [W/m^2]
c
c     I/O
      integer ref_choice
      logical ai,fullRT
      integer Nlay
      double precision lambda_lo(1:Nb_mx)
      double precision lambda_hi(1:Nb_mx)
      double precision epsilon_ground(1:Nb_mx)
      double precision mu
      double precision z(0:Nlay_mx)
      double precision temp(0:Nlay_mx)
      double precision Tground
      double precision Tspace
      double precision toa_sw(1:Nb_mx)
c     MPICH
      integer ierr
      integer stat(MPI_STATUS_SIZE)
c     MPICH
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine send_global_data_mpibcast'

c     integer data
      call MPI_BCAST(ref_choice,1,MPI_INTEGER
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(ai,1,MPI_LOGICAL
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(fullRT,1,MPI_LOGICAL
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(Nlay,1,MPI_INTEGER
     &     ,0,MPI_COMM_WORLD,ierr)
c     double precision data
      call MPI_BCAST(lambda_lo,Nb_mx,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(lambda_hi,Nb_mx,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(epsilon_ground,Nb_mx,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(mu,1,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(z,Nlay_mx+1,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(temp,Nlay_mx+1,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(Tground,1,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(Tspace,1,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(toa_sw,Nb_mx,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)

      return
      end



      subroutine receive_global_data_mpibcast(
     &     ref_choice,ai,fullRT,Nlay,
     &     lambda_lo,lambda_hi,epsilon_ground,mu,z,temp,Tground,Tspace,
     &     toa_sw)
      implicit none
      include 'mpif.h'
      include 'max.inc'
c
c     Purpose: to receive data in each slave processes
c
c     Output:
c       + ref_choice: 1 for a specular reflexion at ground
c                     2 for a diffuse reflexion at ground
c       + ai: true if angular integration is enabled
c       + fullRT: if true, full NER are computed; if false, only gas-space NERs are computed
c       + Nlay: number of atmospheric layers
c       + lambda_lo: lower limit of each spectral band (Âµm)
c       + lambda_hi: higher limit of each spectral band (Âµm)
c       + epsilon_ground: emissivity of the ground
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + z: altitude at the top of each layer (m)
c       + temp: temperature at the top of each layer (K)
c       + Tground: temperature of the ground
c       + Tspace: temperature of space
c       + toa_sw: incoming SW flux @ TOA in each interval [W/m^2]
c
c     I/O
      integer ref_choice
      logical ai
      logical fullRT
      integer Nlay
      double precision lambda_lo(1:Nb_mx)
      double precision lambda_hi(1:Nb_mx)
      double precision epsilon_ground(1:Nb_mx)
      double precision mu
      double precision z(0:Nlay_mx)
      double precision temp(0:Nlay_mx)
      double precision Tground
      double precision Tspace
      double precision toa_sw(1:Nb_mx)
c     MPICH
      integer ierr
      integer stat(MPI_STATUS_SIZE)
c     MPICH
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine receive_global_data_mpibcast'

c     integer data
      call MPI_BCAST(ref_choice,1,MPI_INTEGER
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(ai,1,MPI_LOGICAL
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(fullRT,1,MPI_LOGICAL
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(Nlay,1,MPI_INTEGER
     &     ,0,MPI_COMM_WORLD,ierr)
c     double precision data
      call MPI_BCAST(lambda_lo,Nb_mx,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(lambda_hi,Nb_mx,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(epsilon_ground,Nb_mx,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(mu,1,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(z,Nlay_mx+1,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(temp,Nlay_mx+1,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(Tground,1,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(Tspace,1,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)
      call MPI_BCAST(toa_sw,Nb_mx,MPI_DOUBLE_PRECISION
     &     ,0,MPI_COMM_WORLD,ierr)

      return
      end
