!! ================================================================================================================================
!! SUBROUTINE 	: alloc
!!
!>\BRIEF         Allocate net primary production (= photosynthesis
!! minus autothrophic respiration) to: carbon reserves, aboveground sapwood,
!! belowground sapwood, root, fruits and leaves following Friedlingstein et al. (1999).
!!
!! DESCRIPTION (definitions, functional, design, flags):\n
!! The philosophy underlying the scheme is that allocation patterns result from
!! evolved responses that adjust carbon investments to facilitate capture of most
!! limiting resources i.e. light, water and mineral nitrogen. The implemented scheme
!! calculates the limitation of light, water and nitrogen. However, nitrogen is not a
!! prognostic variable of the model and therefore soil temperature and soil moisture
!! are used as a proxy for soil nitrogen availability.\n
!! Sharpe & Rykiel (1991) proposed a generic relationship between the allocation of
!! carbon to a given plant compartment and the availability of a particular resource:\n
!! \latexonly
!!   \input{alloc1.tex}
!! \endlatexonly
!! \n
!! where A is the allocation of biomass production (NPP) to a given compartment (either
!! leaves, stem, or roots). Xi and Yj are resource availabilities (e.g. light, water,
!! nutrient). For a given plant compartment, a resource can be of type X or Y. An increase
!! in a X-type resource will increase the allocation to compartment A. An increase in a
!! Y-type resource will, however, lead to a decrease in carbon allocation to that compartment.
!! In other words, Y-type resources are those for which uptake increases with increased
!! investment in the compartment in question. X-type resources, as a consequence of
!! trade-offs, are the opposite. For example, water is a Y-type resource for root allocation.
!! Water-limited conditions should promote carbon allocation to roots, which enhance water
!! uptake and hence minimize plant water stress. Negative relationships between investment
!! and uptake arise when increased investment in one compartment leads, as required for
!! conservation of mass, to decreased investment in a component involved in uptake of
!! that resource.\n
!!
!! The implemented scheme allocates carbon to the following components:\n
!! - Carbon reserves;\n
!! - Aboveground sapwood;\n
!! - Belowground sapwood;\n
!! - Roots;\n
!! - Fruits/seeds and\n
!! - Leaves.
!! \n
!!
!! The allocation to fruits and seeds is simply a 10% "tax" of the total biomass
!! production.\n
!! Following carbohydrate use to support budburst and initial growth, the
!! carbohydrate reserve is refilled. The daily amount of carbon allocated to the
!! reserve pool is proportional to leaf+root allocation (::LtoLSR and ::RtoLSR).\n
!! Sapwood and root allocation (respectively ::StoLSR and ::RtoLSR) are proportional
!! to the estimated light and soil (water and nitrogen) stress (::Limit_L and
!! ::Limit_NtoW). Further, Sapwood allocation is separated in belowground sapwood
!! and aboveground sapwood making use of the parameter (:: alloc_sap_above_tree
!! or ::alloc_sap_above_grass). For trees partitioning between above and
!! belowground compartments is a function of PFT age.\n
!! Leaf allocation (::LtoLSR) is calculated as the residual of root and sapwood
!! allocation (LtoLSR(:) = 1. - RtoLSR(:) - StoLSR(:).\n
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S): :: f_alloc; fraction of NPP that is allocated to the
!! six different biomass compartments (leaves, roots, above and belowground wood,
!! carbohydrate reserves and fruits). DIMENSION(npts,nvm,nparts).
!!
!! REFERENCE(S)	:
!! - Friedlingstein, P., G. Joel, C.B. Field, and Y. Fung (1999), Towards an allocation
!! scheme for global terrestrial carbon models, Global Change Biology, 5, 755-770.\n
!! - Sharpe, P.J.H., and Rykiel, E.J. (1991), Modelling integrated response of plants
!! to multiple stresses. In: Response of Plants to Multiple Stresses (eds Mooney, H.A.,
!! Winner, W.E., Pell, E.J.), pp. 205-224, Academic Press, San Diego, CA.\n
!! - Krinner G, Viovy N, de Noblet-Ducoudr N, Ogee J, Polcher J, Friedlingstein P,
!! Ciais P, Sitch S, Prentice I C (2005) A dynamic global vegetation model for studies
!! of the coupled atmosphere-biosphere system. Global Biogeochemical Cycles, 19, GB1015,
!! doi: 10.1029/2003GB002199.\n
!! - Malhi, Y., Doughty, C., and Galbraith, D. (2011). The allocation of ecosystem net primary productivity in tropical forests,
!! Philosophical Transactions of the Royal Society B-Biological Sciences, 366, 3225-3245, DOI 10.1098/rstb.2011.0062.\n
!!
!! FLOWCHART    :
!! \latexonly
!!   \includegraphics[scale=0.5]{allocflow.jpg}
!! \endlatexonly
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE  : pftinout
!!
!>\BRIEF       Introduce and eliminate PFT's from pixel
!!
!! DESCRIPTION**3 : Introduction and elimination of PFTs on the basis of climate condition.
!! For natural and woody PFTs the foliage projected coverage is calculated as follows:
!! \latexonly
!!  \input{equation_lpj_pftinout.tex}
!! \endlatexonly
!! \n
!! where FPC is foliage projective cover (::fpc_nat), CN crown area (::cn_ind,
!! @tex $ m^{2} $ @endtex), IND number of individuals (::ind, @tex $ m^{-2} $ @endtex,
!! FRAC total fraction occupied by natural vegetation (::fracnat),
!! @tex $ LM_{rm max} $ @endtex maximum leaf mass in last year
!! (::lm_lastyearmax, @tex $ g C m^{-2} $ @endtex), SLA specific leaf area (sla,
!! @tex $ m^{2} (g C)^{-1} $ @endtex), and coff coefficient (::ext_coeff). ::ext_coeff
!! describes a property of the canopy (i.e. law of Lambert-Beer) and is defined in **2
!!
!! The foliage projective cover feeds into the calculation of the space available for
!! expansion of existing and dispersion of new PFTs within a gridbox. In turn, available
!! space is use to calculate the number of individuals with a PFT.
!!
!! Saplings are introduced under the condition that winter temperature is
!! moderate, plant age is older than 1.25, (and for some PFTs at least one adjacent grid
!! box exists for expansion), new saplings are introduced for narural PFT. In the simulation of
!! agricultural grassland, if target PFT does not exist in the gridbox, it is introduced
!! regardless of climate condition. When a new PFT is introduced CO_2 is taken from the
!! atmosphere to account for CO_2 present in the seed and required by the germinated seeds
!! to establish a sapling. These initial phases in ontology are not accounted for. However,
!! by taking this small amount of CO2 from the atmosphere, mass balance closure for C is
!! preserved.
!!
!! PFTs are eliminated under the condition that they are no longer adapted to the critical
!! temperatures in winter. When a PFT is eliminated its number of indiviuals is set to zero and
!! the rest of the elimination process is taken care of in lpj_kill.f90.
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S): :: avail_tree (space availability for trees, unitless),
!! :: avail_grass (space availability for grasses, unitless), :: biomass (biomass, \f$gC m^{-2}\f$)
!! and :: ind (density of individuals, \f$m^{-2}\f$)
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART    :
!! \latexonly
!!   \includegraphics[scale = 0.6]{pftinout.png}
!! \endlatexonly
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE   : StomateLpj_clear
!!
!>\BRIEF        Re-initialisation of variable
!!
!! DESCRIPTION  : This subroutine reinitializes variables. To be used if we want to relaunch
!! ORCHIDEE but the routine is not used in current version.
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S): None
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE   : harvest
!!
!>\BRIEF        Harvest of croplands
!!
!! DESCRIPTION  : To take into account biomass harvest from crop (mainly to take
!! into account for the reduced litter input and then decreased soil carbon. it is a
!! constant (40\%) fraction of above ground biomass.
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S): ::harvest_above the harvested biomass
!!
!! REFERENCE(S) :
!! - Piao, S., P. Ciais, P. Friedlingstein, N. de Noblet-Ducoudre, P. Cadule, N. Viovy, and T. Wang. 2009.
!!   Spatiotemporal patterns of terrestrial carbon cycle during the 20th century. Global Biogeochemical
!!   Cycles 23:doi:10.1029/2008GB003339.
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE	: npp_calc
!!
!>\BRIEF        Calculate NPP as the difference between GPP and respiration (= growth + maintenance respiration).
!!              Update biomass of all compartments after calculating respiration and allocation.
!!
!!
!! DESCRIPTION  : NPP is calculated from three components: Gross Primary Productivity (GPP), maintenance respiration
!! and growth respiration (all in @tex $ gC.m^{-2}dt^{-1} $ @endtex), following the convention that positive fluxes denote
!! fluxes plants to the atmosphere. GPP is the input variable from which, in the end, NPP or total allocatable biomass
!! @tex $(gC.m^{-2}dt^{-1}))$ @endtex is calculated. Net primary production is then calculated as:\n
!! NPP = GPP - growth_resp - maint-resp   [eq. 1]\n
!!
!! The calculation of maintenance respiration is done in routine stomate_resp.f90. Maintenance respiration is calculated for
!! the whole plant and is therefore removed from the total allocatable biomass. In order to prevent all allocatable biomass
!! from being used for maintenance respiration, a limit fraction of total allocatable biomass, tax_max, is defined (in
!! variables declaration). If maintenance respiration exceeds tax_max (::bm_tax_max), the maximum allowed allocatable biomass
!! will be respired and the remaining respiration, required in excess of tax_max, is taken out from tissues already present in
!! the plant (biomass).\n
!!
!! After total allocatable biomass has been updated by removing maintenance respiration, total allocatable biomass is distributed
!! to all plant compartments according to the f_alloc fractions calculated in stomate_alloc.f90.\n
!!
!! Growth respiration is calculated as a fraction of allocatable biomass for each part of the plant. The fraction coefficient
!! ::frac_growth_resp is defined in stomate_constants.f90 and is currently set to be the same for all plant compartments.
!! Allocatable biomass of all plant compartments are updated by removing what is lost through growth respiration. Net allocatable
!! biomass (total allocatable biomass after maintenance and growth respiration) is added to the current biomass for  each plant
!! compartment.
!!
!! Finally, leaf age and plant age are updated. Leaf age is described with the concept of "leaf age classes". A number of leaf
!! age classes (nleafages) is defined in stomate_constants.f90. Each leaf age class contains a fraction (::leaf_frac) of the
!! total leaf biomass. When new biomass is added to leaves, the age of the biomass in the youngest leaf age class is decreased.
!! The fractions of leaves in the other leaf ages classes are also updated as the total biomass has increased. Plant age is
!! updated first by increasing the age of the previous biomass by one time step, and then by adjusting this age as the average
!! of the ages of the previous and the new biomass.
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S): ::npp
!!
!! REFERENCE(S)	:
!! - F.W.T.Penning De Vries, A.H.M. Brunsting, H.H. Van Laar. 1974. Products, requirements and efficiency of biosynthesis a
!! quantitative approach. Journal of Theoretical Biology, Volume 45, Issue 2, June 1974, Pages 339-377.
!!
!! FLOWCHART :
!! \latexonly
!! \includegraphics[scale=0.14]{stomate_npp_flow.jpg}
!! \endlatexonly
!! \n
!_ ================================================================================================================================


