LCOV - code coverage report
Current view: top level - MPR - mo_mpr_neutrons.f90 (source / functions) Hit Total Coverage
Test: mHM coverage Lines: 33 54 61.1 %
Date: 2024-04-30 08:53:32 Functions: 2 3 66.7 %

          Line data    Source code
       1             : !> \file mo_mpr_neutrons.f90
       2             : !> \brief \copybrief mo_mpr_neutrons
       3             : !> \details \copydetails mo_mpr_neutrons
       4             : 
       5             : !> \brief   Multiscale parameter regionalization (MPR) for neutrons
       6             : !> \details This module contains all routines required for parametrizing neutrons processes.
       7             : !> \author Maren Kaluza
       8             : !> \date Dec 2017
       9             : !> \copyright Copyright 2005-\today, the mHM Developers, Luis Samaniego, Sabine Attinger: All rights reserved.
      10             : !! mHM is released under the LGPLv3+ license \license_note
      11             : !> \ingroup f_mpr
      12             : module mo_mpr_neutrons
      13             : 
      14             :   use mo_kind, only: i4, dp
      15             : 
      16             :   implicit none
      17             : 
      18             :   public :: mpr_neutrons
      19             : 
      20             :   private
      21             : 
      22             : contains
      23             :   ! ----------------------------------------------------------------------------
      24             : 
      25             :   !      NAME
      26             :   !         mpr_neutrons
      27             : 
      28             :   !>        \brief multiscale parameter regionalization for neutrons
      29             : 
      30             :   !>        \details calculates neutron variables on L0
      31             :   !>                 Global parameters needed (see mhm_parameter.nml):\n
      32             :   !>                    - param( 1) = Desilets_N0   \n
      33             :   !>                    - param( 2) = COSMIC_N0     \n
      34             :   !>                    - param( 3) = COSMIC_N1     \n
      35             :   !>                    - param( 4) = COSMIC_N2     \n
      36             :   !>                    - param( 5) = COSMIC_alpha0 \n
      37             :   !>                    - param( 6) = COSMIC_alpha1 \n
      38             :   !>                    - param( 7) = COSMIC_L30    \n
      39             :   !>                    - param( 8) = COSMIC_L31    \n
      40             :   !>                    - param( 9) = COSMIC_LW0    \n
      41             :   !>                    - param(10) = COSMIC_LW1    \n
      42             : 
      43             :   !      INTENT(IN)
      44             :   !>        \param[in] "real(dp)    :: param(10)"        - global parameters
      45             :   !>        \param[in] "integer(i4) :: is_present(:)"    - indicates whether soiltype is present
      46             :   !>        \param[in] "integer(i4) :: nHorizons(:)"     - Number of Horizons per soiltype2
      47             :   !>        \param[in] "integer(i4) :: nTillHorizons(:)" - Number of Tillage Horizons
      48             :   !>        \param[in] "integer(i4) :: LCover0(:)"       - land cover ids at level 0
      49             :   !>        \param[in] "real(dp)    :: clay(:,:)"        - clay content
      50             :   !>        \param[in] "real(dp)    :: DbM(:,:)"         - mineral Bulk density
      51             :   !>        \param[in] "real(dp)    :: Db(:,:)"          - Bulk density
      52             : 
      53             :   !     INTENT(INOUT)
      54             :   !         None
      55             : 
      56             :   !>      INTENT(OUT)
      57             :   !>        \param[out] "real(dp)   :: COSMIC_L3_till(:,:,:)" - COSMIC paramter L3 tillage layer
      58             :   !>        \param[out] "real(dp)   :: latWat_till(:,:,:)"    - lattice water content tillage layer
      59             :   !>        \param[out] "real(dp)   :: COSMIC_L3(:,:)"        - COSMIC paramter L3 tillage layer
      60             :   !>        \param[out] "real(dp)   :: latWat(:,:)"           - lattice water contente
      61             : 
      62             :   !     INTENT(IN), OPTIONAL
      63             :   !         None
      64             : 
      65             :   !     INTENT(INOUT), OPTIONAL
      66             :   !         None
      67             : 
      68             :   !     INTENT(OUT), OPTIONAL
      69             :   !         None
      70             : 
      71             :   !     RETURN
      72             :   !         None
      73             : 
      74             :   !     RESTRICTIONS
      75             :   !         None
      76             : 
      77             :   !     EXAMPLE
      78             :   !         None
      79             : 
      80             :   !     LITERATURE
      81             :   !         None
      82             : 
      83             :   !     HISTORY
      84             :   !>        \author Maren Kaluza
      85             :   !>        \date Dec 2017
      86             : 
      87             : 
      88          12 :   subroutine mpr_neutrons( process_case, & ! IN: process case
      89          24 :        param               , & ! IN:  global parameter set
      90          24 :        is_present          , & ! IN:  flag indicating presence of soil
      91          12 :        nHorizons           , & ! IN:  Number of Horizons of Soiltype
      92          24 :        nTillHorizons       , & ! IN:  Number of tillage Horizons
      93          12 :        LCover0             , & ! IN:  land cover ids at level 0
      94          12 :        clay                , & ! IN:  clay content
      95          12 :        DbM                 , & ! IN:  mineral Bulk density
      96          12 :        Db                  , & ! IN: Bulk density
      97          12 :        COSMIC_L3_till      , & ! OUT: COSMIC paramter L3 tillage layer
      98          24 :        latWat_till         , & ! OUT: lattice water content tillage layer
      99          12 :        COSMIC_L3           , & ! OUT: COSMIC paramter L3 tillage layer
     100          12 :        latWat                & ! OUT: lattice water contente
     101             :        )
     102             : 
     103             :     ! lots of lines copy-pasted from mo_mpr_soilmoist.f90
     104             :     use mo_message, only: error_message
     105             :     use mo_mpr_global_variables, only: iFlag_soilDB
     106             :     !$  use omp_lib
     107             : 
     108             :     implicit none
     109             : 
     110             :     ! Input --------------------------------------------------------------------
     111             :     integer(i4),                   intent(in)  :: process_case ! process case
     112             :     real(dp),    dimension(:),     intent(in)  :: param        ! global parameters   !! dim = 3 for case 1 and 9 for case 2
     113             :     integer(i4), dimension(:),     intent(in)  :: is_present   ! indicates whether soiltype is present
     114             :     integer(i4), dimension(:),     intent(in)  :: nHorizons    ! Number of Horizons per soiltype
     115             :     integer(i4), dimension(:),     intent(in)  :: nTillHorizons! Number of Tillage Horizons
     116             :     real(dp),    dimension(:,:),   intent(in)  :: DbM          ! mineral Bulk density
     117             :     real(dp),    dimension(:,:,:), intent(in)  :: Db           ! Bulk density
     118             :     integer(i4), dimension(:),     intent(in)  :: LCOVER0      ! land cover ids at level 0
     119             :     real(dp),    dimension(:,:),   intent(in)  :: clay         ! clay content
     120             : 
     121             :     ! Output -------------------------------------------------------------------
     122             :     real(dp),    dimension(:,:,:), intent(out) :: COSMIC_L3_till ! COSMIC parameter L3 tillage layer
     123             :     real(dp),    dimension(:,:,:), intent(out) :: latWat_till    ! lattice water content tillage layer
     124             :     real(dp),    dimension(:,:),   intent(out) :: COSMIC_L3      ! COSMIC parameter L3
     125             :     real(dp),    dimension(:,:),   intent(out) :: latWat         ! lattice water content
     126             : 
     127             :     ! Local variables
     128             :     integer(i4)                               :: i               ! loop index
     129             :     integer(i4)                               :: j               ! loop index
     130             :     integer(i4)                               :: l               ! loop index
     131             :     integer(i4)                               :: tmp_minSoilHorizon
     132             : 
     133             : 
     134             :     !min soil horizon
     135       17712 :     tmp_minSoilHorizon = minval(nTillHorizons(:))
     136             : 
     137             :     ! with zero there will be problem with
     138             :     ! upscaling with harmonic mean for the COMSIC_L3
     139             :     ! in case of process_case .EQ. 1
     140       53184 :     COSMIC_L3_till = 0.000001_dp
     141       53148 :     COSMIC_L3      = 0.000001_dp
     142       53184 :     latWat_till    = 0.000001_dp
     143       53148 :     latWat         = 0.000001_dp
     144             : 
     145             :     ! select case according to a given soil database flag
     146          12 :     SELECT CASE(iFlag_soilDB)
     147             : 
     148             :        ! classical mHM soil database format
     149             :        CASE(0)
     150       17724 :           do i = 1, size(is_present)
     151       17700 :              if ( is_present(i) .lt. 1 ) cycle
     152        1596 :              horizon: do j = 1, nHorizons(i)
     153             :                 ! calculating other soil hydraulic properties
     154             :                 ! tillage horizons
     155       18888 :                 if ( j .le. nTillHorizons(i) ) then
     156             :                    ! LC class
     157    18433800 :                    do L = 1, maxval( LCOVER0 )
     158        1188 :                       if(process_case .EQ. 1) call latticeWater(param(2:3), clay(i,j), latWat_till(i,j,L))
     159        1584 :                       if(process_case .EQ. 2) then
     160           0 :                          call calcL3(param(6:7), Db(i,j,L), COSMIC_L3_till(i,j,L))
     161           0 :                          call latticeWater(param(8:9), clay(i,j), latWat_till(i,j,L))
     162             :                       end if
     163             :                    end do
     164             :                 ! deeper layers
     165             :                 else
     166         792 :                    if(process_case .EQ. 1) call latticeWater(param(2:3), clay(i,j), latWat(i,j-tmp_minSoilHorizon))
     167         792 :                    if(process_case .EQ. 2) then
     168           0 :                       call calcL3(param(6:7), DbM(i,j), COSMIC_L3(i,j-tmp_minSoilHorizon))
     169           0 :                       call latticeWater(param(8:9), clay(i,j), latWat(i,j-tmp_minSoilHorizon))
     170             :                    end if
     171             :                 end if
     172             :              end do horizon
     173             :           end do
     174             : 
     175             :        ! to handle multiple soil horizons with unique soil class
     176             :        CASE(1)
     177           0 :            do i = 1, size(is_present)
     178           0 :              if ( is_present(i) .lt. 1 ) cycle
     179             :              ! **** FOR THE TILLAGE TYPE OF SOIL *****
     180             :              ! there is actually no soil horizons/soil type in this case
     181             :              ! but we assign of j = 1 to use variables as defined in the classical option (iFlag_soil = 0)
     182           0 :              do j = 1, 1
     183             :                 ! tillage horizons properties depending on the LC class
     184           0 :                 do L = 1, maxval( LCOVER0 )
     185           0 :                    if(process_case .EQ. 1) call latticeWater(param(2:3), clay(i,j), latWat_till(i,j,L))
     186           0 :                    if(process_case .EQ. 2) then
     187           0 :                       call calcL3(param(6:7), Db(i,j,L), COSMIC_L3_till(i,j,L))
     188           0 :                       call latticeWater(param(8:9), clay(i,j), latWat_till(i,j,L))
     189             :                    end if
     190             :                 end do
     191             : 
     192             :                 ! *** FOR NON-TILLAGE TYPE OF SOILS ***
     193             :                 ! note j = 1
     194           0 :                 if(process_case .EQ. 1) call latticeWater(param(2:3), clay(i,j), latWat(i,j))
     195           0 :                 if(process_case .EQ. 2) then
     196           0 :                    call calcL3(param(6:7), DbM(i,j), COSMIC_L3(i,j))
     197           0 :                    call latticeWater(param(8:9), clay(i,j), latWat(i,j))
     198             :                 end if
     199             : 
     200             :              end do  ! >> HORIZON
     201             :           end do   ! >> SOIL TYPE
     202             : 
     203             :        CASE DEFAULT
     204          12 :           call error_message('***ERROR: iFlag_soilDB option given does not exist. Only 0 and 1 is taken at the moment.')
     205             :        END SELECT
     206             :        !
     207             : 
     208          12 :    end subroutine
     209             : 
     210             : 
     211             :   !! >> L3 parameter
     212           0 :   subroutine calcL3(param, bulkDensity, L3)
     213             :     ! param(1) = COSMIC_L30
     214             :     ! param(2) = COSMIC_L31
     215             :     implicit none
     216             :     real(dp), dimension(2),  intent(in)       :: param
     217             :     real(dp),                intent(in)       :: bulkDensity
     218             :     real(dp),                intent(inout)    :: L3
     219             : 
     220           0 :     L3 = bulkDensity*param(1) - param(2)
     221           0 :     if( bulkDensity .LT. 0.4_dp ) then ! bulkDensity<0.39 yields negative L3, bulkDensity=0.39 yields L3=0
     222           0 :        L3 = 1.0_dp                     ! Prevent division by zero later on; added by joost Iwema to COSMIC 1.13, Feb. 2017
     223             :     endif
     224             : 
     225          12 :   end subroutine calcL3
     226             : 
     227             : 
     228             :   !! >>>> lattice water
     229        1980 :   subroutine latticeWater( param, clay, latWat )
     230             :     ! param(1) = COSMIC_LW0 or deslet_LW0
     231             :     ! param(2) = COSMIC_LW1 or deslet_LW0
     232             :     implicit none
     233             :     ! Input
     234             :     real(dp), dimension(2), intent(in)  :: param
     235             :     real(dp),               intent(in)  :: clay
     236             :     ! Output
     237             :     real(dp),               intent(out) :: latWat
     238             : 
     239             :     !Martin Schroen's dissertation
     240        1980 :     latWat = ( param(1)*clay/100.0_dp + param(2) )
     241             : 
     242           0 :   end subroutine latticeWater
     243             : 
     244             : end module mo_mpr_neutrons

Generated by: LCOV version 1.16