LCOV - code coverage report
Current view: top level - MPR - mo_mpr_restart.f90 (source / functions) Hit Total Coverage
Test: mHM coverage Lines: 70 142 49.3 %
Date: 2024-04-30 08:53:32 Functions: 4 5 80.0 %

          Line data    Source code
       1             : !> \file mo_mpr_restart.f90
       2             : !> \brief \copybrief mo_mpr_restart
       3             : !> \details \copydetails mo_mpr_restart
       4             : 
       5             : !> \brief reading and writing states, fluxes and configuration for restart of mHM.
       6             : !> \details routines are seperated for reading and writing variables for:
       7             : !!  - states and fluxes, and
       8             : !!  - configuration.
       9             : !!
      10             : !! Reading of L11 configuration is also seperated from the rest, since it is only required when routing is activated.
      11             : !> \authors Stephan Thober
      12             : !> \date Jul 2013
      13             : !> \copyright Copyright 2005-\today, the mHM Developers, Luis Samaniego, Sabine Attinger: All rights reserved.
      14             : !! mHM is released under the LGPLv3+ license \license_note
      15             : !> \ingroup f_mpr
      16             : MODULE mo_mpr_restart
      17             : 
      18             :   ! This module is a restart for the UFZ CHS mesoscale hydrologic model mHM.
      19             : 
      20             :   ! Written  Stephan Thober, Apr 2011
      21             : 
      22             :   IMPLICIT NONE
      23             : 
      24             :   PRIVATE
      25             : 
      26             :   PUBLIC :: write_eff_params            ! read restart files for configuration from a given path
      27             :   PUBLIC :: write_mpr_restart_files     ! write restart files for configuration to a given path
      28             : 
      29             : 
      30             :   !> \brief unpack parameter fields and write them to file
      31             :   !> \param[inout] "type(NcDataset) :: nc"                    NcDataset to add variable to
      32             :   !> \param[in] "character(*) :: var_name"                    variable name
      33             :   !> \param[in] "type(NcDimension), dimension(:) :: var_dims" vector of Variable dimensions
      34             :   !> \param[in] "integer(i4) :: fill_value"                   fill value used for missing values
      35             :   !> \param[in] "integer(i4/dp), dimension(...) :: data"      packed data to be set to variable
      36             :   !> \param[in] "logical, dimension(:, :) :: mask"            mask used for unpacking
      37             :   !> \param[in] "character(*), optional :: var_long_name"     variable long name attribute
      38             :   !> \authors Robert Schweppe
      39             :   !> \date Jun 2018
      40             :   INTERFACE unpack_field_and_write
      41             :     MODULE PROCEDURE unpack_field_and_write_1d_i4, &
      42             :             unpack_field_and_write_1d_dp, &
      43             :             unpack_field_and_write_2d_dp, &
      44             :             unpack_field_and_write_3d_dp
      45             :   end interface unpack_field_and_write
      46             : 
      47             : 
      48             : CONTAINS
      49             : 
      50             :   !> \brief write restart files for each domain
      51             :   !> \details write restart files for each domain. For each domain
      52             :   !! three restart files are written. These are xxx_states.nc,
      53             :   !! xxx_L11_config.nc, and xxx_config.nc (xxx being the three digit
      54             :   !! domain index). If a variable is added here, it should also be added
      55             :   !! in the read restart routines below.
      56             :   !! ADDITIONAL INFORMATION
      57             :   !! write_restart
      58             :   !> \changelog
      59             :   !! - Stephan Thober Aug 2015
      60             :   !!   - moved write of routing states to mRM
      61             :   !! - David Schaefer Nov 2015
      62             :   !!   - mo_netcdf
      63             :   !! - Stephan Thober Nov 2016
      64             :   !!   - moved processMatrix to common variables
      65             :   !! - Zink M. Demirel C. Mar 2017
      66             :   !!   - Added Jarvis soil water stress function at SM process(3)
      67             :   !> \authors Stephan Thober
      68             :   !> \date Jun 2014
      69          82 :   subroutine write_mpr_restart_files(OutFile)
      70             : 
      71             :     use mo_common_restart, only : write_grid_info
      72             :     use mo_common_variables, only : level1, nLCoverScene, domainMeta, LC_year_start, LC_year_end
      73             :     use mo_kind, only : i4, dp
      74             :     use mo_message, only : message
      75             :     use mo_mpr_global_variables, only : nLAI, nSoilHorizons_mHM, HorizonDepth_mHM
      76             :     use mo_netcdf, only : NcDataset, NcDimension
      77             :     use mo_string_utils, only : num2str
      78             :     use mo_common_constants, only : soilHorizonsVarName, landCoverPeriodsVarName, LAIVarName
      79             : 
      80             :     implicit none
      81             : 
      82             :     character(256) :: Fname
      83             : 
      84             :     !> Output Path for each domain
      85             :     character(256), dimension(:), intent(in) :: OutFile
      86             : 
      87             :     integer(i4) :: iDomain, domainID
      88             : 
      89             :     ! start index at level 1
      90             :     integer(i4) :: s1
      91             : 
      92             :     ! end index at level 1
      93             :     integer(i4) :: e1
      94             : 
      95             :     ! mask at level 1
      96           0 :     logical, dimension(:, :), allocatable :: mask1
      97             : 
      98             :     type(NcDataset) :: nc
      99             : 
     100             :     type(NcDimension) :: rows1, cols1, soil1, lcscenes, lais
     101             : 
     102           0 :     real(dp), dimension(:), allocatable :: dummy_1D
     103             : 
     104             : 
     105           0 :     domain_loop : do iDomain = 1, domainMeta%nDomains
     106           0 :       domainID = domainMeta%indices(iDomain)
     107             : 
     108             :       ! write restart file for iDomain
     109           0 :       Fname = trim(OutFile(iDomain))
     110             :       ! print a message
     111           0 :       call message("    Writing Restart-file: ", trim(adjustl(Fname)), " ...")
     112             : 
     113           0 :       nc = NcDataset(fname, "w")
     114             : 
     115           0 :       call write_grid_info(level1(iDomain), "1", nc)
     116             : 
     117           0 :       rows1 = nc%getDimension("nrows1")
     118           0 :       cols1 = nc%getDimension("ncols1")
     119             : 
     120             :       ! write the dimension to the file and also save bounds
     121           0 :       allocate(dummy_1D(nSoilHorizons_mHM+1))
     122           0 :       dummy_1D(1) = 0.0_dp
     123           0 :       dummy_1D(2:nSoilHorizons_mHM+1) = HorizonDepth_mHM(:)
     124           0 :       soil1 = nc%setCoordinate(trim(soilHorizonsVarName), nSoilHorizons_mHM, dummy_1D, 2_i4)
     125           0 :       deallocate(dummy_1D)
     126           0 :       allocate(dummy_1D(nLCoverScene+1))
     127           0 :       dummy_1D(1:nLCoverScene) = LC_year_start(:)
     128             :       ! this is done because bounds are always stored as real so e.g.
     129             :       ! 1981-1990,1991-2000 is thus saved as 1981.0-1991.0,1991.0-2001.0
     130             :       ! it is translated back into ints correctly during reading
     131           0 :       dummy_1D(nLCoverScene+1) = LC_year_end(nLCoverScene) + 1
     132           0 :       lcscenes = nc%setCoordinate(trim(landCoverPeriodsVarName), nLCoverScene, dummy_1D, 0_i4)
     133           0 :       deallocate(dummy_1D)
     134             :       ! write the dimension to the file
     135           0 :       lais = nc%setDimension(trim(LAIVarName), nLAI)
     136             : 
     137             :      ! for appending and intialization
     138           0 :       allocate(mask1(rows1%getLength(), cols1%getLength()))
     139           0 :       s1 = level1(iDomain)%iStart
     140           0 :       e1 = level1(iDomain)%iEnd
     141           0 :       mask1 = level1(iDomain)%mask
     142             : 
     143           0 :       call write_eff_params(mask1, s1, e1, rows1, cols1, soil1, lcscenes, lais, nc)
     144           0 :       deallocate(mask1)
     145           0 :       call nc%close()
     146             : 
     147             :     end do domain_loop
     148             : 
     149           0 :   end subroutine write_mpr_restart_files
     150             : 
     151             : 
     152             :   !> \brief write effective parameter fields to given restart file
     153             :   !> \changelog
     154             :   !!  - Rohini Kumar Oct 2021
     155             :   !!    - Added Neutron count module to mHM integrate into develop branch (5.11.2)
     156             :   !!  - Sebastian Müller Mar 2023
     157             :   !!    - made L1_alpha, L1_kSlowFlow, L1_kBaseFlow and L1_kPerco land cover dependent
     158             :   !> \authors Robert Schweppe
     159             :   !> \date Jun 2018
     160          16 :   subroutine write_eff_params(mask1, s1, e1, rows1, cols1, soil1, lcscenes, lais, nc)
     161             : 
     162           0 :     use mo_common_constants, only : nodata_dp, nodata_i4
     163             :     use mo_common_variables, only : LC_year_end, LC_year_start, processMatrix
     164             :     use mo_kind, only : i4
     165             :     use mo_mpr_global_variables, only : L1_HarSamCoeff, L1_PrieTayAlpha, L1_aeroResist, &
     166             :                                         L1_alpha, L1_degDay, L1_degDayInc, L1_degDayMax, L1_degDayNoPre, L1_fAsp, &
     167             :                                         L1_fRoots, L1_fSealed, L1_jarvis_thresh_c1, L1_kBaseFlow, L1_kPerco, &
     168             :                                         L1_kSlowFlow, L1_karstLoss, L1_kfastFlow, L1_maxInter, L1_petLAIcorFactor, &
     169             :                                         L1_sealedThresh, L1_soilMoistExp, L1_soilMoistFC, L1_soilMoistSat, L1_surfResist, &
     170             :                                         L1_tempThresh, L1_unsatThresh, L1_wiltingPoint, &
     171             :                                         ! neutron count
     172             :                                         L1_No_Count, L1_bulkDens, L1_latticeWater, L1_COSMICL3
     173             : 
     174             :     use mo_netcdf, only : NcDataset, NcDimension, NcVariable
     175             : 
     176             :     implicit none
     177             : 
     178             :     logical, dimension(:, :), allocatable, intent(in) :: mask1 !< mask at level 1
     179             :     integer(i4), intent(in) :: s1 !< start index at level 1
     180             :     integer(i4), intent(in) :: e1 !< end index at level 1
     181             :     type(NcDimension), intent(in) :: rows1 !< y dimension
     182             :     type(NcDimension), intent(in) :: cols1 !< x dimension
     183             :     type(NcDimension), intent(in) :: soil1 !< soil dimension
     184             :     type(NcDimension), intent(in) :: lcscenes !< land conver scenes dimension
     185             :     type(NcDimension), intent(in) :: lais !< LAI dimension
     186             :     type(NcDataset), intent(inout) :: nc !< NetCDF file to write to
     187             : 
     188             :     type(NcVariable) :: var
     189             : 
     190             :     !-------------------------------------------
     191             :     ! EFFECTIVE PARAMETERS
     192             :     !-------------------------------------------
     193             :     call unpack_field_and_write(nc, "L1_fSealed", &
     194           0 :             (/rows1, cols1, lcscenes/), nodata_dp, L1_fSealed(s1 : e1, 1, :), mask1, &
     195          64 :             "fraction of Sealed area at level 1")
     196             : 
     197             :     call unpack_field_and_write(nc, "L1_alpha", &
     198           0 :             (/rows1, cols1, lcscenes/), nodata_dp, L1_alpha(s1 : e1, 1, :), mask1, &
     199          64 :             "exponent for the upper reservoir at level 1")
     200             : 
     201             :     call unpack_field_and_write(nc, "L1_degDayInc", &
     202           0 :             (/rows1, cols1, lcscenes/), nodata_dp, L1_degDayInc(s1 : e1, 1, :), mask1, &
     203          64 :             "increase of the Degree-day factor per mm of increase in precipitation at level 1")
     204             : 
     205             :     call unpack_field_and_write(nc, "L1_degDayMax", &
     206           0 :             (/rows1, cols1, lcscenes/), nodata_dp, L1_degDayMax(s1 : e1, 1, :), mask1, &
     207          64 :             "maximum degree-day factor at level 1")
     208             : 
     209             :     call unpack_field_and_write(nc, "L1_degDayNoPre", &
     210           0 :             (/rows1, cols1, lcscenes/), nodata_dp, L1_degDayNoPre(s1 : e1, 1, :), mask1, &
     211          64 :             "degree-day factor with no precipitation at level 1")
     212             : 
     213             :     call unpack_field_and_write(nc, "L1_degDay", &
     214           0 :             (/rows1, cols1, lcscenes/), nodata_dp, L1_degDay(s1 : e1, 1, :), mask1, &
     215          64 :             "degree-day factor with no precipitation at level 1")
     216             : 
     217             :     call unpack_field_and_write(nc, "L1_karstLoss", &
     218           0 :             (/rows1, cols1/), nodata_dp, L1_karstLoss(s1 : e1, 1, 1), mask1, &
     219          48 :             "Karstic percolation loss at level 1")
     220             : 
     221             :     call unpack_field_and_write(nc, "L1_fRoots", &
     222           0 :             (/rows1, cols1, soil1, lcscenes/), nodata_dp, L1_fRoots(s1 : e1, :, :), mask1, &
     223          80 :             "Fraction of roots in soil horizons at level 1")
     224             : 
     225             :     call unpack_field_and_write(nc, "L1_maxInter", &
     226           0 :             (/rows1, cols1, lais/), nodata_dp, L1_maxInter(s1 : e1, :, 1), mask1, &
     227          64 :             "Maximum interception at level 1")
     228             : 
     229             :     call unpack_field_and_write(nc, "L1_kfastFlow", &
     230           0 :             (/rows1, cols1, lcscenes/), nodata_dp, L1_kfastFlow(s1 : e1, 1, :), mask1, &
     231          64 :             "fast interflow recession coefficient at level 1")
     232             : 
     233             :     call unpack_field_and_write(nc, "L1_kSlowFlow", &
     234           0 :             (/rows1, cols1, lcscenes/), nodata_dp, L1_kSlowFlow(s1 : e1, 1, :), mask1, &
     235          64 :             "slow interflow recession coefficient at level 1")
     236             : 
     237             :     call unpack_field_and_write(nc, "L1_kBaseFlow", &
     238           0 :             (/rows1, cols1, lcscenes/), nodata_dp, L1_kBaseFlow(s1 : e1, 1, :), mask1, &
     239          64 :             "baseflow recession coefficient at level 1")
     240             : 
     241             :     call unpack_field_and_write(nc, "L1_kPerco", &
     242           0 :             (/rows1, cols1, lcscenes/), nodata_dp, L1_kPerco(s1 : e1, 1, :), mask1, &
     243          64 :             "percolation coefficient at level 1")
     244             : 
     245             :     call unpack_field_and_write(nc, "L1_soilMoistFC", &
     246           0 :             (/rows1, cols1, soil1, lcscenes/), nodata_dp, L1_soilMoistFC(s1 : e1, :, :), mask1, &
     247          80 :             "SM below which actual ET is reduced linearly till PWP at level 1 for processCase(3)=1")
     248             : 
     249             :     call unpack_field_and_write(nc, "L1_soilMoistSat", &
     250           0 :             (/rows1, cols1, soil1, lcscenes/), nodata_dp, L1_soilMoistSat(s1 : e1, :, :), mask1, &
     251          80 :             "Saturation soil moisture for each horizon [mm] at level 1")
     252             : 
     253             :     call unpack_field_and_write(nc, "L1_soilMoistExp", &
     254           0 :             (/rows1, cols1, soil1, lcscenes/), nodata_dp, L1_soilMoistExp(s1 : e1, :, :), mask1, &
     255          80 :             "Exponential parameter to how non-linear is the soil water retention at level 1")
     256             : 
     257          45 :     if (any(processMatrix(3, 1) == (/2, 3/))) then
     258             :       call unpack_field_and_write(nc, "L1_jarvis_thresh_c1", &
     259           0 :               (/rows1, cols1/), nodata_dp, L1_jarvis_thresh_c1(s1 : e1, 1, 1), mask1, &
     260           6 :               "jarvis critical value for normalized soil water content")
     261             :     end if
     262             : 
     263          16 :     if (processMatrix(5, 1) == -1) then
     264             :       call unpack_field_and_write(nc, "L1_petLAIcorFactor", &
     265           0 :               (/rows1, cols1, lais, lcscenes/), nodata_dp, L1_petLAIcorFactor(s1 : e1, :, :), mask1, &
     266          10 :               "PET correction factor based on LAI")
     267             :     end if
     268             : 
     269             :     call unpack_field_and_write(nc, "L1_tempThresh", &
     270           0 :             (/rows1, cols1, lcscenes/), nodata_dp, L1_tempThresh(s1 : e1, 1, :), mask1, &
     271          64 :             "Threshold temperature for snow/rain at level 1")
     272             : 
     273             :     call unpack_field_and_write(nc, "L1_unsatThresh", &
     274           0 :             (/rows1, cols1/), nodata_dp, L1_unsatThresh(s1 : e1, 1, 1), mask1, &
     275          48 :             "Threshold water depth controlling fast interflow at level 1")
     276             : 
     277             :     call unpack_field_and_write(nc, "L1_sealedThresh", &
     278           0 :             (/rows1, cols1/), nodata_dp, L1_sealedThresh(s1 : e1, 1, 1), mask1, &
     279          48 :             "Threshold water depth for surface runoff in sealed surfaces at level 1")
     280             : 
     281             :     call unpack_field_and_write(nc, "L1_wiltingPoint", &
     282           0 :             (/rows1, cols1, soil1, lcscenes/), nodata_dp, L1_wiltingPoint(s1 : e1, :, :), mask1, &
     283          80 :             "Permanent wilting point at level 1")
     284             : 
     285          29 :     select case (processMatrix(5, 1))
     286             :     case(-1 : 0) ! PET is input
     287             :       call unpack_field_and_write(nc, "L1_fAsp", &
     288           0 :               (/rows1, cols1/), nodata_dp, L1_fAsp(s1 : e1, 1, 1), mask1, &
     289          39 :               "PET correction factor due to terrain aspect at level 1")
     290             : 
     291             :     case(1) ! Hargreaves-Samani
     292             :       call unpack_field_and_write(nc, "L1_fAsp", &
     293           0 :               (/rows1, cols1/), nodata_dp, L1_fAsp(s1 : e1, 1, 1), mask1, &
     294           6 :               "PET correction factor due to terrain aspect at level 1")
     295             : 
     296             :       call unpack_field_and_write(nc, "L1_HarSamCoeff", &
     297           0 :               (/rows1, cols1/), nodata_dp, L1_HarSamCoeff(s1 : e1, 1, 1), mask1, &
     298           6 :               "Hargreaves-Samani coefficient")
     299             : 
     300             :     case(2) ! Priestley-Taylor
     301             :       call unpack_field_and_write(nc, "L1_PrieTayAlpha", &
     302           0 :               (/rows1, cols1, lais/), nodata_dp, L1_PrieTayAlpha(s1 : e1, :, 1), mask1, &
     303           4 :               "Priestley Taylor coeffiecient (alpha)")
     304             : 
     305             :     case(3) ! Penman-Monteith
     306             :       call unpack_field_and_write(nc, "L1_aeroResist", &
     307           0 :               (/rows1, cols1, lais, lcscenes/), nodata_dp, L1_aeroResist(s1 : e1, :, :), mask1, &
     308           0 :               "aerodynamical resitance")
     309             : 
     310             :       call unpack_field_and_write(nc, "L1_surfResist", &
     311           0 :               (/rows1, cols1, lais/), nodata_dp, L1_surfResist(s1 : e1, :, 1), mask1, &
     312          16 :               "bulk surface resitance")
     313             : 
     314             :    end select
     315             : 
     316             :    ! neutron count
     317          16 :    select case (processMatrix(10, 1))
     318             :    case(1) ! deslet
     319             :       call unpack_field_and_write(nc, "L1_No_Count", &
     320           0 :            (/rows1, cols1/), nodata_dp, L1_No_Count(s1:e1, 1, 1), mask1, &
     321           0 :            "N0 count at level 1")
     322             :       call unpack_field_and_write(nc, "L1_bulkDens", &
     323           0 :            (/rows1, cols1, soil1, lcscenes/), nodata_dp, L1_bulkDens(s1:e1, :, :), mask1, &
     324           0 :            "Bulk density at level 1 for processCase(10)")
     325             :       call unpack_field_and_write(nc, "L1_latticeWater", &
     326           0 :            (/rows1, cols1, soil1, lcscenes/), nodata_dp, L1_latticeWater(s1:e1, :, :), mask1, &
     327           0 :            "Lattice water content at level 1 for processCase(10)")
     328             : 
     329             :    case(2) ! COSMIC
     330             :       call unpack_field_and_write(nc, "L1_No_Count", &
     331           0 :            (/rows1, cols1/), nodata_dp, L1_No_Count(s1 : e1, 1, 1), mask1, &
     332           0 :            "N0 count at level 1")
     333             :       call unpack_field_and_write(nc, "L1_bulkDens", &
     334           0 :            (/rows1, cols1, soil1, lcscenes/), nodata_dp, L1_bulkDens(s1 : e1, :, :), mask1, &
     335           0 :            "Bulk density at level 1 for processCase(10)")
     336             :       call unpack_field_and_write(nc, "L1_latticeWater", &
     337           0 :            (/rows1, cols1, soil1, lcscenes/), nodata_dp, L1_latticeWater(s1 : e1, :, :), mask1, &
     338           0 :            "Lattice water content at level 1 for processCase(10)")
     339             :       call unpack_field_and_write(nc, "L1_COSMICL3", &
     340           0 :            (/rows1, cols1, soil1, lcscenes/), nodata_dp, L1_COSMICL3(s1 : e1, :, :), mask1, &
     341          16 :            "COSMIC L3 parameter at level 1 for processCase(10)")
     342             :    end select
     343             : 
     344          16 :   end subroutine write_eff_params
     345             : 
     346             :   !> \copydoc unpack_field_and_write
     347             :   subroutine unpack_field_and_write_1d_i4(nc, var_name, var_dims, fill_value, data, mask, var_long_name)
     348             : 
     349          16 :     use mo_kind, only : i4
     350             :     use mo_netcdf, only : NcDataset, NcDimension, NcVariable
     351             : 
     352             :     implicit none
     353             : 
     354             :     ! NcDataset to add variable to
     355             :     type(NcDataset), intent(inout) :: nc
     356             : 
     357             :     ! variable name
     358             :     character(*), intent(in) :: var_name
     359             : 
     360             :     ! vector of Variable dimensions
     361             :     type(NcDimension), dimension(:), intent(in) :: var_dims
     362             : 
     363             :     ! fill value used for missing values
     364             :     integer(i4), intent(in) :: fill_value
     365             : 
     366             :     ! packed data to be set to variable
     367             :     integer(i4), dimension(:), intent(in) :: data
     368             : 
     369             :     ! mask used for unpacking
     370             :     logical, dimension(:, :), intent(in) :: mask
     371             : 
     372             :     ! variable long name attribute
     373             :     character(*), optional, intent(in) :: var_long_name
     374             : 
     375             :     type(NcVariable) :: var
     376             : 
     377             : 
     378             :     ! set variable
     379             :     var = nc%setVariable(var_name, "i32", var_dims)
     380             :     call var%setFillValue(fill_value)
     381             : 
     382             :     ! set the unpacked data
     383             :     call var%setData(unpack(data, mask, fill_value))
     384             : 
     385             :     ! optionally set attributes
     386             :     if (present(var_long_name)) then
     387             :       call var%setAttribute("long_name", trim(var_long_name))
     388             :     end if
     389             : 
     390             :   end subroutine
     391             : 
     392             :   !> \copydoc unpack_field_and_write
     393         134 :   subroutine unpack_field_and_write_1d_dp(nc, var_name, var_dims, fill_value, data, mask, var_long_name)
     394             : 
     395             :     use mo_kind, only : dp
     396             :     use mo_netcdf, only : NcDataset, NcDimension, NcVariable
     397             : 
     398             :     implicit none
     399             : 
     400             :     ! NcDataset to add variable to
     401             :     type(NcDataset), intent(inout) :: nc
     402             : 
     403             :     ! variable name
     404             :     character(*), intent(in) :: var_name
     405             : 
     406             :     ! vector of Variable dimensions
     407             :     type(NcDimension), dimension(:), intent(in) :: var_dims
     408             : 
     409             :     ! fill value used for missing values
     410             :     real(dp), intent(in) :: fill_value
     411             : 
     412             :     ! packed data to be set to variable
     413             :     real(dp), dimension(:), intent(in) :: data
     414             : 
     415             :     ! mask used for unpacking
     416             :     logical, dimension(:, :), intent(in) :: mask
     417             : 
     418             :     ! variable long name attribute
     419             :     character(*), optional, intent(in) :: var_long_name
     420             : 
     421             :     type(NcVariable) :: var
     422             : 
     423             : 
     424             :     ! set variable
     425          67 :     var = nc%setVariable(var_name, "f64", var_dims)
     426          67 :     call var%setFillValue(fill_value)
     427             : 
     428             :     ! set the unpacked data
     429          67 :     call var%setData(unpack(data, mask, fill_value))
     430             : 
     431             :     ! optionally set attributes
     432          67 :     if (present(var_long_name)) then
     433          67 :       call var%setAttribute("long_name", trim(var_long_name))
     434             :     end if
     435             : 
     436          67 :   end subroutine
     437             : 
     438             :   !> \copydoc unpack_field_and_write
     439         386 :   subroutine unpack_field_and_write_2d_dp(nc, var_name, var_dims, fill_value, data, mask, var_long_name)
     440             : 
     441          67 :     use mo_kind, only : dp, i4
     442             :     use mo_netcdf, only : NcDataset, NcDimension, NcVariable
     443             : 
     444             :     implicit none
     445             : 
     446             :     ! NcDataset to add variable to
     447             :     type(NcDataset), intent(inout) :: nc
     448             : 
     449             :     ! variable name
     450             :     character(*), intent(in) :: var_name
     451             : 
     452             :     ! vector of Variable dimensions
     453             :     type(NcDimension), dimension(:), intent(in) :: var_dims
     454             : 
     455             :     ! fill value used for missing values
     456             :     real(dp), intent(in) :: fill_value
     457             : 
     458             :     ! packed data to be set to variable
     459             :     real(dp), dimension(:, :), intent(in) :: data
     460             : 
     461             :     ! mask used for unpacking
     462             :     logical, dimension(:, :), intent(in) :: mask
     463             : 
     464             :     ! variable long name attribute
     465             :     character(*), optional, intent(in) :: var_long_name
     466             : 
     467             :     type(NcVariable) :: var
     468             : 
     469         193 :     real(dp), dimension(:, :, :), allocatable :: dummy_arr
     470             : 
     471             :     integer(i4), dimension(3) :: dim_length
     472             : 
     473             :     integer(i4) :: ii
     474             : 
     475             : 
     476             :     ! set variable
     477         193 :     var = nc%setVariable(var_name, "f64", var_dims)
     478         193 :     call var%setFillValue(fill_value)
     479             : 
     480         772 :     dim_length = var%getShape()
     481         965 :     allocate(dummy_arr(dim_length(1), dim_length(2), dim_length(3)))
     482         767 :     do ii = 1, size(data, 2)
     483         767 :       dummy_arr(:, :, ii) = unpack(data(:, ii), mask, fill_value)
     484             :     end do
     485             : 
     486             :     ! set the unpacked data
     487         193 :     call var%setData(dummy_arr)
     488             : 
     489             :     ! optionally set attributes
     490         193 :     if (present(var_long_name)) then
     491         193 :       call var%setAttribute("long_name", trim(var_long_name))
     492             :     end if
     493             : 
     494         193 :   end subroutine
     495             : 
     496             :   !> \copydoc unpack_field_and_write
     497         164 :   subroutine unpack_field_and_write_3d_dp(nc, var_name, var_dims, fill_value, data, mask, var_long_name)
     498             : 
     499         193 :     use mo_kind, only : dp, i4
     500             :     use mo_netcdf, only : NcDataset, NcDimension, NcVariable
     501             : 
     502             :     implicit none
     503             : 
     504             :     ! NcDataset to add variable to
     505             :     type(NcDataset), intent(inout) :: nc
     506             : 
     507             :     ! variable name
     508             :     character(*), intent(in) :: var_name
     509             : 
     510             :     ! vector of Variable dimensions
     511             :     type(NcDimension), dimension(:), intent(in) :: var_dims
     512             : 
     513             :     ! fill value used for missing values
     514             :     real(dp), intent(in) :: fill_value
     515             : 
     516             :     ! packed data to be set to variable
     517             :     real(dp), dimension(:, :, :), intent(in) :: data
     518             : 
     519             :     ! mask used for unpacking
     520             :     logical, dimension(:, :), intent(in) :: mask
     521             : 
     522             :     ! variable long name attribute
     523             :     character(*), optional, intent(in) :: var_long_name
     524             : 
     525             :     type(NcVariable) :: var
     526             : 
     527          82 :     real(dp), dimension(:, :, :, :), allocatable :: dummy_arr
     528             : 
     529             :     integer(i4), dimension(4) :: dim_length
     530             : 
     531             :     integer(i4) :: ii, jj
     532             : 
     533             : 
     534             :     ! set variable
     535          82 :     var = nc%setVariable(var_name, "f64", var_dims)
     536          82 :     call var%setFillValue(fill_value)
     537             : 
     538         410 :     dim_length = var%getShape()
     539         492 :     allocate(dummy_arr(dim_length(1), dim_length(2), dim_length(3), dim_length(4)))
     540         266 :     do ii = 1, size(data, 2)
     541         634 :       do jj = 1, size(data, 3)
     542         552 :         dummy_arr(:, :, ii, jj) = unpack(data(:, ii, jj), mask, fill_value)
     543             :       end do
     544             :     end do
     545             : 
     546             :     ! set the unpacked data
     547          82 :     call var%setData(dummy_arr)
     548             : 
     549             :     ! optionally set attributes
     550          82 :     if (present(var_long_name)) then
     551          82 :       call var%setAttribute("long_name", trim(var_long_name))
     552             :     end if
     553             : 
     554          82 :   end subroutine
     555             : 
     556             : END MODULE mo_mpr_restart

Generated by: LCOV version 1.16