! ******************************************************************************
!!!!!!!!!!!!   JCmodif 110525 del calculation of grazingc and grazingn
!!!!!!!!!!!!   they have been moved before Respiration


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!   chg_plante was introduced from Grassland_Management, put after intake calculation
!!!!!!!!   to get the biomass change, and calculate DNDF NDF & DNDFI for dynamic
!!!!!!!!   DNDF NDF & DNDFI were cited from SUBROUTINE variablesPlantes of PASIM2011
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!   variablesPlantes was introduced from Plantes.f90 of PaSim
!!!!!!!!   to get state variables need be intake selection before chg_plante
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


!********************************************
!********************************************
! SUBROUTINE OF cow ANIMAL MODEL
!********************************************
!********************************************
!----------------------------------
! 1 - intake capacity
!----------------------------------
!*suckler Cow


! Heifer
! Equations from INRA feed tables 2007 p.75
!------------------------------------------


!----------------------------------------------
! 3 - Milk_production
!----------------------------------------------
! the milk production is based on Wood equation
!----------------------------------------------


!----------------------------------------------
! 4 - Balance energy Cow
!----------------------------------------------
! the energy balance for the cow to compute weight
! gain or loss, and body condition score gain or loss
!----------------------------------------------


!----------------------------------
! 4 - Respiration & Methane loss
!----------------------------------
! Methane emissions were previously calculated as a fixed proportion of the
! ingested carbon (Minonzio, 1998);
! Methan-Emissionen der schweizerischen Landwirtschaft
! G Minonzio, A Grub, J Fuhrer - Schriftenreihe Umwelt, 1998
! In reality, the main factors responsible for CH4 production are not only the amount
! but also the quality of the diet (fibres). Cf. Vuichard Thesis


! Fonction permettant de savoir si les animaux paturent au jour J
! Retour : 1:si des animaux sont en paturage au jour J
!          0:sinon


!----------------------------------------
! SUBROUTINES DU MODULE ANIMAL LAITIER
!----------------------------------------


!--------------------------
! Net Energy requirements
!--------------------------


!----------------------------------
! Potential milk production (MPpot)
!----------------------------------


!! ================================================================================================================================
!! SUBROUTINE     : lpj_cover
!!
!>\BRIEF          Recalculate vegetation cover and LAI
!!
!!\n DESCRIPTION : Veget_max is first renewed here according to newly calculated foliage biomass in this calculation step
!! Then, litter, soil carbon, and biomass are also recalcuted with taking into account the changes in Veget_max (i.e. delta_veg)
!! Grid-scale fpc (foliage projected coverage) is calculated to obtain the shadede ground area by leaf's light capture
!! Finally, grid-scale fpc is adjusted not to exceed 1.0
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) : ::lai (leaf area index, @tex $(m^2 m^{-2})$ @endtex),
!! :: veget (fractional vegetation cover, unitless)
!!
!! REFERENCE(S)   : None
!!
!! FLOWCHART :
!! \latexonly
!!     \includegraphics[scale=0.5]{lpj_cover_flowchart.png}
!! \endlatexonly
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE   : season
!!
!>\BRIEF          This subroutine calculates many of the long-term biometeorological variables
!!                needed in the phenology subroutines and in the calculation of long-term vegetation
!!                dynamics in the LPJ DGVM.
!!
!! DESCRIPTION    This subroutine is called by the module ::stomate before LPJ, and mainly deals
!!                with the calculation of long-term meteorological variables, carbon fluxes and
!!                vegetation-related variables that are used to calculate vegetation dynamics
!!                in the stomate modules relating to the phenology and to the longer-term
!!                changes in vegetation type and fractional cover in the LPJ DGVM modules. \n
!!                In sections 2 to 5, longer-term meteorological variables are calculated. The
!!                long-term moisture availabilities are used in the leaf onset and senescence
!!                phenological models ::stomate_phenology and ::stomate_turnover that require
!!                a moisture condition. The long term temperatures are also required for phenology
!!                but in addition they are used in calculations of C flux and the presence and
!!                establishment of vegetation patterns on a longer timescale in the LPJ DGVM modules.
!!                Finally the monthly soil humidity/relative soil moisture is used in the C
!!                allocation module ::stomate_alloc. \n
!!                Sections 12 to 14 also calculate long-term variables of C fluxes, including NPP,
!!                turnover and GPP. The first two are used to calculate long-term vegetation
!!                dynamics and land cover change in the LPJ DVGM modules. The weekly GPP is used
!!                to determine the dormancy onset and time-length, as described below. \n
!!                The long-term variables described above are are used in certain vegetation
!!                dynamics processes in order to maintain consistency with the basic hypotheses of the
!!                parameterisations of LPJ, which operates on a one year time step (Krinner et al., 2005).
!!                In order to reduce the computer memory requirements, short-term variables (e.g. daily
!!                temperatures) are not stored for averaging over a longer period. Instead
!!                the long-term variables (e.g. monthly temperature) are calculated at each time step
!!                using a linear relaxation method, following the equation:
!!                \latexonly
!!                \input{season_lin_relax_eqn1.tex}
!!                \endlatexonly
!!                \n
!!                The long-term variables are therefore updated on a daily basis. This method allows for
!!                smooth temporal variation of the long-term variables which are used to calculate
!!                vegetation dynamics (Krinner et al., 2005). \n
!!                Sections 6 to 11 calculate the variables required for to determine leaf onset in
!!                the module ::stomate_phenology.
!!                These include :
!!                - the dormance onset and time-length, when GPP is below a certain threshold \n
!!                - the growing degree days (GDD), which is the sum of daily temperatures greater than
!!                -5 degrees C, either since the onset of the dormancy period, or since midwinter \n
!!                - the number of chilling days, which is the number of days with a daily temperature
!!                lower than a PFT-dependent threshold since the beginning of the dormancy period \n
!!                - the number of growing days, which is the the number of days with a temperature
!!                greater than -5 degrees C since the onset of the dormancy period \n
!!                - the time since the minimum moisture availability in the dormancy period. \n
!!                These variables are used to determine the conditions needed for the start of the
!!                leaf growing season. The specific models to which they correspond are given below. \n
!!                Sections 15 to 20 are used to update the maximum/minimum or the sum of various
!!                meteorological and biological variables during the year that are required for
!!                calculating either leaf onset or longer-term vegetation dynamics the following year. \n
!!                At the end of the year, these variables are updated from "thisyear" to "lastyear",
!!                in Section 21 of this subroutine, for use the following year. \n
!!                Finally the probably amount of herbivore consumption is calculated in Section 22,
!!                following McNaughton et al. (1989).
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S): :: herbivores,
!!                        :: maxmoiavail_lastyear, :: maxmoiavail_thisyear,
!!                        :: minmoiavail_lastyear, :: minmoiavail_thisyear,
!!                        :: maxgppweek_lastyear, :: maxgppweek_thisyear,
!!                        :: gdd0_lastyear, :: gdd0_thisyear,
!!                        :: precip_lastyear, :: precip_thisyear,
!!                        :: lm_lastyearmax, :: lm_thisyearmax,
!!                        :: maxfpc_lastyear, :: maxfpc_thisyear,
!!                        :: moiavail_month, :: moiavail_week,
!!                        :: t2m_longterm, :: tlong_ref, :: t2m_month, :: t2m_week,
!!                        :: tsoil_month, :: soilhum_month,
!!                        :: npp_longterm, :: turnover_longterm, :: gpp_week,
!!                        :: gdd_m5_dormance, :: gdd_midwinter,
!!                        :: ncd_dormance, :: ngd_minus5, :: time_lowgpp,
!!                        :: time_hum_min, :: hum_min_dormance
!!                        :: npp0_cumul !! Arsene 25-06-2014 NPPcumul ADD
!!
!! REFERENCES   :
!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P.
!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
!! - McNaughton, S.J., M. Oesterheld, D.A. Frank and K.J. Williams (1989),
!! Ecosystem-level patterns of primary productivity and herbivory in terrestrial
!! habitats, Nature, 341, 142-144.
!!
!! FLOWCHART    :
!! \latexonly
!! \includegraphics[scale = 1]{season_flowchart_part1.png}
!! \includegraphics[scale = 1]{season_flowchart_part2.png}
!! \includegraphics[scale = 1]{season_flowchart_part3.png}
!! \endlatexonly
!! \n
!_ =================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE     : deep_carbcycle
!!
!>\BRIEF          Recalculate vegetation cover and LAI
!!
!!\n DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S): None
!!
!! REFERENCE(S)   : None
!!
!! FLOWCHART :
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : altcalc
!!
!>\BRIEF        This routine calculate active layer thickness
!!
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) : alt
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : soil_gasdiff_alloc
!!
!>\BRIEF        This routine allocate arrays related to oxygen and methane in the snow/soil medium
!!
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) :
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : soil_gasdiff_coeff
!!
!>\BRIEF        This routine calculate coeff related to gas diffuvisity
!!
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) :
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : soil_gasdiff_diff
!!
!>\BRIEF        This routine update oxygen and methane in the snow and soil
!!
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) :
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : traMplan
!!
!>\BRIEF        This routine calculates plant-mediated transport of methane
!!
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) :
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : ebullition
!!
!>\BRIEF        This routine calculates CH4 ebullition
!!
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) :
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : microactem
!!
!>\BRIEF        This routine calculates parameters describing bacterial activity (time constant tau[s]) as a function of temperature
!!
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) :
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : snowlevels
!!
!>\BRIEF        This routine calculates depths of full levels and intermediate
!!              levels related to snow pack
!!
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) :
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : snow_interpol
!!
!>\BRIEF        This routine interpolates oxygen and methane into snow layers
!!
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) :
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : permafrost_carbon_clear
!!
!>\BRIEF
!!
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) :
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : initialize_yedoma_carbonstocks
!!
!>\BRIEF        This routine intialize soil carbon in yedoma region
!!
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) :
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : carbinput
!!
!>\BRIEF        This routine calculate carbon input to the soil
!!
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) :
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : cryoturbate
!!
!>\BRIEF        This routine calculates cryoturbation process
!!
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) :
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : permafrost_decomp
!!
!>\BRIEF        This routine calculates carbon decomposition
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) :
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!!
!================================================================================================================================
!! SUBROUTINE   : calc_vert_int_soil_carbon
!!
!>\BRIEF        This routine calculates carbon decomposition
!!
!! DESCRIPTION :
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) :
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART11    : None
!! \n
!_
!================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE   : constraints
!!
!>\BRIEF        Determine whether each PFT can adapt to and regenerate under the prevailing climate
!! conditions. Climate conditions are characterised by different threshold values for air temperature.
!!
!! DESCRIPTION : PFTs are adapted to the climate conditions if the daily air temperature does not drop below
!! the treshold values ::tcm_crit. Some PFT's do not have a ::tcm_crit treshold. Seasonal trees die if leafage
!! does not show a clear seasonality. (i.e. if the start of the growing season is never detected)
!!
!! If the monthly temperature is below ::tcm_crit i.e. the critical temperature of the coldest month, the
!! PFT will be able to regenerate. If minimum temperatures do not drop below ::tcm_crit, its regenerative
!! capacity decreases with time. Hence, plants that need vernalization die after a few years if they don't
!! vernalize (even if they would not loose their leaves).
!!
!! The treshold values ::t_min_crit, the critical temperature of the coldest month is defined in
!! stomate_constants.f90'. However, ::regenerate_min, the critical temperature to support regeneration is
!! calculated in this routine from parameters of which none depenent on the PFT. The value for
!! ::large_value is defined as 1.E33 in stomata_constraints
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S) : ::adapted (0-1, unitless) and ::regenerate (0-1, unitless)
!!
!! REFERENCE(S) : None
!!
!! FLOWCHART :
!! \latexonly
!!     \includegraphics[scale=0.3]{lpj_constraints_flowchart.png}
!! \endlatexonly
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! FUNCTION     : firefrac_func
!!
!>\BRIEF        Calculate the annual fire fraction using long term fire index
!!
!! DESCRIPTION	: None
!!
!! RECENT CHANGE(S): None
!!
!! RETURN VALUE : annual fire fraction (::firefrac_result)
!!
!! REFERENCES   :
!! - Thonicke K., Venevsky S., Sitch S., and Cramer W. (2001) The role of fire
!! disturbance for global vegetation dynamics: coupling fire into a Dynamic
!! Global Vegetation Model, Global Ecology & Biogeography, 10, 661-677.\n
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


! =================================================================================================================================
! SUBROUTINE   : establish
!
!>\BRIEF       Calculate sstablishment of new woody PFT and herbaceous PFTs
!!
!! DESCRIPTION : Establishments of new woody and herbaceous PFT are simulated.
!! Maximum establishment rate (0.12) declines due to competition for light (space).
!! There are two establishment estimates: one for the for DGVM and one for the
!! static cases.\n
!! In the case of DGVM, competitive process of establishment for the area of
!! available space is represented using more detailed description compared with static
!! one. Biomass and distribution of plant age are updated on the basis of changes
!! in number of individuals. Finally excess sapwood of is converted to heartwood.
!!
!! \latexonly
!! \input{equation_lpj_establish.tex}
!! \endlatexonly
!! \n
!!
!! RECENT CHANGE(S): None
!!
!! REFERENCE(S)    :
!! Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
!!    dynamics in the modelling of terrestrial ecosystems: comparing two
!!    contrasting approaches within European climate space,
!!    Global Ecology and Biogeography, 10, 621-637.
!!
!! FLOWCHART       :
!! \latexonly
!! \includegraphics[scale = 0.7]{establish.png}
!! \endlatexonly
!! \n
!_ ================================================================================================================================


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!! CUTTING
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Excute the same process for grids where flag_cutting=1


!! ================================================================================================================================
!! SUBROUTINE 	: stomate_init
!!
!>\BRIEF        The routine is called only at the first simulation. At that
!! time settings and flags are read and checked for internal consistency and
!! memory is allocated for the variables in stomate.
!!
!! DESCRIPTION  : The routine reads the
!! following flags from the run definition file:
!! -bavard (level of online diagnostic in stomate)\n
!! -ipd (index of grid point for online diagnostics)\n
!! -ok_herbivores (flag to activate herbivores)\n
!! -treat_expansion (flag to activate PFT expansion across a pixel\n
!! -harvest_agri (flag to harvest aboveground biomass from agricultural PFTs)\n
!! \n
!! Check for inconsistent setting between the following flags:
!! -control%ok_stomate\n
!! -control%ok_dgvm\n
!! -control%ok_co2\n
!! -ldforcing_write\n
!! \n
!! Memory is allocated for all the variables of stomate and new indexing tables
!! are build. New indexing tables are needed because a single pixel can conatin
!! several PFTs. The new indexing tables have separate indices for the different
!! PFTs. Similar index tables are build for land use cover change.\n
!! \n
!! Several global variables and land cover change variables are initialized to
!! zero.\n
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S): Strictly speaking the subroutine has no output
!! variables. However, the routine allocates memory and builds new indexing
!! variables for later use.\n
!!
!! REFERENCE(S)	: None
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE 	: stomate_clear
!!
!>\BRIEF        Deallocate memory of the stomate variables.
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S): None
!!
!! REFERENCES	: None
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE 	: stomate_var_init
!!
!>\BRIEF        Initialize variables of stomate with a none-zero initial value.
!! Subroutine is called only if ::ok_stomate = .TRUE. STOMATE diagnoses some
!! variables for SECHIBA : assim_param, deadleaf_cover, etc. These variables can
!! be recalculated from STOMATE's prognostic variables. Note that height is
!! saved in SECHIBA.
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S): leaf age (::leaf_age) and fraction of leaves in leaf
!! age class (::leaf_frac). The maximum water on vegetation available for
!! interception, fraction of soil covered by dead leaves
!! (::deadleaf_cover) and assimilation parameters (:: assim_param).
!!
!! REFERENCE(S)	: None
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE 	: stomate_accu
!!
!>\BRIEF        Accumulate a variable for the time period specified by
!! ::dt_tot or calculate the mean value over ::dt_tot.
!!
!! DESCRIPTION : None
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S): accumulated or mean variable ::field_out::
!!
!! REFERENCE(S)	: None
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE 	: init_forcing
!!
!>\BRIEF        Allocate memory for the variables containing the forcing data.
!! The maximum size of the allocated memory is specified in run definition file
!! (::max_totsize) and needs to be a compromise between charging the memory and
!! accessing disks to get the forcing data.
!!
!! DESCRIPTION : None
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S): Strictly speaking the subroutine has no output
!! variables. However, the routine allocates memory for later use.
!!
!! REFERENCE(S)	: None
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE 	: forcing_zero
!!
!>\BRIEF        Initialize variables containing the forcing data; variables are
!! set to zero.
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S): None
!!
!! REFERENCES	: None
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE 	: forcing_write
!!
!>\BRIEF        Appends data values to a netCDF file containing the forcing
!! variables of the general processes in stomate.
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S): netCDF file
!!
!! REFERENCES	: None
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE 	: forcing_read
!!
!>\BRIEF        Read forcing file.
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S) : None
!!
!! MAIN OUTPUT VARIABLE(S): None
!!
!! REFERENCES	: None
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


! two function of fertilization
! one is for each time
! the other one is for strategy spatialization of fertilization in management
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!  FERTILISATION a chaque pas de temps
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!! SPATIALISATION DE LA FERTILISATION GEREE PAR MANAGEMENT
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


!!!!!!!!!!!!!!!!!!!!!!!
!!!! 05212013 JCADD subroutine for reading management from map nc file
!!!!!!!!!!!!!!!!!!!!!!!


! Subroutine linreg_pasim for autogestion


!-
!===
!-
!! ================================================================================================================================
!! SUBROUTINE   : daily
!!
!>\BRIEF          This routine generates daily weather conditions from monthly-mean
!! climatic parameters.
!!
!! DESCRIPTION  :  Specifically, this routine generates daily values of
!!                 - daily total precipitation \n
!!                 - daily maximum temperature \n
!!                 - daily minimum temperature \n
!!                 - daily average cloud cover \n
!!                 - daily average relative humidity \n
!!                 - daily average wind speed \n
!!                 In order to generate daily weather conditions, the model uses
!!                 a series of 'weather generator' approaches,
!!                 which generate random combinations of weather conditions
!!                 based upon the climatological conditions in general. \n
!!                 This weather generator is based upon the so-called Richardson
!!                 weather generator. \n
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S): ::psurf, ::cloud, ::tmax, ::tmin, ::qd, ::ud, ::precip
!!
!! REFERENCE(S) :
!! -  Geng, S., F.W.T. Penning de Vries, and L. Supit, 1985:  A simple
!! method for generating rainfall data, Agricultural and Forest
!! Meteorology, 36, 363-376.
!! -  Richardson, C. W. and Wright, D. A., 1984: WGEN: A model for
!! generating daily weather variables: U. S. Department of
!! Agriculture, Agricultural Research Service.
!! - Richardson, C., 1981: Stochastic simulation of daily
!! precipitation, temperature, and solar radiation. Water Resources
!! Research 17, 182-190.
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! SUBROUTINE   : diurnal
!!
!>\BRIEF          This routine interpolates values from the!*
!! subroutine daily into instantaneous values for simulating a diurnal cycle.
!!
!! DESCRIPTION  :
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S):  ::fira, ::solad, ::ua, ::ta, ::qa, ::raina, ::snowa, ::rh.
!!
!! REFERENCE(S) :
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! SUBROUTINE   : weathgen_init
!!
!>\BRIEF         This subroutine initializes weather variables.
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S):  ::kindex, ::nbindex
!!
!! REFERENCE(S) :
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE   : weathgen_read_file
!!
!>\BRIEF         This subroutine allocates variables and reads files.
!!
!! DESCRIPTION  :
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S):
!!
!! REFERENCE(S) :
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!
!=
!
!! ================================================================================================================================
!! SUBROUTINE   : weathgen_begin
!!
!>\BRIEF         This subroutines initializes variables or reads restart values.
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S): ::nbindex, ::tair, ::pb, ::qair, ::kindex
!!
!! REFERENCE(S) :
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! SUBROUTINE   : weathgen_get
!!
!>\BRIEF        This subroutine initializes forcing values.
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S): ::swdown, ::raina, ::snowa, ::tair, ::u, ::v, ::qair, ::psurf, ::lwdown
!!
!! REFERENCE(S) :
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! SUBROUTINE   : weathgen_restwrite
!!
!>\BRIEF         This subroutine writes data in the restart file.
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S): None
!!
!! REFERENCE(S) :
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! SUBROUTINE   : weathgen_data
!!
!>\BRIEF         This subroutine reads data from an netcdf file.
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S): ::champout
!!
!! REFERENCE(S) :
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! SUBROUTINE   : weathgen_dump
!!
!>\BRIEF        This subroutine "dumps" data before writing an netcdf file.
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S):
!!
!! REFERENCE(S) :
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! SUBROUTINE   : gather_weather
!!
!>\BRIEF        This subroutine determines which points are not in the computational domain and
!! creates a mask for these points.
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S): ::var_out
!!
!! REFERENCE(S) :
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! SUBROUTINE   : shift_shield
!!
!>\BRIEF
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S): ::champ
!!
!! REFERENCE(S) :
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! FUNCTION     : tsat1
!!
!>\BRIEF         This function computes the saturated temperature for vapor.
!!
!! DESCRIPTION :  functions tsatl,tsati are used below so that Lowe's
!!                polyomial for liquid is used if t gt 273.16, or for ice if
!!                t lt 273.16. also impose range of validity for Lowe's polys.\n
!!
!! RECENT CHANGE(S): None
!!
!! RETURN VALUE : tsat
!!
!! REFERENCE(S) :
!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! FUNCTION     : tsati
!!
!>\BRIEF         This function computes the saturated temperature for ice.
!!
!! DESCRIPTION :  functions tsatl,tsati are used below so that Lowe's
!!                polyomial for liquid is used if t gt 273.16, or for ice if
!!                t lt 273.16. also impose range of validity for Lowe's polys.\n
!!
!! RECENT CHANGE(S): None
!!
!! RETURN VALUE : tsat
!!
!! REFERENCE(S) :
!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! FUNCTION     : esat
!!
!>\BRIEF         This function computes specific humidity with the polynomials of Lowe.
!!
!! DESCRIPTION : The function esat is svp in n/m**2, with t in deg k.
!!               (100 * lowe's poly since 1 mb = 100 n/m**2.). \n
!!               Polynomials for svp(t), d(svp)/dt over water and ice
!!
!! RECENT CHANGE(S): None
!!
!! RETURN VALUE : esatout
!!
!! REFERENCE(S) :
!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
! ================================================================================================================================
!! FUNCTION     : qsat
!!
!>\BRIEF         This function computes the saturation specific humidity.
!!
!! DESCRIPTION :  statement function qsat is saturation specific humidity,
!! with svp e and ambient pressure p in n/m**2. impose an upper
!! limit of 1 to avoid spurious values for very high svp
!! and/or small p
!!
!! RECENT CHANGE(S): None
!!
!! RETURN VALUE : qsatout
!!
!! REFERENCE(S) :
!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! SUBROUTINE   : weathgen_qsat
!!
!>\BRIEF        This subroutine calculates the saturation vapor pressure with the polynomials of Lowe.
!!
!! DESCRIPTION  : Vectorized version of functions esat and qsat.
!!                statement function esat is svp in n/m**2, with t in deg K.\n
!!               (100 * lowe's poly since 1 mb = 100 n/m**2.)\n
!!               Polynomials for svp(t), d(svp)/dt over water
!!               and ice are from Lowe(1977),jam,16,101-103 \n
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S): ::qsat
!!
!! REFERENCE(S) :
!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! SUBROUTINE   : weathgen_qsat_2d
!!
!>\BRIEF        This subroutine calculates the saturation vapor pressure with the polynomials of Lowe.
!!
!! DESCRIPTION  : Vectorized version of functions esat and qsat.
!!                statement function esat is svp in n/m**2, with t in deg K.\n
!!               (100 * lowe's poly since 1 mb = 100 n/m**2.)\n
!!               Polynomials for svp(t), d(svp)/dt over water
!!               and ice are from Lowe(1977),jam,16,101-103 \n
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S): ::qsat
!!
!! REFERENCE(S) :
!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!! ================================================================================================================================
!! SUBROUTINE   : mask_c_o
!!
!>\BRIEF        This subroutine computes a field which indicated if the point is terrestrial or oceanic.
!!
!! DESCRIPTION  : From a mask field, we make an indicator mask Earth/ocean. Earth : 1 ; ocean : 0.
!!
!! RECENT CHANGE(S): z.x.li,01/04/1994 : creation of the subroutine
!!
!! MAIN OUTPUT VARIABLE(S): ::mask, ::ncorr, ::icorr
!!
!! REFERENCE(S) :
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! SUBROUTINE   : dist_sphe
!!
!>\BRIEF        This subroutine computes the minimum distance between two points on Earth
!! according the great circle. \n
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S): Laurent Li, 30/12/1996 : creation of this subroutine
!!
!! MAIN OUTPUT VARIABLE(S): ::distance
!!
!! REFERENCE(S) :
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!-
!===
!-
!! ================================================================================================================================
!! SUBROUTINE   : permute
!!
!>\BRIEF         This subroutine initializes an array of size n by random integers between 1 and n.
!!
!! DESCRIPTION  : None
!!
!! RECENT CHANGE(S): None
!!
!! MAIN OUTPUT VARIABLE(S): ::ordre
!!
!! REFERENCE(S) :
!!
!! FLOWCHART    : None
!! \n
!_ ================================================================================================================================


!
!  Public interfaces
!
!
!  Start timing region.
!


!
!  End timing region.
!


!
!  Produce timing report
!


!
!  Linear insertion with linear search (Algorithm L)
!


!
!
!  Start new i/o unit .
!


!
!  End an i/o-unit
!


!
!  Start new array.
!


!
!  End an array-unit
!


!-----------------------------------------------------------------------
! SUBROUTINE read_quad(A,factor)
!
! !  Read the next item from the buffer as a real (quadruple precision) number.
! !  If the optional argument factor is present, the value read should be
! !  divided by it. (External value = factor*internal value)
!
! REAL(KIND=qp), INTENT(INOUT) :: a
! REAL(KIND=qp), INTENT(IN), OPTIONAL :: factor
!
! CHARACTER(LEN=50) :: string
!
! if (clear) a=0.0_qp
!
! !  If there are no more items on the line, I is unchanged
! if (item .ge. nitems) return
!
! string=""
! call reada(string)
! !  If the item is null, I is unchanged
! if (string == "") return
! read (unit=string,fmt=*,err=99) a
! if (present(factor)) then
!   a=a/factor
! endif
! return
!
! 99 a=0.0_qp
! select case(nerror)
! case(-1,0)
!   call report("Error while reading real number",.true.)
! case(1)
!   print "(2a)", "Error while reading real number. Input is ", trim(string)
! case(2)
!   nerror=-1
! end select
!
! END SUBROUTINE read_quad
!-----------------------------------------------------------------------


!
!
! A sampling version of the Lorentzian line profile
!


!
! computing cross sections errors using energy uncertainties and Lorentz line profile


!C  (C) Copr. 1986-92 Numerical Recipes Software


!Check if the lorentzian is the same


!-----------Humlicek methods----------------------!
! This should be heavily vectorized by the compiler


!! *Description*:
!!
!! Returns the radius of the Hill sphere
!!
!!    r_H ~ a_1(1-e_1) * (mass_1/3mass_2)^(1/3))
!!
!! where M_1 and M_2 are the masses of the object whose Hill-sphere
!! radius is sought (e.g., the Earth) and the object around which
!! the previous revolves (e.g., the Sun), respectively. The
!! semimajor axis a_1 and eccentricity e_1 refer to the previous
!! object. The default values for a_1 (= 1.0 AU) and e_1 (= 0) will
!! be used if they are not explicitly given.
!!


!! *Description*:
!!
!! If used for the first time during execution, this routine reads
!! the planetary ephemerides from a given file (e.g., JPL's deXXX.dat
!! or IMCCE's inpopXXX.dat) and stores the data in an array.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Deallocates memory used by the planetary ephemerides. Should be
!! used at the very end of an executable.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Reads the planetary ephemeris table, carries out interpolations,
!! and returns the position and velocity of the point 'ntarget' with
!! respect to 'ncenter'.
!!
!! ntarget = integer number of target point.
!!
!! ncentet = integer number of center point.
!!
!! The numbering convention for 'ntarget' and 'ncenter' is:
!!
!!

!!         1 = Mercury            8 = Neptune
!!         2 = Venus              9 = Pluto
!!         3 = Earth             10 = Moon
!!         4 = Mars              11 = Sun
!!         5 = Jupiter          (12 = solar-system barycenter)
!!         6 = Saturn           (13 = earth-moon barycenter)
!!         7 = Uranus           (14 = nutations (longitude and obliq))
!!                              (15 = librations, if on eph file)
!!

!!  Additional: -10 = 9 planets + Moon
!!
!! If nutations are wanted, set ntarget = 14, and for librations,
!! set ntarget = 15. Set ncenter = 0.
!!
!! Output is a 6-vector containing position and velocity of point
!! 'ntarget' relative to 'ncenter' in an equatorial reference
!! frame. The units are AU and AU/day.  For librations the units are
!! radians and radians per day.
!!
!! Returns error.
!!
!! ntarget=-10 and ncenter=11 tested to produce correct results.
!! ntarget=-10 and ncenter=12 tested to produce correct results.
!!
! In the case
! of nutations the first four words of rrd will be set to nutations and
! rates, having units of radians and radians/day.
!!
!! Known errors:
!!
!!  ntarget  ncenter
!!    13       any, except 12
!!    -9       11
!!    -9       12
!!


!! *Description*:
!!
!! Same as planetary_ephemeris_r8, but with digits allowing greater
!! numerical accuracy, i.e., the accuracy of values is the same
!! as for planetary_ephemeris_r8.
!!


!! *Description*:
!!
!! Reads the planetary ephemeris table, carries out interpolations,
!! and returns the position and velocity of the point 'ntarget' with
!! respect to 'ncenter'.
!!
!! ntarget = integer number of target point.
!!
!! ncentet = integer number of center point.
!!
!! The numbering convention for 'ntarget' and 'ncenter' is:
!!
!!

!!         1 = Mercury            8 = Neptune
!!         2 = Venus              9 = Pluto
!!         3 = Earth             10 = Moon
!!         4 = Mars              11 = Sun
!!         5 = Jupiter          (12 = solar-system barycenter)
!!         6 = Saturn           (13 = earth-moon barycenter)
!!         7 = Uranus           (14 = nutations (longitude and obliq))
!!                              (15 = librations, if on eph file)
!!

!!  Additional: -10 = 9 planets + Moon
!!
!! If nutations are wanted, set ntarget = 14, and for librations,
!! set ntarget = 15. Set ncenter = 0.
!!
!! Output is a CartesianCoordinates object (crtcrd) containing
!! position and velocity of point 'ntarget' relative to
!! 'ncenter'. The units are au and au/day.  For librations the units
!! are radians and radians per day.
!!
!! Returns error.
!!
!! ntarget=-10 and ncenter=11 tested to produce correct results.
!! ntarget=-10 and ncenter=12 tested to produce correct results.
!!
! In the case
! of nutations the first four words of rrd will be set to nutations and
! rates, having units of radians and radians/day.
!!
!! Known errors:
!!
!!  ntarget  ncenter
!!    13        *
!!    -9       11
!!    -9       12
!!


!! *Description*:
!!
!! Reads the jpl planetary ephemeris and gives the position and
!! velocity of the point 'ntarget' with respect to 'ncenter'.
!!
!! ntarget = integer number of target point.
!!
!! ncentet = integer number of center point.
!!
!! The numbering convention for 'ntarget' and 'ncenter' is:
!!
!!

!!         1 = mercury           8 = neptune
!!         2 = venus             9 = pluto
!!         3 = earth            10 = moon
!!         4 = mars             11 = sun
!!         5 = jupiter          (12 = solar-system barycenter)
!!         6 = saturn           (13 = earth-moon barycenter)
!!         7 = uranus           (14 = nutations (longitude and obliq))
!!                              (15 = librations, if on eph file)
!!

!!
!! If nutations are wanted, set ntarget = 14, and for librations,
!! set ntarget = 15. Set ncenter = 0.
!!
!! Output is a CartesianCoordinates object (crtcrd) containing position and velocity
!! of point 'ntarget' relative to 'ncenter'. the units are AU and AU/day.
!! For librations the units are radians and radians per day.
!!
!! Returns error.
!!
! In the case
! of nutations the first four words of rrd will be set to nutations and
! rates, having units of radians and radians/day.
!!


!! *Description*:
!!
!! The Roche limit 'd' for a fluid satellite where
!!
!!    d ~ 2.44 * r_planet * (rho_planet/rho_satellite)^(1/3))
!!
!! and r_planet and rho_planet are the radius and bulk density of
!! the planet, and rho_satellite is the bulk density of the
!! satellite.
!!


!! *Description*:
!!
!! If used for the first time during execution, this routine reads
!! the BC430 asteroid ephemerides from a given file and stores the
!! data in an array.
!!
!! Returns error.
!!


! Returns the BC430 masses for nastpert asteroids.


!! *Description*:
!!
!! Reads the BC430 asteroid Ephemeris and gives the position and
!! velocity of the nastpert most massive asteroids at epoch mjd_tt.
!!
!! nastpert = integer amount of asteroids wanted. Starts from
!! most massive ones -> need a better scheme later. 300 = everything.
!! Output is a 6-vector containing position and velocity of point
!! 'nastpert' relative to 'ncenter' in an equatorial reference
!! frame. The units are AU and AU/day.
!!
!! Returns error.
!!


!! Description:
!!   Bulirsch-Stoer scheme.
!!   Rational function extrapolation w/ modified midpoint.
!!
!! References:
!!   [1] Press et al. 1989, Numerical Recipes.
!!   [2] Stoer & Bulirsch 1980, Introduction to Num. Anal.
!!
!! Usage:
!!   CALL bulirsch_full_planeph(mjd_tdt0, mjd_tdt1, &
!!                          celements, error, jacobian, step)
!!
!! mjd_tdt0         integration start (MJD TT)
!! mjd_tdt1         integration stop (MJD TT)
!! celements        initial coordinates for massless particles (1:6,1:nparticles)
!! error            returns true, if something fails
!! jacobian         jacobian matrix (coordinates wrt initial coordinates)
!! step             step size
!! ncenter          number of solar-system object to use as center (default=Sun)
!! encounters       table containing the closest distances to, or earliest
!!                  time of impact with solar-system objects
!! masses           masses for additional perturbing bodies
!!


!! One integration step.
!!
!!  mjd_tdt  modified Julian date (for ephemerides)
!!  H        step size
!!  ws0      initial coordinates for the massless bodies
!!  ws1      final coordinates for the massless bodies
!!  error    returns true, if something fails
!!  pws0     initial values of the partial derivatives
!!  pws1     final values of the partial derivatives
!!


!! Description:
!!   Modified midpoint step (2nd order).
!!
!! References:
!!   [1] Press et al. 1989, Numerical Recipes.
!!
!! Usage:
!!   CALL step_midpoint_full_planeph(mjd_tdt, h, nsteps, ws0, ws1,
!!                               error, pws0, pws1)
!!
!! One integration step.
!!
!!  mjd_tdt  modified Julian date (for ephemerides)
!!  h        (big) step size
!!  nsteps   number of substeps
!!  ws0      initial coordinates for the massless bodies
!!  ws1      final coordinates for the massless bodies
!!  error    returns true, if something fails
!!  pws0     initial values of the partial derivatives
!!  pws1     final values of the partial derivatives
!!


!! *Description*:
!!
!!   Rational and polynomial function extrapolation for
!!   (Gragg-)Bulirsch-Stoer integration.
!!
!!   These routines are applicable to single vectors or single matrices
!!   or to groups of vectors or matrices.
!!   Extrapolation is always towards zero.
!!   Extrapolation converges when all of the elements of a vector/matrix
!!   are converged. For groups of N vectors/matrices, convergence is checked
!!   individually N times.
!!
!! References:
!!   [1] Press et al. 1989, Numerical Recipes.
!!   [2] Stoer & Bulirsch 1980, Introduction to Num. Anal.
!!
!! Usage:
!!   CALL ratf_extrapolation(z, h, w0, w1, ddif, converged)
!!   CALL polf_extrapolation(z, h, w0, w1, ddif, converged)
!!
!! Fill one diagonal in rational function extrapolation table.
!! Applicable to vectors.
!!
!!  z          index to process in extrapolation table
!!  h          sequence of step sizes used
!!  w0         integrations corresponding the step sizes h
!!  w1         extrapolated values with z integrations
!!  ddif       extrapolation table with differences (see below)
!!  converged  flag for convergence
!!


!! Fill one diagonal in polynomial function extrapolation table.
!! Applicable to vectors.
!!
!!  z          index to process in extrapolation table
!!  h          sequence of step sizes used
!!  w0         integrations corresponding the step sizes h
!!  w1         extrapolated values with z integrations
!!  ddif       extrapolation table with differences
!!  converged  flag for convergence
!!


!! Fill one diagonal in rational function extrapolation table.
!! Applicable to matrices.
!!
!!  z          index to process in extrapolation table
!!  h          sequence of step sizes used
!!  w0         integrations corresponding the step sizes h
!!  w1         extrapolated values with z integrations
!!  ddif       extrapolation table with differences (see below)
!!  converged  flag for convergence
!!


!! Fill one diagonal in polynomial function extrapolation table.
!! Applicable to matrices.
!!
!!  z          index to process in extrapolation table
!!  h          sequence of step sizes used
!!  w0         integrations corresponding the step sizes h
!!  w1         extrapolated values with z integrations
!!  ddif       extrapolation table with differences
!!  converged  flag for convergence
!!


!! Fill one diagonal in rational function extrapolation table.
!! Applicable to N individual vectors.
!!
!!  z          index to process in extrapolation table
!!  h          sequence of step sizes used
!!  w0         integrations corresponding the step sizes h
!!  w1         extrapolated values with z integrations
!!  ddif       extrapolation table with differences (see below)
!!  converged  flags for convergence
!!


!! Fill one diagonal in polynomial function extrapolation table.
!! Applicable to N individual vectors.
!!
!!  z          index to process in extrapolation table
!!  h          sequence of step sizes used
!!  w0         integrations corresponding the step sizes h
!!  w1         extrapolated values with z integrations
!!  ddif       extrapolation table with differences (see below)
!!  converged  flags for convergence
!!


!! Fill one diagonal in rational function extrapolation table.
!! Applicable to N individual matrices.
!!
!!  z          index to process in extrapolation table
!!  h          sequence of step sizes used
!!  w0         integrations corresponding the step sizes h
!!  w1         extrapolated values with z integrations
!!  ddif       extrapolation table with differences (see below)
!!  converged  flags for convergence
!!


!! Fill one diagonal in polynomial function extrapolation table.
!! Applicable to N individual matrices.
!!
!!  z          index to process in extrapolation table
!!  h          sequence of step sizes used
!!  w0         integrations corresponding the step sizes h
!!  w1         extrapolated values with z integrations
!!  ddif       extrapolation table with differences (see below)
!!  converged  flags for convergence
!!


!! Gauss-Radau integrator by Edgar Everhart
!! (Physics Department, University of Denver)
!!
!! This 15th-order version is written out for faster execution.
!! y'=f(y,t) is clss=1, y"=f(y,t) is clss= -2, and y"=f(y',y,t)
!! is clss=2. mjd_tdt1 is t(final), and mjd_tdt0 is t(initial).
!! ll controls sequence size. Thus ss=10**(-ll) controls the size
!! of a term. A typical ll-value is in the range 6 to 12. However,
!! if ll<0 then step is the constant sequence size used. celements
!! enter as the starting position-velocity vector, at time
!! mjd_tdt0, and are output as the final position-velocity vector
!! at time mjd_tdt1. Integration is in real(8) precision, also
!! known as 'double precision'.
!!
!! References:
!! E. Everhart (1985), 'An efficient integrator that uses
!! Gauss-Radau spacings', A. Carusi and G. B. Valsecchi (eds.),
!! Dynamics of Comets: Their Origin and Evolution (proceedings),
!! Astrophysics and Space Science Library, vol. 115, D. Reidel
!! Publishing Company
!!
!! E. Everhart (1974), 'Implicit single-sequence methods for
!! integrating orbits', Celestial Mechanics, vol. 10, no. 1,
!! pp. 35-55
!!
!!
!! Input/output parameters:
!! mjd_tdt0         integration start (MJD TT)
!! mjd_tdt1         integration stop (MJD TT)
!! celements        initial coordinates for massless particles and additional perturbers (1:6,1:nparticles)
!! ll
!! clss
!! perturbers
!! error            returns true, if something fails
!! jacobian         jacobian matrix (new coordinates wrt initial coordinates)
!! step             step size
!! ncenter          number of solar-system object to use as center (default=Sun)
!! encounters       table containing the closest distances to, or earliest
!!                  time of impact with solar-system objects
!! masses     masses for additional perturbing bodies
!!
!!
!! @author MG (in f95)
!! @version   01.03.2010
!!
!!
!! WARNING: jacobians do not yet work properly!
!!


!! Description:
!!
!! Evaluation of the full Newtonian force function for several
!! massless bodies. Positions of the massive bodies are read from
!! JPL (deXXX) or IMCCE (inpopXXX) ephemerides. A relativistic term
!! due to the Sun is included.  Optional argument triggers
!! evaluation of the partial derivatives of the force function wrt
!! Cartesian coordinates.
!!
!! References:
!!   [1] Karttunen, Taivaanmekaniikka
!!
!! Usage:
!!   CALL interact_full_planeph(ws, mjd_tdt, wds, error, pwds)
!!
!! Interaction.
!!
!!  ws           heliocentric, equatorial, Cartesian coordinates for bodies
!!                that need to be integrated (massless particles +
!!                additional perturbers)
!!  mjd_tdt      modified Julian date (for ephemerides)
!!  wds          evaluated force function
!!  perturbers   boolean mask for the basic set of perturbers available (true = use in force model)
!!  error        true, if reading from ephemerides fails
!!  pwds         evaluated partial derivatives of the force function
!!  encounters   encounters(i,j) where i=massless particle,
!!                j=perturber, encounters(i,j)=1 or 2, where 1=within
!!                planetary radius (~collision) and 2=outside
!!                planetary radius
!!  masses       masses for additional perturbers
!!  radial_acceleration scalar of force to be added in the direction
!!               radially outwards from the origin (usually the Sun)
!!               this is aimed for accounting for radiation pressure
!!


!! Description:
!!
!! Evaluation of the full Newtonian force function for several
!! massless bodies. Positions of the massive bodies are read from
!! JPL (deXXX) or IMCCE (inpopXXX) ephemerides. A relativistic term
!! due to the Sun is included.  Optional argument triggers
!! evaluation of the partial derivatives of the force function wrt
!! Cartesian coordinates.
!!
!! References:
!!   [1] Karttunen, Taivaanmekaniikka
!!
!! Usage:
!!   CALL interact_full_planeph(ws, mjd_tdt, wds, error, pwds)
!!
!! Interaction.
!!
!!  ws       planetocentric, ecliptical (are not they equatorial??), Cartesian coordinates
!!                 for the massless bodies
!!  mjd_tdt  modified Julian date (for ephemerides)
!!  wds      evaluated force function
!!  error    true, if reading from ephemerides fails
!!  pwds     evaluated partial derivatives of the force function
!!


!!!!!!!!!
!
! Subroutines and functions that implement the universal Kepler
! solver by Wisdom and Hernandez (2015, MNRAS 453,
! 3015-3023). Translation from original C code to Fortran 90 by MG.
!


!! *Description*:
!!
!! Extrapolates by a factor fac through the face of the
!! simplex across from the high point, tries it, and replaces
!! the high point if the new point is better.
!!


!! *Description*:
!!
!! Computes a histogram (histo) for given data (indata) either as
!! number density (without pdf) or from pdf (with pdf).
!!


!! *Description*:
!!
!! Computes various statistical quantities for a given data set.
!! Current output: arithmetic mean, standard deviation, skewness,
!! and kurtosis.
!!


!! *Description*:
!!
!! This routine calculates the end points of the confidence interval
!! (or credible interval) by incorporating bins of a histogram until
!! the sum of normalized weights is larger than the requested
!! probability mass.
!!


!! *Description*:
!!
!! This routine calculates the end points of the confidence interval
!! (or credible interval) by descending from the ML solution until
!! the sum of normalized weights is larger than the requested
!! probability mass.
!!


!! *Description*:
!!
!! Returns the Mahalanobis distance given the information matrix
!! (ie, inverse covariance matrix) and residuals of a given
!! observation.
!!


!! *Description*:
!!
!! Determines Stumpff-function c_k(x) by using series. The number of
!! terms is dictated by the precision: the series is truncated when
!! the accuracy given by additional terms can not be presented with
!! the used precision.
!!
!! Input values: x=R and k=0,1,2,...
!!
!! If k<0, the function returns 0.
!!


!! *Description*:
!!
!! Determines Stumpff-function c_k(x) by using the recursion
!! formula.
!!
!! If 'to_higher' is abscent or .false., the function returns c_k(x)
!! assuming that 'stumpff' is c_(k+2)(x). If 'to_higher' is .true.,
!! the function returns c_(k+2)(x) assuming that 'stumpff' is
!! c_(k)(x).
!!
!! Input values: x=R, k=0,1,2,..., stumpff>0
!!
!! If k<0 or stumpff<=0, the function returns 0.
!!


!!$  SUBROUTINE insert_list_node_ch1024_i4(list, key)
!!$
!!$    IMPLICIT NONE
!!$    TYPE (lnkd_list_ch1024_i4), POINTER :: list
!!$    INTEGER(iprec4), INTENT(in) :: key
!!$    TYPE (lnkd_list_node_ch1024_i4), POINTER :: new_node
!!$
!!$    ALLOCATE(new_node)
!!$    new_node%next => list%nil
!!$    new_node%key = key
!!$    !new_node%str = str
!!$    IF (ASSOCIATED(list%tail,list%nil) .AND. &
!!$         ASSOCIATED(list%head,list%nil)) THEN
!!$       list%head => new_node
!!$       list%tail => new_node
!!$    ELSE
!!$       list%tail%next => new_node
!!$       list%tail => list%tail%next
!!$    END IF
!!$
!!$  END SUBROUTINE insert_list_node_ch1024_i4


!! *Description*:
!!
!! This algorithm was presented during the "Tietorakenteet" course
!! organized in Spring 2006 at the Department of Computer Science
!! at the University of Helsinki. The results are identical with the
!! version by Cormen et al. (Introduction to algorithms, 2003, MIT
!! Press).
!!
!!$  FUNCTION delete_tree_node_rb_i8(tree, z) RESULT(y)
!!$
!!$    IMPLICIT NONE
!!$    TYPE (rb_tree_i8), POINTER :: tree
!!$    TYPE (rb_tree_node_i8), POINTER :: z, y
!!$    TYPE (rb_tree_node_i8), POINTER :: x, w
!!$
!!$    IF (ASSOCIATED(z%lchild,tree%nil) .OR. ASSOCIATED(z%rchild,tree%nil)) THEN
!!$       if (.not.associated(z%lchild,tree%nil)) then
!!$          x => z%lchild
!!$       else
!!$          x => z%rchild
!!$       end if
!!$       w => z%parent
!!$       if (associated(w,tree%nil)) then
!!$          tree%root => x
!!$       else
!!$          if (associated(z,w%lchild)) then
!!$             w%lchild => x
!!$          else
!!$             w%rchild => x
!!$          end if
!!$       end if
!!$       x%parent => w
!!$       if (.not.z%red) then
!!$          CALL rb_delete_fixup(tree, x)
!!$       end if
!!$       y => z
!!$    else
!!$       y => successor(tree, z)
!!$       x => y%rchild
!!$       w => y%parent
!!$       IF (ASSOCIATED(y,w%lchild)) THEN
!!$          w%lchild => x
!!$       else
!!$          w%rchild => x
!!$       end IF
!!$       x%parent => w
!!$       z%key = y%key
!!$       z%data_list => y%data_list
!!$       IF (.NOT.y%red) THEN
!!$          CALL rb_delete_fixup(tree, x)
!!$       END IF
!!$    end IF
!!$
!!$  END FUNCTION delete_tree_node_rb_i8


!! *Description*:
!!
!! The insertion sort technique is the same as the one used for
!! sorting cards: Pick out the second card and put it in order with
!! the first card. Then pick out the third card and put it into the
!! sequence among the first two. Continue until the last card has
!! been picked out and inserted. In a random situation the algorithm
!! scales as N**2, but assuming an almost sorted array it can even
!! reach N.  Generally, the insertion sort should not be used
!! for N >= 100. This implementation is an in-place sort.
!!


!! *Description*:
!!
!! Binary search routine. Returns the position of the search key in
!! the one-dimensional input array. If the search key is not found,
!! it returns -1.
!!
!! As a prerequisite, the array which is to be scanned has to be sorted
!! in ascending order. The algorithm searches for the search
!! key by repeatedly dividing the search interval in half. Initially
!! the interval covers the whole array. If the item in the middle of
!! the interval is larger than the key, the interval is narrowed to
!! the lower half. Otherwise it is narrowed to the upper half. The
!! procedure is continued until the value is found, or the interval
!! is empty.
!!


!! *Description*:
!!
!! Binary search routine. Returns the position where the key value
!! should be found (starting from left) in the one-dimensional input
!! array, if the array is sorted in ascending order.
!!
!! As a prerequisite, the array which is to be scanned has to be sorted
!! in ascending order. The algorithm searches for the value by
!! repeatedly dividing the search interval in half. Initially
!! the interval covers the whole array. If the item in the middle of
!! the interval is larger than the value, the interval is narrowed to
!! the lower half. Otherwise it is narrowed to the upper half. The
!! procedure is continued until the interval is empty.
!!


!! *Description*:
!!
!! Binary search routine. Returns the position where the key value
!! should be found (starting from left) in the one-dimensional input
!! array, given an index array providing the ascending order of the
!! array elements.
!!
!! As a prerequisite, the array which is to be scanned has to be sorted
!! in ascending order. The algorithm searches for the value by
!! repeatedly dividing the search interval in half. Initially
!! the interval covers the whole array. If the item in the middle of
!! the interval is larger than the value, the interval is narrowed to
!! the lower half. Otherwise it is narrowed to the upper half. The
!! procedure is continued until the interval is empty.
!!


!! *Description*:
!!
!! Computes all eigenvalues and eigenvectors of a real symmetric
!! N x N matrix 'a'. 'd' is a vector of length N that returns the
!! eigenvalues of 'a'. 'v' is an N x N matrix whose columns contain,
!! on output, the normalized eigenvectors of 'a'. 'nrot' returns the
!! number of Jacobi rotations that were required.
!!
!! Reference:
!! Press, Teukolsky, Vetterling, and Flannery: Numerical Recipes in
!! Fortran 90 -- The Art of Parallel Scientific Computing, 2nd Ed.,
!! 1999, Cambridge University Press, pp. 1225--1227.
!!


!! *Description*:
!!
!! Returns an identity matrix of a given dimension.
!!


!! *Description*:
!!
!! Ref. Numerical Recipes for Fortran 90, Sect. 23.5
!!


!! *Description*:
!!
!! Returns the triple product (x dot (y cross z)) of three vectors
!! with three elements.
!!


!! *Description*:
!!
!! Returns cross product of two 3-vectors.
!!


!! Description:
!!
!! This subroutine takes a 2D distribution and computes its
!! cumulative version as a function of rows and columns.
!!
!! Programming interface:
!!
!! Name         In/out  Type          Structure  Meaning
!!
!! in           in      real(8)       array      Incremental 2D distribution
!! out          out     real(8)       array      Cumulative 2D distribution
!!
!! Errors:
!!
!! No errors should occur and none are trapped.
!!


!! *Description*:
!!
!! Converts a string to a integer(4) number. An error is reported if
!! the string cannot be converted to number.
!!


!! *Description*:
!!
!! Converts a string to a real(prec8) number. An error is reported if
!! the string cannot be converted to number.
!!


!! *Description*:
!!
!! Converts a string to a real(16) number. An error is reported if
!! the string cannot be converted to number.
!!


!! *Description*:
!!
!! This subroutine returns the input string with all the lowercase
!! letters converted to uppercase letters.
!!


!! *Description*:
!!
!! This subroutine returns the input string with all the uppercase
!! letters converted to lowercase letters.
!!


!! Moved from Base_class.f90.


!! *Description*:
!!
!! Decodes an encoded MPC type date.
!!
!! Example:
!!
!! K01AM -> 2001 11 22
!!
!! Returns error.
!!


!!$  subroutine writeMercuryOrbitFile(lu, print_header, type, &
!!$       element_type_out, id, orb, mass, close_encounter_threshold,)
!!$
!!$    implicit none
!!$
!!$    if (print_header) then
!!$       write(lu,"(A)") ")O+_06 Big-body initial data  (WARNING: Do not delete this line!!)"
!!$       write(lu,"(A)") ") Lines beginning with `)' are ignored."
!!$       write(lu,"(A)") ")---------------------------------------------------------------------"
!!$       write(lu,"(A)") " style (Cartesian, Asteroidal, Cometary) = Cartesian"
!!$       write(lu,"(A)") " epoch (in days) = 2451000.5"
!!$       write(lu,"(A)") ")---------------------------------------------------------------------"
!!$    end if
!!$    write(lu,"(A,1X,'m=',F)") trim(id), ,
!!$
!!$
!!$  end subroutine writeMercuryOrbitFile


!! *Description*:
!!
!! Initializes object using default values:
!!   - position and velocity vectors are zero
!!   - coordinate frame is equatorial
!!   - epoch is the default Time object
!!
!! Returns error.
!!


!! *Description*:
!!
!! Initializes object using values given as spherical coordinates
!! and their time derivatives, the coordinate frame, and the epoch.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Initializes object using values given as the traditional
!! astrometric coordinates, and a Time object. Coordinate
!! frame is equatorial, and the distance and the velocity
!! vector are set to zero.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Initializes object using values given as the traditional
!! astrometric coordinates, the distance, and a Time object.
!! Coordinate frame is equatorial, and the velocity vector
!! is set to zero.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Initializes object using values given as the longitude,
!! latitude, and a Time object. Angles are given in radians.
!! Coordinate frame is equatorial, and the distance and the
!! velocity vector are set to zero.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Initializes object using values given as the distance [AU],
!! longitude, latitude, and a Time object. Angles are given in
!! radians. Coordinate frame is equatorial, and the
!! velocity vector is set to zero.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Initializes object using values given as the position and
!! velocity vectors, the coordinate frame, and a Time object
!! for the epoch.
!!
!! The vectors contain:
!!    - position(1): distance   [AU]
!!    - position(2): longitude  [rad]
!!    - position(3): latitude   [rad]
!!    - velocity(1): ddistance  [AU/d]
!!    - velocity(2): dlongitude [rad/d]
!!    - velocity(3): dlatitude  [rad/d]
!!
!! Returns error.
!!


!! *Description*:
!!
!! Nullifies this object.
!!


!! *Description*:
!!
!! Returns a copy of this object.
!!


!! *Description*:
!!
!! Returns the status of this object, i.e. whether
!! it exists or not.
!!


!! *Description*:
!!
!! Adds Gaussian deviates to the coordinates. The new center
!! relative to the original coordinates and the standard deviations
!! should be given in radians for the angular space coordinates, AUs
!! for distance, radians per day for angular velocities and AU per
!! day for line-of-sight velocity. Outputs the final values for
!! center (which should not change) and deviates.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Adds uniform deviates to the coordinates. The center relative to
!! the original coordinates and the absolute values of the boundary
!! values ((i,1)=center, (i,2)=abs(boundary), position i=1:3 and
!! velocity i=4:6) should be given in radians for the angular space
!! coordinates, AUs for distance, radians per day for angular
!! velocities and AUs per day for line-of-sight velocity.
!!
!! Returns error.
!!


! Description:
!
! Checks that longitude and latitude are within [0,2pi] and
! [-pi/2,pi/2], respectively.
!


!! *Description*:
!!
!! Reallocates a pointer array of SphericalCoordinates-objects and
!! copies the data from the old array to the new array (if it fits).
!!
!! *Usage*:
!!
!! myscoords => reallocate(myscoords,4)
!!
!! Returns error.
!!


!! *Description*:
!!
!! Reallocates a pointer array of SphericalCoordinates-objects and
!! copies the data from the old array to the new array (if it fits).
!!
!! *Usage*:
!!
!! myscoords => reallocate(myscoords,4,2)
!!
!! Returns error.
!!


!! *Description*:
!!
!!
!! Rotates position coordinates to equatorial coordinates.
!! Optionally, returns partial derivatives between final and initial
!! coordinates. An identity matrix is returned if the coordinates
!! are not changed, otherwise:
!!
!! dr_eq/dr_ec    dr_eq/dlon_ec    dr_eq/dlat_ec    dr_eq/ddr_ec    dr_eq/ddlon_ec    dr_eq/ddlat_ec
!!
!! dlon_eq/dr_ec  dlon_eq/dlon_ec  dlon_eq/dlat_ec  dlon_eq/ddr_ec  dlon_eq/ddlon_ec  dlon_eq/ddlat_ec
!!
!! dlat_eq/dr_ec  dlat_eq/dlon_ec  dlat_eq/dlat_ec  dlat_eq/ddr_ec  dlat_eq/ddlon_ec  dlat_eq/ddlat_ec
!!
!! ddr_eq/dr_ec   ddr_eq/dlon_ec   ddr_eq/dlat_ec   ddr_eq/ddr_ec   ddr_eq/ddlon_ec   ddr_eq/ddlat_ec
!!
!! ddlon_eq/dr_ec ddlon_eq/dlon_ec ddlon_eq/dlat_ec ddlon_eq/ddr_ec ddlon_eq/ddlon_ec ddlon_eq/ddlat_ec
!!
!! ddlat_eq/dr_ec ddlat_eq/dlon_ec ddlat_eq/dlat_ec ddlat_eq/ddr_ec ddlat_eq/ddlon_ec ddlat_eq/ddlat_ec
!!


!! *Description*:
!!
!! Rotates position coordinates to ecliptic coordinates.
!! Optionally, returns partial derivatives between final and initial
!! coordinates. An identity matrix is returned if the coordinates
!! are not changed, otherwise:
!!
!! dr_ec/dr_eq    dr_ec/dlon_eq    dr_ec/dlat_eq    dr_ec/ddr_eq    dr_ec/ddlon_eq    dr_ec/ddlat_eq
!!
!! dlon_ec/dr_eq  dlon_ec/dlon_eq  dlon_ec/dlat_eq  dlon_ec/ddr_eq  dlon_ec/ddlon_eq  dlon_ec/ddlat_eq
!!
!! dlat_ec/dr_eq  dlat_ec/dlon_eq  dlat_ec/dlat_eq  dlat_ec/ddr_eq  dlat_ec/ddlon_eq  dlat_ec/ddlat_eq
!!
!! ddr_ec/dr_eq   ddr_ec/dlon_eq   ddr_ec/dlat_eq   ddr_ec/ddr_eq   ddr_ec/ddlon_eq   ddr_ec/ddlat_eq
!!
!! ddlon_ec/dr_eq ddlon_ec/dlon_eq ddlon_ec/dlat_eq ddlon_ec/ddr_eq ddlon_ec/ddlon_eq ddlon_ec/ddlat_eq
!!
!! ddlat_ec/dr_eq ddlat_ec/dlon_eq ddlat_ec/dlat_eq ddlat_ec/ddr_eq ddlat_ec/ddlon_eq ddlat_ec/ddlat_eq
!!


!! *Description*:
!!
!! Initializes a PhysicalParameters object.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Returns a copy of this object.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Returns the status of the object, i.e. whether it exists or not.
!!


!! *Description*:
!!
!! Compute near-Earth-asteroid thermal model (NEATM) flux in the
!! wavelength domain. (Ref: Michael Mommert's PhD thesis 2013)
!!
!! Input:
!!
!!  T           :: temperature [K]
!!  lambda_min  :: lower limit for wavelength [m]
!!  lambda_max  :: upper limit for wavelength [m]
!!  phase_angle :: solar phase angle [rad]
!!
!! Output:
!!
!!  B           :: blackbody spectrum [W m^-2 m^-1 sterad^-1]
!!
!! Returns error.
!!


!! *Description*:
!!
!! Compute fast-rotating [thermal] model (FRM) flux in the
!! wavelength domain. (Ref: Michael Mommert's PhD thesis 2013)
!!
!! Input:
!!
!!  T          :: temperature [K]
!!  lambda_min :: lower limit for wavelength [m]
!!  lambda_max :: upper limit for wavelength [m]
!!
!! Output:
!!
!!  B          :: blackbody spectrum [W m^-2 m^-1 sterad^-1]
!!
!! Returns error.
!!


!! *Description*:
!!
!! Compute crude estimate for H by calculating the exact value for
!! each orbit and observation, and averaging over observations. That
!! is, for single point estimates (e.g., from LSL) we calculate nobs
!! H values and assume their average represents the overall H. For a
!! sampled solution each orbit gets an H value which has been
!! averaged over observations.
!!
!! NB: different bands (AKA filters) are not yet properly treated!
!!
!! Returns error.
!!


!! *Description*:
!!
!! Compute estimates for H and G as specified in Bowell et al. 1989.
!!


!! *Description*:
!!
!! Compute estimates for H and G and their uncertainties as
!! specified in Bowell et al. 1989.
!!


!! *Description*:
!!
!! MCMC mass estimation algorithm. See Siltala & Granvik (2020,2017)
!! https://doi.org/10.1051/0004-6361/201935608
!! https://doi.org/10.1016/j.icarus.2017.06.028
!!
!! @author LS, MG
!!


!! *Description*:
!!
!! Asteroid mass estimation 'marching' algorithm.
!!
!! For an earlier, simpler version without least-squares fitting,
!! see Siltala & Granvik (2017)
!! https://doi.org/10.1016/j.icarus.2017.06.028
!!
!! @author LS, MG, ET
!!


!! *Description*:
!!
!! Default initialization routine. Reads the observatory data from
!! the file to which the parameter CODE_FNAME points.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Reads the observatory data from the given file.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Returns the equation of the equinoxes (difference between
!! apparent sidereal time and mean sidereal time) in radians.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Construction of rotation matrix for transformations between
!! different reference systems.
!!
!! INPUT:    frame1    -  starting frame ("ecliptical" or "equatorial")
!!           rsys1     -  starting reference system ("mean" or "true-of-date")
!!           t1        -  starting reference time (mjd, tt)
!!           frame2    -  final frame ("ecliptical" or "equatorial")
!!           rsys2     -  final reference system ("mean" or "true-of-date")
!!           t2        -  final reference time (mjd, tt)
!!
!! OUTPUT:   ROT(3,3)  -  rotation matrix giving the transformation from
!!                        starting to final reference systems:
!!                        x2 = ROT x1
!!
!! Returns error.
!!
!! Based on f77 routine by Mario Carpino (rotpn.f).
!!


!! *Desription*:
!!
!! Initializes a new object using default values.
!!
!! Returns error.
!!


!! *Desription*:
!!
!! Initializes a new object using values given as a calendar
!! date.
!!
!! Returns error.
!!


!! *Desription*:
!!
!! Initializes a new object using values
!! given as a MPC packed date.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Initializes a new object using values given as a modified
!! Julian date.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Deallocates the memory required for storing time-difference tables.
!!


!! *Description*:
!!
!! Returns difference DAT = TAI - UTC as a function of UTC.
!!
!! INPUT:    mjdc    - Modified Julian Day (UTC)
!!
!! OUTPUT:   deltaAT - TAI-UTC given as an integer number
!!           of seconds
!!
!! Acknowledgements: Based on Mario Carpino's f77 routine.
!!
!! Returns error.
!!


!! Description:
!!
!! Returns delta T = ET - UT.
!!
!! INPUT:    tjm       -  Modified Julian Day (UT1)
!!
!! OUTPUT:   deltaT    -  ET - UT1 (in seconds)
!!
!! Acknowledgements: Based on Mario Carpino's f77 routine.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Returns .true., if the absolute difference of the
!! objects is less than epsilon, and .false. otherwise.
!!


!! *Description*:
!!
!! Reallocates a pointer array of Time-objects and
!! copies the data from the old array to the new array (if it fits).
!!
!! *Usage*:
!!
!! mytimes => reallocate(mytimes,4)
!!
!! Returns error.
!!


!! Description:
!!
!! Conversion of a modified Julian date from one timescale
!! to another.
!!
!! INPUT:    mjd1      -  Modified Julian Day
!!           scale1    -  Input time scale
!!           scale2    -  Output (required) time scale
!!
!! OUTPUT:   mjd2      -  Modified Julian Day
!!
!! Supported time scales:
!!        UT1
!!        TAI
!!        UTC
!!        TDT = TT = ET
!!
!! Returns error.
!!
!! Acknowledgements: Based on Mario Carpino's f77 routine.
!!


!! Description:
!!
!! Reduction of time to normal form.
!!
!! INPUT:    mjd       -  Modified Julian Day (integer part)
!!           sec       -  Seconds within day
!!           scale     -  Time scale
!!
!! OUTPUT:   mjd and sec are normalized, namely sec is reduced within
!!           the limits 0 <= sec < lod, and mjd is changed accordingly;
!!           lod (length of the day) is usually 86400 s, but can be
!!           different from that value in the case of UTC, due to
!!           leap seconds.
!!
!! Returns error.
!!
!! Acknowledgements: Based on Mario Carpino's f77 routine.
!!


!! *Description*:
!!
!! Initializes this object with the given values.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Returns the status of this object, i.e. whether it exists or not.
!!


!! *Description*:
!!
!! Reallocates a pointer array of Observation-objects and
!! copies the existing (non-nullified) data from the old array to
!! the new array (if it fits).
!!
!! *Usage*:
!!
!! myobservations => reallocate(myobservations,4)
!!
!! Returns error.
!!


!! *Description*:
!!
!! Reallocates a pointer array of Observation-objects and
!! copies existing data from the old array to
!! the new array (if it fits).
!!
!! *Usage*:
!!
!! myobservations => reallocate(myobservations,4,5)
!!
!! Returns error.
!!


!! *Description*:
!!
!! Adds multinormal deviates to the observation. The mean relative
!! to the original coordinates and the (optional) covariance matrix
!! should be given in radians for the angular space coordinates, AUs
!! for distance, radians per day for angular velocities and AUs per
!! day for line-of-sight velocity. Note that the covariance matrix
!! for the observational uncertainties is not correctly updated if
!! the original observation has a non-zero covariance matrix.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Adds uniform deviates to the observation. The center relative to
!! the original coordinates and the absolute values of the boundary
!! values ((i,1)=center, (i,2)=abs(boundary), position i=1:3 and
!! velocity i=4:6) should be given in radians for the angular space
!! coordinates, AUs for distance, radians per day for angular
!! velocities and AUs per day for line-of-sight velocity. Note that
!! the covariance matrix for the observational uncertainties is not
!! updated.
!!
!! Returns error.
!!


!! *Description*:
!!
!! Returns error.
!!


!! *Description*:
!!
!!
!! Returns error.
!!


!! *Description*:
!!
!!
!! Returns error if allocation fails.
!!


!! *Description*:
!!
!! Automated statistical orbital ranging. By gradually increasing
!! the number of sample orbits (10->200->norb_init), the topocentric
!! range intervals are iterated until they correspond to an unbiased
!! phase space region of possible orbits.
!!
!! Returns error.
!!
!! @author  JV, MG
!! @version 2011-08-22
!!