diff --git a/CMakeLists.txt b/CMakeLists.txt index cea35a725..9618bd2ea 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -7,14 +7,43 @@ project( ) option(CABLE_MPI "Build the MPI executable" OFF) +option(CABLE_TESTS "Build CABLE tests" OFF) # third party libs if(CABLE_MPI) find_package(MPI REQUIRED COMPONENTS Fortran) + find_package(PIO COMPONENTS Fortran QUIET) + if(TARGET PIO::PIO_Fortran) + message(STATUS "Found PIO_Fortran: ${PIO_DIR}") + endif() endif() find_package(PkgConfig REQUIRED) pkg_check_modules(NETCDF REQUIRED IMPORTED_TARGET "netcdf-fortran") +if(CABLE_TESTS) + enable_testing() + include(FetchContent) + if(CABLE_MPI) + option(FORTUNO_WITH_MPI "Fortuno: whether to build the MPI interface" ON) + FetchContent_Declare( + FortunoMPI + GIT_REPOSITORY https://github.com/fortuno-repos/fortuno + GIT_TAG main + ) + FetchContent_MakeAvailable(FortunoMPI) + set(fortuno_libs Fortuno::fortuno_mpi) + else() + option(FORTUNO_WITH_MPI "Fortuno: whether to build the MPI interface" OFF) + FetchContent_Declare(Fortuno + GIT_REPOSITORY https://github.com/fortuno-repos/fortuno + GIT_TAG main + FIND_PACKAGE_ARGS CONFIG + ) + FetchContent_MakeAvailable(Fortuno) + set(fortuno_libs Fortuno::fortuno_serial) + endif () +endif() + set(CABLE_Intel_Fortran_FLAGS -fp-model precise) set(CABLE_Intel_Fortran_FLAGS_DEBUG -O0 -g -traceback -fpe0) set(CABLE_Intel_Fortran_FLAGS_RELEASE -O2) @@ -239,6 +268,7 @@ else() src/util/cable_common.F90 src/shared/casa_offline_inout.F90 src/shared/casa_ncdf.F90 + src/offline/cable_io_decomp.F90 src/offline/cable_iovars.F90 src/offline/cable_surface_types.F90 src/offline/cable_define_types.F90 @@ -271,13 +301,26 @@ else() src/offline/spincasacnp.F90 src/util/cable_climate_type_mod.F90 src/util/masks_cbl.F90 + src/util/cable_array_utils.F90 + src/util/netcdf/cable_netcdf_decomp_util.F90 + src/util/netcdf/cable_netcdf.F90 + src/util/netcdf/cable_netcdf_internal.F90 + src/util/netcdf/cable_netcdf_stub_types.F90 + src/util/netcdf/nf90/cable_netcdf_nf90.F90 ) target_link_libraries(cable_common PRIVATE PkgConfig::NETCDF) if(CABLE_MPI) - target_compile_definitions(cable_common PRIVATE __MPI__) - target_link_libraries(cable_common PRIVATE MPI::MPI_Fortran) + target_compile_definitions(cable_common PRIVATE __MPI__) + target_link_libraries(cable_common PRIVATE MPI::MPI_Fortran) + endif() + + if(TARGET PIO::PIO_Fortran) + target_link_libraries(cable_common PRIVATE PIO::PIO_Fortran) + target_sources(cable_common PRIVATE src/util/netcdf/pio/cable_netcdf_pio.F90) + else() + target_sources(cable_common PRIVATE src/util/netcdf/pio/cable_netcdf_pio_stub.F90) endif() if(CABLE_MPI) @@ -302,4 +345,33 @@ else() install(TARGETS cable RUNTIME) endif() + if (CABLE_TESTS) + add_executable( + cable-tests + tests/cable_tests.F90 + tests/fixtures.F90 + tests/utils/file_utils.F90 + tests/test_cable_netcdf.F90 + ) + if(CABLE_MPI) + target_sources(cable-tests PRIVATE tests/fortuno_interface_mpi.f90) + else() + target_sources(cable-tests PRIVATE tests/fortuno_interface_serial.f90) + endif() + target_link_libraries(cable-tests PRIVATE cable_common ${fortuno_libs}) + if(CABLE_MPI) + add_test(NAME cable-tests-serial + COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} 1 $ ~parallel + ) + set_tests_properties(cable-tests-serial PROPERTIES PROCESSORS 1) + add_test(NAME cable-tests-parallel + COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} 4 $ parallel + ) + set_tests_properties(cable-tests-parallel PROPERTIES PROCESSORS 4) + else() + add_test(NAME cable-tests-serial + COMMAND $ ~parallel + ) + endif() + endif() endif() diff --git a/build.bash b/build.bash index f4b243a9c..c824851b7 100755 --- a/build.bash +++ b/build.bash @@ -17,6 +17,9 @@ options below will be passed to CMake when generating the build system. Options: -c, --clean Delete build directory before invoking CMake. -m, --mpi Compile MPI executable. + -p, --parallelio + Enable parallel I/O support. This flag requires that --mpi is + also set. -C, --compiler Specify the compiler to use. -n, --ncpus @@ -63,6 +66,9 @@ while [ ${#} -gt 0 ]; do mpi=1 cmake_args+=(-DCABLE_MPI="ON") ;; + -p|--parallelio) + pio=1 + ;; -l|--library) build_args+=(--target cable_science) cmake_args+=(-DCABLE_LIBRARY="ON") @@ -98,9 +104,15 @@ if hostname -f | grep gadi.nci.org.au > /dev/null; then module add netcdf/4.6.3 case ${compiler} in intel) - module add intel-compiler/2019.5.281 + module add intel-compiler-llvm/2025.0.4 compiler_lib_install_dir=Intel - [[ -n ${mpi} ]] && module add intel-mpi/2019.5.281 + [[ -n ${mpi} ]] && module add openmpi/4.1.7 + # This is required so that the Parallel IO library is discoverable + # via CMake's `find_package` mechanism: + # TODO(Sean): This install of Parallel IO is specific to + # openmpi/4.1.7. We need a better way to provide this library on + # Gadi. + [[ -n ${pio} ]] && prepend_path CMAKE_PREFIX_PATH "/g/data/tm70/sb8430/parallelio_install" ;; gnu) module add gcc/13.2.0 @@ -123,6 +135,15 @@ if hostname -f | grep gadi.nci.org.au > /dev/null; then prepend_path CMAKE_PREFIX_PATH "${OPENMPI_BASE}/include/${compiler_lib_install_dir}" fi + if [[ -n ${pio} ]]; then + # The NetCDF Fortran version must be consistent with the version used in Parallel IO + # TODO(Sean): we need a better way to provide these libraries on Gadi + prepend_path CMAKE_PREFIX_PATH "/g/data/tm70/sb8430/spack/0.22/release/linux-rocky8-x86_64_v4/intel-2021.10.0/netcdf-c-4.9.2-oxepdmgcx6raxo4vi4teu45qqr63v3uj" + prepend_path PKG_CONFIG_PATH "/g/data/tm70/sb8430/spack/0.22/release/linux-rocky8-x86_64_v4/intel-2021.10.0/netcdf-c-4.9.2-oxepdmgcx6raxo4vi4teu45qqr63v3uj/lib/pkgconfig" + prepend_path CMAKE_PREFIX_PATH "/g/data/tm70/sb8430/spack/0.22/release/linux-rocky8-x86_64_v4/intel-2021.10.0/netcdf-fortran-4.6.1-eq777uogbelnhv43ln6jyub2gbmos42x" + prepend_path PKG_CONFIG_PATH "/g/data/tm70/sb8430/spack/0.22/release/linux-rocky8-x86_64_v4/intel-2021.10.0/netcdf-fortran-4.6.1-eq777uogbelnhv43ln6jyub2gbmos42x/lib/pkgconfig" + fi + elif hostname -f | grep -E '(mc16|mcmini)' > /dev/null; then : "${compiler:=gnu}" diff --git a/src/offline/cable_abort.F90 b/src/offline/cable_abort.F90 index 346c89035..ef9962e51 100644 --- a/src/offline/cable_abort.F90 +++ b/src/offline/cable_abort.F90 @@ -20,55 +20,38 @@ MODULE cable_abort_module + USE iso_fortran_env, ONLY: error_unit USE cable_IO_vars_module, ONLY: check, logn - IMPLICIT NONE - -CONTAINS + USE cable_mpi_mod, ONLY: mpi_grp_t - !============================================================================== - ! - ! Name: abort - ! - ! Purpose: Prints an error message and stops the code - ! - ! CALLed from: get_default_inits - ! get_restart_data - ! get_default_lai - ! open_met_file - ! get_met_data - ! load_parameters - ! open_output_file - ! write_output - ! read_gridinfo - ! countpatch - ! get_type_parameters - ! readpar_i - ! readpar_r - ! readpar_rd - ! readpar_r2 - ! readpar_r2d - ! define_output_variable_r1 - ! define_output_variable_r2 - ! define_output_parameter_r1 - ! define_output_parameter_r2 - ! write_output_variable_r1 - ! write_output_variable_r2 - ! write_output_parameter_r1 - ! write_output_parameter_r1d - ! write_output_parameter_r2 - ! write_output_parameter_r2d - ! - !============================================================================== + IMPLICIT NONE - SUBROUTINE abort(message) + TYPE(mpi_grp_t), PRIVATE :: mpi_grp_global - ! Input arguments - CHARACTER(LEN=*), INTENT(IN) :: message +CONTAINS - WRITE (*, *) message - STOP 1 + SUBROUTINE cable_abort_module_init(mpi_grp) + !! Initialise abort module + TYPE(mpi_grp_t), intent(in) :: mpi_grp + mpi_grp_global = mpi_grp + END SUBROUTINE + + SUBROUTINE cable_abort(message, file, line) + !! Print the error message and stop the code + CHARACTER(LEN=*), INTENT(IN) :: message !! Error message + CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: file + INTEGER, INTENT(IN), OPTIONAL :: line + CHARACTER(5) :: line_string + + IF (present(file) .AND. present(line)) THEN + WRITE (line_string, "(I5)") line + WRITE (error_unit, *) file // ":" // trim(adjustl(line_string)) // ": " // message + ELSE + WRITE (error_unit, *) message + END IF + call mpi_grp_global%abort() - END SUBROUTINE abort + END SUBROUTINE !============================================================================== ! diff --git a/src/offline/cable_define_types.F90 b/src/offline/cable_define_types.F90 index 9a2699ab7..df411ca31 100644 --- a/src/offline/cable_define_types.F90 +++ b/src/offline/cable_define_types.F90 @@ -37,16 +37,19 @@ MODULE cable_def_types_mod !---CABLE default KINDs for representing INTEGER/REAL values !---at least 10-digit precision - INTEGER :: mp, & ! # total no of patches/tiles - mvtype,& ! total # vegetation types, from input + INTEGER :: mp !! Total number of patches/tiles in the local grid of this MPI rank + INTEGER :: mp_global !! Total number of patches/tiles in the global grid + INTEGER :: mvtype !! Total number of vegetation types #ifdef UM_BUILD - mstype=9,& ! total # soil types, needs to be defined at compile time for now + INTEGER :: mstype = 9 !! Total number of soil types, needs to be defined at compile time for now #else - mstype,& ! total # soil types, from input + INTEGER :: mstype !! Total number of soil types, from input #endif - mland,& ! ! # land grid cells - mpatch !number of patches ! mpatch added by rk4417 - phase2 - !allows for setting this to a const value + INTEGER :: mland !! Total number of land grid cells in the local grid of this MPI rank + INTEGER :: mland_global !! Total number of land grid cells in the global grid + INTEGER :: mpatch ! mpatch added by rk4417 - phase2 + !! Number of patches - allows for setting this to a const value + INTEGER, PARAMETER :: & i_d = KIND(9), & diff --git a/src/offline/cable_driver_common.F90 b/src/offline/cable_driver_common.F90 index 9fc5b92c0..93cffc798 100644 --- a/src/offline/cable_driver_common.F90 +++ b/src/offline/cable_driver_common.F90 @@ -42,6 +42,7 @@ MODULE cable_driver_common_mod USE CABLE_PLUME_MIP, ONLY : PLUME_MIP_TYPE, PLUME_MIP_INIT USE CABLE_CRU, ONLY : CRU_TYPE, CRU_INIT USE CABLE_site, ONLY : site_TYPE, site_INIT + USE cable_abort_module, ONLY : cable_abort_module_init IMPLICIT NONE PRIVATE @@ -122,6 +123,8 @@ SUBROUTINE cable_driver_init(mpi_grp, NRRRR) INTEGER :: ioerror, unit CHARACTER(len=4) :: cRank ! for worker-logfiles + CALL cable_abort_module_init(mpi_grp) + !check to see if first argument passed to cable is !the name of the namelist file !if not use cable.nml diff --git a/src/offline/cable_initialise.F90 b/src/offline/cable_initialise.F90 index 766e6bcce..8c2fee22d 100644 --- a/src/offline/cable_initialise.F90 +++ b/src/offline/cable_initialise.F90 @@ -31,7 +31,7 @@ MODULE cable_init_module - USE cable_abort_module, ONLY: abort, nc_abort + USE cable_abort_module, ONLY: cable_abort, nc_abort USE cable_def_types_mod USE cable_IO_vars_module, ONLY: latitude,longitude, patch, & landpt,smoy,ncid_rin,max_vegpatches, & @@ -58,7 +58,7 @@ MODULE cable_init_module ! ! CALLed from: load_parameters ! - ! CALLs: abort + ! CALLs: cable_abort ! !============================================================================== @@ -120,8 +120,8 @@ SUBROUTINE get_default_inits(met,soil,ssnow,canopy,logn, EMSOIL) END DO - IF(ANY(ssnow%tgg>350.0).OR.ANY(ssnow%tgg<180.0)) CALL abort('Soil temps nuts') - IF(ANY(ssnow%albsoilsn>1.0).OR.ANY(ssnow%albsoilsn<0.0)) CALL abort('Albedo nuts') + IF(ANY(ssnow%tgg>350.0).OR.ANY(ssnow%tgg<180.0)) CALL cable_abort('Soil temps nuts') + IF(ANY(ssnow%albsoilsn>1.0).OR.ANY(ssnow%albsoilsn<0.0)) CALL cable_abort('Albedo nuts') ! Site independent initialisations (all gridcells): ! soil+snow albedo for infrared (other values read in below): @@ -154,7 +154,7 @@ END SUBROUTINE get_default_inits ! CALLs: nc_abort ! extraRestart ! readpar - ! abort + ! cable_abort ! ! Input file: [restart].nc ! @@ -220,7 +220,7 @@ SUBROUTINE get_restart_data(logn,ssnow,canopy,rough,bgc, & IF(ok /= NF90_NOERR) CALL nc_abort & (ok,'Error finding number of land points in restart file ' & //TRIM(filename%restart_in)//' (SUBROUTINE get_restart)') - IF(mland_restart /= mland) CALL abort('Number of land points in '// & + IF(mland_restart /= mland) CALL cable_abort('Number of land points in '// & 'restart file '//TRIM(filename%restart_in)// & ' differs from number in met file '//TRIM(filename%met)) @@ -252,7 +252,7 @@ SUBROUTINE get_restart_data(logn,ssnow,canopy,rough,bgc, & ! (ok,'Error finding number of surface types in restart file ' & ! //TRIM(filename%restart_in)//' (SUBROUTINE get_restart)') ! IF(surftype_restart /= 4) CALL & - ! abort('Number of surface types per grid cell in '// & + ! cable_abort('Number of surface types per grid cell in '// & ! 'restart file '//TRIM(filename%restart_in)// & ! ' differs from number in cable_variables.f90 ') ! ! Get surffrac variable: @@ -295,11 +295,11 @@ SUBROUTINE get_restart_data(logn,ssnow,canopy,rough,bgc, & IF(ok/=NF90_NOERR) CALL nc_abort(ok,'Error reading longitude in file ' & //TRIM(filename%restart_in)// '(SUBROUTINE get_restart)') IF(ANY(ABS(lat_restart-latitude)>0.01)) & - CALL abort('Latitude of land points in '// & + CALL cable_abort('Latitude of land points in '// & 'restart file '//TRIM(filename%restart_in)// & ' differs from met file '//TRIM(filename%met)) IF(ANY(ABS(lon_restart-longitude)>0.01)) & - CALL abort('Longitude of land points in '// & + CALL cable_abort('Longitude of land points in '// & 'restart file '//TRIM(filename%restart_in)// & ' differs from met file '//TRIM(filename%met)) DEALLOCATE(lat_restart,lon_restart) @@ -496,7 +496,7 @@ SUBROUTINE get_restart_data(logn,ssnow,canopy,rough,bgc, & IF (ANY(INvar /= veg%iveg)) THEN PRINT *, 'Error: veg type in restart file different from met input' PRINT *, 'Recommend not using this restart file as parameters have changed.' - CALL abort('Check iveg in '//filename%restart_in) + CALL cable_abort('Check iveg in '//filename%restart_in) ENDIF ELSE ! no problem with overwriting default values @@ -539,7 +539,7 @@ SUBROUTINE get_restart_data(logn,ssnow,canopy,rough,bgc, & IF (ANY(INvar /= soil%isoilm)) THEN PRINT *, 'Error: soil type in restart file different from met input' PRINT *, 'Recommend not using this restart file as parameters have changed.' - CALL abort('Check isoil in '//filename%restart_in) + CALL cable_abort('Check isoil in '//filename%restart_in) ENDIF ELSE ! no problem with overwriting default values diff --git a/src/offline/cable_input.F90 b/src/offline/cable_input.F90 index 84c3b6a66..e987c921a 100644 --- a/src/offline/cable_input.F90 +++ b/src/offline/cable_input.F90 @@ -37,7 +37,7 @@ MODULE cable_input_module ! Note that any precision changes from r_1 to REAL(4) enable running with -r8 ! - USE cable_abort_module, ONLY: abort, nc_abort + USE cable_abort_module, ONLY: cable_abort, nc_abort USE cable_def_types_mod USE casadimension, ONLY: icycle USE casavariable @@ -58,6 +58,7 @@ MODULE cable_input_module USE casa_inout_module, ONLY: casa_readphen, casa_init USE casa_readbiome_module, ONLY: casa_readbiome USE cable_checks_module, ONLY: check_range + USE cable_mpi_mod, ONLY: mpi_grp_t IMPLICIT NONE @@ -152,7 +153,7 @@ MODULE cable_input_module ! CALLed from: load_parameters ! ! CALLs: nc_abort - ! abort + ! cable_abort ! ! Input file: [LAI].nc ! @@ -228,7 +229,7 @@ SUBROUTINE get_default_lai END IF ok = NF90_INQUIRE_DIMENSION(ncid,tID,LEN=ntime) IF (ok /= NF90_NOERR) CALL nc_abort(ok,'Error getting time dimension.') - IF (ntime /= 12) CALL abort('Time dimension not 12 months.') + IF (ntime /= 12) CALL cable_abort('Time dimension not 12 months.') ok = NF90_INQ_VARID(ncid,'LAI',laiID) IF (ok /= NF90_NOERR) CALL nc_abort(ok,'Error finding LAI variable.') @@ -277,7 +278,7 @@ END SUBROUTINE get_default_lai ! ! CALLed from: cable_offline_driver ! - ! CALLs: abort + ! CALLs: cable_abort ! nc_abort ! date_and_time ! @@ -599,11 +600,11 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) latitude = lat_all(1,1) longitude = lon_all(1,1) mland_fromfile=1 - ALLOCATE(land_x(mland_fromfile),land_y(mland_fromfile)) - land_x = 1 - land_y = 1 + ALLOCATE(land_x_global(mland_fromfile),land_y_global(mland_fromfile)) + land_x_global = 1 + land_y_global = 1 ELSE - ! Call abort if more than one gridcell and no + ! Call cable_abort if more than one gridcell and no ! recognised grid system: CALL nc_abort & (ok,'Error finding grid system ("mask" or "land") variable in ' & @@ -634,7 +635,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) ! Allocate latitude and longitude variables: ALLOCATE(latitude(mland_fromfile),longitude(mland_fromfile)) ! Write to indicies of points in all-grid which are land - ALLOCATE(land_x(mland_fromfile),land_y(mland_fromfile)) + ALLOCATE(land_x_global(mland_fromfile),land_y_global(mland_fromfile)) ! Allocate "mask" variable: ALLOCATE(mask(xdimsize,ydimsize)) ! Initialise all gridpoints as sea: @@ -650,8 +651,8 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) ! Write to mask variable: mask(x,y)=1 ! Save indicies: - land_x(j) = x - land_y(j) = y + land_x_global(j) = x + land_y_global(j) = y END DO END IF ! does "land" variable exist ELSE ! i.e. "mask" variable exists @@ -693,16 +694,16 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) latitude = lat_temp(1:mland_fromfile) longitude = lon_temp(1:mland_fromfile) ! Write to indicies of points in mask which are land - ALLOCATE(land_x(mland_fromfile),land_y(mland_fromfile)) - land_x = land_xtmp(1:mland_fromfile) - land_y = land_ytmp(1:mland_fromfile) + ALLOCATE(land_x_global(mland_fromfile),land_y_global(mland_fromfile)) + land_x_global = land_xtmp(1:mland_fromfile) + land_y_global = land_ytmp(1:mland_fromfile) ! Clear lon_temp, lat_temp,land_xtmp,land_ytmp DEALLOCATE(lat_temp,lon_temp,land_xtmp,land_ytmp) END IF ! "mask" variable or no "mask" variable ! Set global mland value (number of land points), used to allocate ! all of CABLE's arrays: - mland = mland_fromfile + mland_global = mland_fromfile ! Write number of land points to log file: WRITE(logn,'(24X,I7,A29)') mland_fromfile, ' of which are land grid cells' @@ -723,7 +724,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) ok = NF90_INQ_DIMID(ncid_met,'monthly', monthlydimID) IF(ok==NF90_NOERR) THEN ! if found ok = NF90_INQUIRE_DIMENSION(ncid_met,monthlydimID,len=tempmonth) - IF(tempmonth/=12) CALL abort ('Number of months in met file /= 12.') + IF(tempmonth/=12) CALL cable_abort ('Number of months in met file /= 12.') END IF ! Set longitudes to be [-180,180]: @@ -732,10 +733,10 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) END WHERE ! Check ranges for latitude and longitude: IF(ANY(longitude>180.0).OR.ANY(longitude<-180.0)) & - CALL abort('Longitudes read from '//TRIM(filename%met)// & + CALL cable_abort('Longitudes read from '//TRIM(filename%met)// & ' are not [-180,180] or [0,360]! Please set.') IF(ANY(latitude>90.0).OR.ANY(latitude<-90.0)) & - CALL abort('Latitudes read from '//TRIM(filename%met)// & + CALL cable_abort('Latitudes read from '//TRIM(filename%met)// & ' are not [-90,90]! Please set.') !=================^^ End spatial details ^^======================== @@ -845,11 +846,11 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) END IF ELSE IF((ok==NF90_NOERR.AND.time_coord=='LOC'.AND.mland_fromfile>1)) THEN ! Else if local time is selected for regional simulation, abort: - CALL abort('"time" variable must be GMT for multiple site simulation!' & + CALL cable_abort('"time" variable must be GMT for multiple site simulation!' & //' Check "coordinate" field in time variable.' & //' (SUBROUTINE open_met_file)') ELSE IF(time_coord/='LOC'.AND.time_coord/='GMT') THEN - CALL abort('Meaningless time coordinate in met data file!' & + CALL cable_abort('Meaningless time coordinate in met data file!' & // ' (SUBROUTINE open_met_file)') END IF @@ -1007,7 +1008,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) /='W/m^2'.OR.metunits%SWdown(1:5)/='Wm^-2' & .OR.metunits%SWdown(1:4)/='Wm-2'.OR.metunits%SWdown(1:5) /= 'W m-2')) THEN WRITE(*,*) metunits%SWdown - CALL abort('Unknown units for SWdown'// & + CALL cable_abort('Unknown units for SWdown'// & ' in '//TRIM(filename%met)//' (SUBROUTINE open_met_data)') END IF ! Look for Tair (essential):- - - - - - - - - - - - - - - - - - - @@ -1031,7 +1032,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) convert%Tair = 0.0 ELSE WRITE(*,*) metunits%Tair - CALL abort('Unknown units for Tair'// & + CALL cable_abort('Unknown units for Tair'// & ' in '//TRIM(filename%met)//' (SUBROUTINE open_met_data)') END IF ! Look for Qair (essential):- - - - - - - - - - - - - - - - - - - @@ -1056,7 +1057,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) convert%Qair=1.0 ELSE WRITE(*,*) metunits%Qair - CALL abort('Unknown units for Qair'// & + CALL cable_abort('Unknown units for Qair'// & ' in '//TRIM(filename%met)//' (SUBROUTINE open_met_data)') END IF @@ -1088,7 +1089,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) convert%Rainf = dels/3600.0 ELSE WRITE(*,*) metunits%Rainf - CALL abort('Unknown units for Rainf'// & + CALL cable_abort('Unknown units for Rainf'// & ' in '//TRIM(filename%met)//' (SUBROUTINE open_met_data)') END IF ! Multiply acceptable Rainf ranges by time step size: @@ -1122,7 +1123,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) //TRIM(filename%met)//' (SUBROUTINE open_met_file)') IF (metunits%Wind(1:3)/='m/s'.AND.metunits%Wind(1:2)/='ms'.AND.metunits%Wind(1:5)/='m s-1') THEN WRITE(*,*) metunits%Wind - CALL abort('Unknown units for Wind'// & + CALL cable_abort('Unknown units for Wind'// & ' in '//TRIM(filename%met)//' (SUBROUTINE open_met_data)') END IF ! Now "optional" variables: @@ -1146,7 +1147,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) .OR.metunits%LWdown(1:4)/='Wm-2'.OR.metunits%SWdown(1:5) /= 'W m-2')) THEN WRITE(*,*) metunits%LWdown - CALL abort('Unknown units for LWdown'// & + CALL cable_abort('Unknown units for LWdown'// & ' in '//TRIM(filename%met)//' (SUBROUTINE open_met_data)') END IF ELSE @@ -1183,7 +1184,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) convert%PSurf = 1.0 ELSE WRITE(*,*) metunits%PSurf - CALL abort('Unknown units for PSurf'// & + CALL cable_abort('Unknown units for PSurf'// & ' in '//TRIM(filename%met)//' (SUBROUTINE open_met_data)') END IF ELSE ! If PSurf not present @@ -1206,16 +1207,16 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) ! Convert from feet to metres: convert%Elev = 0.3048 ELSE - CALL abort('Unknown units for Elevation'// & + CALL cable_abort('Unknown units for Elevation'// & ' in '//TRIM(filename%met)//' (SUBROUTINE open_met_data)') END IF ! Allocate space for elevation variable: - ALLOCATE(elevation(mland)) + ALLOCATE(elevation(mland_global)) ! Get site elevations: IF(metGrid=='mask') THEN - DO i = 1, mland + DO i = 1, mland_global ok= NF90_GET_VAR(ncid_met,id%Elev,data2, & - start=(/land_x(i),land_y(i)/),count=(/1,1/)) + start=(/land_x_global(i),land_y_global(i)/),count=(/1,1/)) IF(ok /= NF90_NOERR) CALL nc_abort & (ok,'Error reading elevation in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') @@ -1230,7 +1231,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) elevation = REAL(data1) * convert%Elev END IF ELSE ! If both PSurf and elevation aren't present, abort: - CALL abort & + CALL cable_abort & ('Error finding PSurf or Elevation in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') END IF @@ -1249,7 +1250,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) //TRIM(filename%met)//' (SUBROUTINE open_met_file)') IF(metunits%CO2air(1:3)/='ppm') THEN WRITE(*,*) metunits%CO2air - CALL abort('Unknown units for CO2air'// & + CALL cable_abort('Unknown units for CO2air'// & ' in '//TRIM(filename%met)//' (SUBROUTINE open_met_data)') END IF ELSE ! CO2 not present @@ -1274,7 +1275,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) (ok,'Error finding Snowf units in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') ! Make sure Snowf units are the same as Rainf units: - IF(metunits%Rainf/=metunits%Snowf) CALL abort & + IF(metunits%Rainf/=metunits%Snowf) CALL cable_abort & ('Please ensure Rainf and Snowf units are the same'// & ' in '//TRIM(filename%met)//' (SUBROUTINE open_met_data)') ELSE @@ -1334,16 +1335,16 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) IF(ok /= NF90_NOERR) CALL nc_abort & (ok,'Error finding avPrecip units in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') - IF(metunits%avPrecip(1:2)/='mm') CALL abort( & + IF(metunits%avPrecip(1:2)/='mm') CALL cable_abort( & 'Unknown avPrecip units in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') ! Allocate space for avPrecip variable: - ALLOCATE(avPrecip(mland)) + ALLOCATE(avPrecip(mland_global)) ! Get avPrecip from met file: IF(metGrid=='mask') THEN - DO i = 1, mland + DO i = 1, mland_global ok= NF90_GET_VAR(ncid_met,id%avPrecip,data2, & - start=(/land_x(i),land_y(i)/),count=(/1,1/)) + start=(/land_x_global(i),land_y_global(i)/),count=(/1,1/)) IF(ok /= NF90_NOERR) CALL nc_abort & (ok,'Error reading avPrecip in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') @@ -1351,7 +1352,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) END DO ELSE IF(metGrid=='land') THEN ! Allocate single preciaion temporary variable: - ALLOCATE(temparray1(mland)) + ALLOCATE(temparray1(mland_global)) ! Collect data from land only grid in netcdf file: ok= NF90_GET_VAR(ncid_met,id%avPrecip,temparray1) IF(ok /= NF90_NOERR) CALL nc_abort & @@ -1363,14 +1364,14 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) END IF ! Now find average precip from met data, and create rescaling ! factor for spinup: - ALLOCATE(PrecipScale(mland)) - DO i = 1, mland + ALLOCATE(PrecipScale(mland_global)) + DO i = 1, mland_global IF(metGrid=='mask') THEN ! Allocate space for temporary precip variable: ALLOCATE(tempPrecip3(1,1,kend)) ! Get all data for this grid cell: ok= NF90_GET_VAR(ncid_met,id%Rainf,tempPrecip3, & - start=(/land_x(i),land_y(i),1+koffset/),count=(/1,1,kend/)) + start=(/land_x_global(i),land_y_global(i),1+koffset/),count=(/1,1,kend/)) IF(ok /= NF90_NOERR) CALL nc_abort & (ok,'Error reading Rainf in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') @@ -1380,7 +1381,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) ! Get snowfall data for this grid cell: IF(exists%Snowf) THEN ok= NF90_GET_VAR(ncid_met,id%Snowf,tempPrecip3, & - start=(/land_x(i),land_y(i),1+koffset/),count=(/1,1,kend/)) + start=(/land_x_global(i),land_y_global(i),1+koffset/),count=(/1,1,kend/)) IF(ok /= NF90_NOERR) CALL nc_abort & (ok,'Error reading Snowf in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') @@ -1439,16 +1440,16 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) ! Note existence of at least one model parameter in the met file: exists%parameters = .TRUE. ! Allocate space for user-defined veg type variable: - ALLOCATE(vegtype_metfile(mland,nmetpatches)) - IF(exists%patch) ALLOCATE(vegpatch_metfile(mland,nmetpatches)) + ALLOCATE(vegtype_metfile(mland_global,nmetpatches)) + IF(exists%patch) ALLOCATE(vegpatch_metfile(mland_global,nmetpatches)) ! Check dimension of veg type: ok=NF90_INQUIRE_VARIABLE(ncid_met,id%iveg,ndims=iveg_dims) IF(metGrid=='mask') THEN ! i.e. at least two spatial dimensions IF(iveg_dims==2) THEN ! no patch specific iveg information, just x,y - DO i = 1, mland + DO i = 1, mland_global ok= NF90_GET_VAR(ncid_met,id%iveg,data2i, & ! get iveg data - start=(/land_x(i),land_y(i)/),count=(/1,1/)) + start=(/land_x_global(i),land_y_global(i)/),count=(/1,1/)) IF(ok /= NF90_NOERR) CALL nc_abort & (ok,'Error reading iveg in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') @@ -1464,10 +1465,10 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) (ok,'Patch-specific vegetation type (iveg) must be accompanied '// & 'by a patchfrac variable - this was not found in met data file '& //TRIM(filename%met)//' (SUBROUTINE open_met_file)') - DO i = 1, mland + DO i = 1, mland_global ! Then, get the patch specific iveg data: ok= NF90_GET_VAR(ncid_met,id%iveg,vegtype_metfile(i,:), & - start=(/land_x(i),land_y(i),1/),count=(/1,1,nmetpatches/)) + start=(/land_x_global(i),land_y_global(i),1/),count=(/1,1,nmetpatches/)) IF(ok /= NF90_NOERR) CALL nc_abort & ! check read ok (ok,'Error reading iveg in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') @@ -1476,7 +1477,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) !Anna: also read patch fractions ok= NF90_GET_VAR(ncid_met,id%patchfrac,vegpatch_metfile(i,:), & - start=(/land_x(i),land_y(i),1/),count=(/1,1,nmetpatches/)) + start=(/land_x_global(i),land_y_global(i),1/),count=(/1,1,nmetpatches/)) IF(ok /= NF90_NOERR) CALL nc_abort & ! check read ok (ok,'Error reading patchfrac in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') @@ -1486,7 +1487,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) ELSE IF(metGrid=='land') THEN ! Collect data from land only grid in netcdf file: IF(iveg_dims==1) THEN ! i.e. no patch specific iveg information - DO i = 1, mland + DO i = 1, mland_global ok= NF90_GET_VAR(ncid_met,id%iveg,data1i, & start=(/i/),count=(/1/)) IF(ok /= NF90_NOERR) CALL nc_abort & @@ -1508,13 +1509,13 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) IF(exists%patch) then !Anna: also read patch fractions ok= NF90_GET_VAR(ncid_met,id%patchfrac,vegpatch_metfile(i,:), & - start=(/land_x(i),land_y(i),1/),count=(/1,1,nmetpatches/)) + start=(/land_x_global(i),land_y_global(i),1/),count=(/1,1,nmetpatches/)) IF(ok /= NF90_NOERR) CALL nc_abort & ! check read ok (ok,'Error reading patchfrac in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') END IF - DO i = 1, mland + DO i = 1, mland_global ! Then, get the patch specific iveg data: ok= NF90_GET_VAR(ncid_met, id%iveg, & vegtype_metfile(i,:),& @@ -1539,13 +1540,13 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) ! Check dimension of soil type: ok=NF90_INQUIRE_VARIABLE(ncid_met,id%isoil,ndims=isoil_dims) ! Allocate space for user-defined soil type variable: - ALLOCATE(soiltype_metfile(mland,nmetpatches)) + ALLOCATE(soiltype_metfile(mland_global,nmetpatches)) ! Get soil type from met file: IF(metGrid=='mask') THEN IF(isoil_dims==2) THEN ! i.e. no patch specific isoil information - DO i = 1, mland + DO i = 1, mland_global ok= NF90_GET_VAR(ncid_met,id%isoil,data2i, & - start=(/land_x(i),land_y(i)/),count=(/1,1/)) + start=(/land_x_global(i),land_y_global(i)/),count=(/1,1/)) IF(ok /= NF90_NOERR) CALL nc_abort & (ok,'Error reading isoil in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') @@ -1553,10 +1554,10 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) soiltype_metfile(i,:)=data2i(1,1) END DO ELSE IF(isoil_dims==3) THEN ! i.e. patch specific isoil information - DO i = 1, mland + DO i = 1, mland_global ok= NF90_GET_VAR(ncid_met,id%isoil, & soiltype_metfile(i,:), & - start=(/land_x(i),land_y(i),1/),count=(/1,1,nmetpatches/)) + start=(/land_x_global(i),land_y_global(i),1/),count=(/1,1,nmetpatches/)) IF(ok /= NF90_NOERR) CALL nc_abort & (ok,'Error reading isoil in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') @@ -1565,7 +1566,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) ELSE IF(metGrid=='land') THEN IF(isoil_dims==1) THEN ! i.e. no patch specific isoil information ! Collect data from land only grid in netcdf file: - DO i = 1, mland + DO i = 1, mland_global ok= NF90_GET_VAR(ncid_met,id%isoil,data1i, & start=(/i/),count=(/1/)) IF(ok /= NF90_NOERR) CALL nc_abort & @@ -1575,7 +1576,7 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) soiltype_metfile(i,:) = data1i(1) END DO ELSE IF(isoil_dims==2) THEN ! i.e. patch specific isoil information - DO i = 1, mland + DO i = 1, mland_global ok= NF90_GET_VAR(ncid_met, id%isoil, & soiltype_metfile(i,:), & start=(/i,1/), count=(/1,nmetpatches/)) @@ -1612,7 +1613,7 @@ END SUBROUTINE open_met_file ! ! MODULEs used: cable_common_module ! - ! CALLs: abort + ! CALLs: cable_abort ! nc_abort ! rh_sh ! sinbet @@ -1673,7 +1674,7 @@ SUBROUTINE get_met_data(spinup,spinConv,met,soil,rad, & met%moy(landpt(i)%cstart) = smoy met%year(landpt(i)%cstart) = syear CASE DEFAULT - CALL abort('Unknown time coordinate! ' & + CALL cable_abort('Unknown time coordinate! ' & //' (SUBROUTINE get_met_data)') END SELECT ELSE @@ -2184,10 +2185,10 @@ SUBROUTINE get_met_data(spinup,spinConv,met,soil,rad, & ! Rescale precip to average rainfall for this site: DO i=1,mland ! over all land points/grid cells met%precip(landpt(i)%cstart:landpt(i)%cend) = & - met%precip(landpt(i)%cstart) / PrecipScale(i) + met%precip(landpt(i)%cstart) / PrecipScale(to_land_index_global(i)) ! Added for snow (EK nov2007) met%precip_sn(landpt(i)%cstart:landpt(i)%cend) = & - met%precip_sn(landpt(i)%cstart) / PrecipScale(i) + met%precip_sn(landpt(i)%cstart) / PrecipScale(to_land_index_global(i)) ENDDO END IF @@ -2507,9 +2508,9 @@ SUBROUTINE get_met_data(spinup,spinConv,met,soil,rad, & ! Rescale precip to average rainfall for this site: DO i=1,mland ! over all land points/grid cells met%precip(landpt(i)%cstart:landpt(i)%cend) = & - met%precip(landpt(i)%cstart) / PrecipScale(i) + met%precip(landpt(i)%cstart) / PrecipScale(to_land_index_global(i)) met%precip_sn(landpt(i)%cstart:landpt(i)%cend) = & - met%precip_sn(landpt(i)%cstart) / PrecipScale(i) + met%precip_sn(landpt(i)%cstart) / PrecipScale(to_land_index_global(i)) ENDDO END IF @@ -2634,7 +2635,7 @@ SUBROUTINE get_met_data(spinup,spinConv,met,soil,rad, & DEALLOCATE(tmpDat1, tmpDat2, tmpDat3, tmpDat2x) ELSE - CALL abort('Unrecognised grid type') + CALL cable_abort('Unrecognised grid type') END IF ! grid type IF ((.NOT. exists%Snowf) .OR. ALL(met%precip_sn == 0.0)) THEN ! honour snowf input @@ -2708,7 +2709,7 @@ END SUBROUTINE close_met_file ! casa_readbiome ! casa_readphen ! casa_init - ! abort + ! cable_abort ! get_restart_data ! get_parameters_met ! derived_parameters @@ -2722,7 +2723,7 @@ END SUBROUTINE close_met_file SUBROUTINE load_parameters(met,air,ssnow,veg,climate,bgc,soil,canopy,rough,rad, & sum_flux,bal,logn,vegparmnew,casabiome,casapool, & casaflux,sum_casapool, sum_casaflux,casamet,casabal,phen,POP,spinup,EMSOIL, & - TFRZ, LUC_EXPT, POPLUC) + TFRZ, LUC_EXPT, POPLUC, mpi_grp) !* Defines the priority order of sources of parameter ! values for CABLE, determines the total number of patches over all grid ! cells, and writes parameter values to CABLE's parameter arrays. @@ -2776,6 +2777,7 @@ SUBROUTINE load_parameters(met,air,ssnow,veg,climate,bgc,soil,canopy,rough,rad, TYPE( POP_TYPE ), INTENT(INOUT) :: POP TYPE( POPLUC_TYPE ), INTENT(INOUT) :: POPLUC TYPE (LUC_EXPT_TYPE), INTENT(INOUT) :: LUC_EXPT + TYPE(mpi_grp_t), INTENT(IN) :: mpi_grp INTEGER,INTENT(IN) :: logn ! log file unit number LOGICAL,INTENT(IN) :: & vegparmnew, & ! are we using the new format? @@ -2804,7 +2806,7 @@ SUBROUTINE load_parameters(met,air,ssnow,veg,climate,bgc,soil,canopy,rough,rad, INTEGER, DIMENSION(:), ALLOCATABLE :: Iwood ! Allocate spatial heterogeneity variables: - ALLOCATE(landpt(mland)) + ALLOCATE(landpt_global(mland_global)) WRITE(logn,*) '-------------------------------------------------------' WRITE(logn,*) 'Looking for parameters and initial states....' @@ -2818,7 +2820,7 @@ SUBROUTINE load_parameters(met,air,ssnow,veg,climate,bgc,soil,canopy,rough,rad, ! soil types based on latitude and longitude. This includes determining ! the number of patches in each grid cell, and so the total number of ! patches. - CALL get_default_params(logn,vegparmnew,LUC_EXPT) + CALL get_default_params(logn, vegparmnew, LUC_EXPT, mpi_grp) !| 2. Allocate CABLE (and CASA's [+phenology], if used) variables now that @@ -2945,7 +2947,7 @@ SUBROUTINE load_parameters(met,air,ssnow,veg,climate,bgc,soil,canopy,rough,rad, //TRIM(frst_in)//' (SUBROUTINE load_parameters) ' & //'Recommend running without restart file.') ! Check that mp_restart = mp from default/met values - IF(mp_restart /= mp) CALL abort('Number of patches in '// & + IF(mp_restart /= mp) CALL cable_abort('Number of patches in '// & 'restart file '//TRIM(frst_in)//' does not equal '// & 'to number in default/met file settings. (SUB load_parameters) ' & //'Recommend running without restart file.') diff --git a/src/offline/cable_io_decomp.F90 b/src/offline/cable_io_decomp.F90 new file mode 100644 index 000000000..84055c1c7 --- /dev/null +++ b/src/offline/cable_io_decomp.F90 @@ -0,0 +1,328 @@ +module cable_io_decomp_mod + use cable_def_types_mod, only: mp, mp_global + use cable_def_types_mod, only: mland, mland_global + use cable_def_types_mod, only: ms + use cable_def_types_mod, only: msn + use cable_def_types_mod, only: nrb + use cable_def_types_mod, only: ncp + use cable_def_types_mod, only: ncs + + use cable_io_vars_module, only: xdimsize, ydimsize + use cable_io_vars_module, only: land_x, land_y + use cable_io_vars_module, only: landpt + use cable_io_vars_module, only: max_vegpatches + use cable_io_vars_module, only: land_decomp_start + use cable_io_vars_module, only: patch_decomp_start + use cable_io_vars_module, only: output + use cable_io_vars_module, only: metGrid + + use cable_netcdf_decomp_util_mod, only: dim_spec_t + use cable_netcdf_decomp_util_mod, only: io_decomp_land_to_x_y + use cable_netcdf_decomp_util_mod, only: io_decomp_patch_to_x_y_patch + use cable_netcdf_decomp_util_mod, only: io_decomp_land_to_land + use cable_netcdf_decomp_util_mod, only: io_decomp_patch_to_land_patch + use cable_netcdf_decomp_util_mod, only: io_decomp_patch_to_patch + + use cable_netcdf_mod, only: cable_netcdf_decomp_t + use cable_netcdf_mod, only: CABLE_NETCDF_INT + use cable_netcdf_mod, only: CABLE_NETCDF_FLOAT + use cable_netcdf_mod, only: CABLE_NETCDF_DOUBLE + + implicit none + private + + public :: & + io_decomp_t, & + cable_io_decomp_init + + type io_decomp_t + class(cable_netcdf_decomp_t), allocatable :: patch_to_x_y_patch_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_to_x_y_patch_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_to_x_y_patch_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_soil_to_x_y_patch_soil_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_soil_to_x_y_patch_soil_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_soil_to_x_y_patch_soil_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_snow_to_x_y_patch_snow_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_snow_to_x_y_patch_snow_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_snow_to_x_y_patch_snow_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_rad_to_x_y_patch_rad_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_rad_to_x_y_patch_rad_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_rad_to_x_y_patch_rad_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_plantcarbon_to_x_y_patch_plantcarbon_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_plantcarbon_to_x_y_patch_plantcarbon_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_plantcarbon_to_x_y_patch_plantcarbon_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon_to_x_y_patch_soilcarbon_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon_to_x_y_patch_soilcarbon_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon_to_x_y_patch_soilcarbon_real64 + + class(cable_netcdf_decomp_t), allocatable :: patch_to_land_patch_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_to_land_patch_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_to_land_patch_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_soil_to_land_patch_soil_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_soil_to_land_patch_soil_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_soil_to_land_patch_soil_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_snow_to_land_patch_snow_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_snow_to_land_patch_snow_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_snow_to_land_patch_snow_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_rad_to_land_patch_rad_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_rad_to_land_patch_rad_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_rad_to_land_patch_rad_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_plantcarbon_to_land_patch_plantcarbon_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_plantcarbon_to_land_patch_plantcarbon_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_plantcarbon_to_land_patch_plantcarbon_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon_to_land_patch_soilcarbon_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon_to_land_patch_soilcarbon_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon_to_land_patch_soilcarbon_real64 + + class(cable_netcdf_decomp_t), allocatable :: patch_to_patch_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_to_patch_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_to_patch_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_soil_to_patch_soil_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_soil_to_patch_soil_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_soil_to_patch_soil_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_snow_to_patch_snow_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_snow_to_patch_snow_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_snow_to_patch_snow_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_rad_to_patch_rad_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_rad_to_patch_rad_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_rad_to_patch_rad_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_plantcarbon_to_patch_plantcarbon_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_plantcarbon_to_patch_plantcarbon_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_plantcarbon_to_patch_plantcarbon_real64 + class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon_to_patch_soilcarbon_int32 + class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon_to_patch_soilcarbon_real32 + class(cable_netcdf_decomp_t), allocatable :: patch_soilcarbon_to_patch_soilcarbon_real64 + + class(cable_netcdf_decomp_t), allocatable :: land_to_x_y_int32 + class(cable_netcdf_decomp_t), allocatable :: land_to_x_y_real32 + class(cable_netcdf_decomp_t), allocatable :: land_to_x_y_real64 + class(cable_netcdf_decomp_t), allocatable :: land_soil_to_x_y_soil_int32 + class(cable_netcdf_decomp_t), allocatable :: land_soil_to_x_y_soil_real32 + class(cable_netcdf_decomp_t), allocatable :: land_soil_to_x_y_soil_real64 + class(cable_netcdf_decomp_t), allocatable :: land_snow_to_x_y_snow_int32 + class(cable_netcdf_decomp_t), allocatable :: land_snow_to_x_y_snow_real32 + class(cable_netcdf_decomp_t), allocatable :: land_snow_to_x_y_snow_real64 + class(cable_netcdf_decomp_t), allocatable :: land_rad_to_x_y_rad_int32 + class(cable_netcdf_decomp_t), allocatable :: land_rad_to_x_y_rad_real32 + class(cable_netcdf_decomp_t), allocatable :: land_rad_to_x_y_rad_real64 + class(cable_netcdf_decomp_t), allocatable :: land_plantcarbon_to_x_y_plantcarbon_int32 + class(cable_netcdf_decomp_t), allocatable :: land_plantcarbon_to_x_y_plantcarbon_real32 + class(cable_netcdf_decomp_t), allocatable :: land_plantcarbon_to_x_y_plantcarbon_real64 + class(cable_netcdf_decomp_t), allocatable :: land_soilcarbon_to_x_y_soilcarbon_int32 + class(cable_netcdf_decomp_t), allocatable :: land_soilcarbon_to_x_y_soilcarbon_real32 + class(cable_netcdf_decomp_t), allocatable :: land_soilcarbon_to_x_y_soilcarbon_real64 + + class(cable_netcdf_decomp_t), allocatable :: land_to_land_int32 + class(cable_netcdf_decomp_t), allocatable :: land_to_land_real32 + class(cable_netcdf_decomp_t), allocatable :: land_to_land_real64 + class(cable_netcdf_decomp_t), allocatable :: land_soil_to_land_soil_int32 + class(cable_netcdf_decomp_t), allocatable :: land_soil_to_land_soil_real32 + class(cable_netcdf_decomp_t), allocatable :: land_soil_to_land_soil_real64 + class(cable_netcdf_decomp_t), allocatable :: land_snow_to_land_snow_int32 + class(cable_netcdf_decomp_t), allocatable :: land_snow_to_land_snow_real32 + class(cable_netcdf_decomp_t), allocatable :: land_snow_to_land_snow_real64 + class(cable_netcdf_decomp_t), allocatable :: land_rad_to_land_rad_int32 + class(cable_netcdf_decomp_t), allocatable :: land_rad_to_land_rad_real32 + class(cable_netcdf_decomp_t), allocatable :: land_rad_to_land_rad_real64 + class(cable_netcdf_decomp_t), allocatable :: land_plantcarbon_to_land_plantcarbon_int32 + class(cable_netcdf_decomp_t), allocatable :: land_plantcarbon_to_land_plantcarbon_real32 + class(cable_netcdf_decomp_t), allocatable :: land_plantcarbon_to_land_plantcarbon_real64 + class(cable_netcdf_decomp_t), allocatable :: land_soilcarbon_to_land_soilcarbon_int32 + class(cable_netcdf_decomp_t), allocatable :: land_soilcarbon_to_land_soilcarbon_real32 + class(cable_netcdf_decomp_t), allocatable :: land_soilcarbon_to_land_soilcarbon_real64 + + end type io_decomp_t + +contains + + subroutine cable_io_decomp_init(io_decomp) + type(io_decomp_t), intent(out), target :: io_decomp + + type(dim_spec_t), allocatable :: mem_shape_land(:) + type(dim_spec_t), allocatable :: mem_shape_land_soil(:) + type(dim_spec_t), allocatable :: mem_shape_land_snow(:) + type(dim_spec_t), allocatable :: mem_shape_land_rad(:) + type(dim_spec_t), allocatable :: mem_shape_land_plantcarbon(:) + type(dim_spec_t), allocatable :: mem_shape_land_soilcarbon(:) + type(dim_spec_t), allocatable :: mem_shape_patch(:) + type(dim_spec_t), allocatable :: mem_shape_patch_soil(:) + type(dim_spec_t), allocatable :: mem_shape_patch_snow(:) + type(dim_spec_t), allocatable :: mem_shape_patch_rad(:) + type(dim_spec_t), allocatable :: mem_shape_patch_plantcarbon(:) + type(dim_spec_t), allocatable :: mem_shape_patch_soilcarbon(:) + + type(dim_spec_t), allocatable :: var_shape_x_y(:) + type(dim_spec_t), allocatable :: var_shape_x_y_soil(:) + type(dim_spec_t), allocatable :: var_shape_x_y_snow(:) + type(dim_spec_t), allocatable :: var_shape_x_y_rad(:) + type(dim_spec_t), allocatable :: var_shape_x_y_plantcarbon(:) + type(dim_spec_t), allocatable :: var_shape_x_y_soilcarbon(:) + type(dim_spec_t), allocatable :: var_shape_x_y_patch(:) + type(dim_spec_t), allocatable :: var_shape_x_y_patch_soil(:) + type(dim_spec_t), allocatable :: var_shape_x_y_patch_snow(:) + type(dim_spec_t), allocatable :: var_shape_x_y_patch_rad(:) + type(dim_spec_t), allocatable :: var_shape_x_y_patch_plantcarbon(:) + type(dim_spec_t), allocatable :: var_shape_x_y_patch_soilcarbon(:) + type(dim_spec_t), allocatable :: var_shape_land(:) + type(dim_spec_t), allocatable :: var_shape_land_soil(:) + type(dim_spec_t), allocatable :: var_shape_land_snow(:) + type(dim_spec_t), allocatable :: var_shape_land_rad(:) + type(dim_spec_t), allocatable :: var_shape_land_plantcarbon(:) + type(dim_spec_t), allocatable :: var_shape_land_soilcarbon(:) + type(dim_spec_t), allocatable :: var_shape_land_patch(:) + type(dim_spec_t), allocatable :: var_shape_land_patch_soil(:) + type(dim_spec_t), allocatable :: var_shape_land_patch_snow(:) + type(dim_spec_t), allocatable :: var_shape_land_patch_rad(:) + type(dim_spec_t), allocatable :: var_shape_land_patch_plantcarbon(:) + type(dim_spec_t), allocatable :: var_shape_land_patch_soilcarbon(:) + type(dim_spec_t), allocatable :: var_shape_patch(:) + type(dim_spec_t), allocatable :: var_shape_patch_soil(:) + type(dim_spec_t), allocatable :: var_shape_patch_snow(:) + type(dim_spec_t), allocatable :: var_shape_patch_rad(:) + type(dim_spec_t), allocatable :: var_shape_patch_plantcarbon(:) + type(dim_spec_t), allocatable :: var_shape_patch_soilcarbon(:) + + logical :: requires_land_output_grid, requires_x_y_output_grid + + mem_shape_land = [dim_spec_t('land', mland)] + mem_shape_land_soil = [dim_spec_t('land', mland), dim_spec_t('soil', ms)] + mem_shape_land_snow = [dim_spec_t('land', mland), dim_spec_t('snow', msn)] + mem_shape_land_rad = [dim_spec_t('land', mland), dim_spec_t('rad', nrb)] + mem_shape_land_plantcarbon = [dim_spec_t('land', mland), dim_spec_t('plantcarbon', ncp)] + mem_shape_land_soilcarbon = [dim_spec_t('land', mland), dim_spec_t('soilcarbon', ncs)] + mem_shape_patch = [dim_spec_t('patch', mp)] + mem_shape_patch_soil = [dim_spec_t('patch', mp), dim_spec_t('soil', ms)] + mem_shape_patch_snow = [dim_spec_t('patch', mp), dim_spec_t('snow', msn)] + mem_shape_patch_rad = [dim_spec_t('patch', mp), dim_spec_t('rad', nrb)] + mem_shape_patch_plantcarbon = [dim_spec_t('patch', mp), dim_spec_t('plantcarbon', ncp)] + mem_shape_patch_soilcarbon = [dim_spec_t('patch', mp), dim_spec_t('soilcarbon', ncs)] + + var_shape_x_y = [dim_spec_t('x', xdimsize), dim_spec_t('y', ydimsize)] + var_shape_x_y_soil = [dim_spec_t('x', xdimsize), dim_spec_t('y', ydimsize), dim_spec_t('soil', ms)] + var_shape_x_y_snow = [dim_spec_t('x', xdimsize), dim_spec_t('y', ydimsize), dim_spec_t('snow', msn)] + var_shape_x_y_rad = [dim_spec_t('x', xdimsize), dim_spec_t('y', ydimsize), dim_spec_t('rad', nrb)] + var_shape_x_y_plantcarbon = [dim_spec_t('x', xdimsize), dim_spec_t('y', ydimsize), dim_spec_t('plantcarbon', ncp)] + var_shape_x_y_soilcarbon = [dim_spec_t('x', xdimsize), dim_spec_t('y', ydimsize), dim_spec_t('soilcarbon', ncs)] + var_shape_x_y_patch = [dim_spec_t('x', xdimsize), dim_spec_t('y', ydimsize), dim_spec_t('patch', max_vegpatches)] + var_shape_x_y_patch_soil = [dim_spec_t('x', xdimsize), dim_spec_t('y', ydimsize), dim_spec_t('patch', max_vegpatches), dim_spec_t('soil', ms)] + var_shape_x_y_patch_snow = [dim_spec_t('x', xdimsize), dim_spec_t('y', ydimsize), dim_spec_t('patch', max_vegpatches), dim_spec_t('snow', msn)] + var_shape_x_y_patch_rad = [dim_spec_t('x', xdimsize), dim_spec_t('y', ydimsize), dim_spec_t('patch', max_vegpatches), dim_spec_t('rad', nrb)] + var_shape_x_y_patch_plantcarbon = [dim_spec_t('x', xdimsize), dim_spec_t('y', ydimsize), dim_spec_t('patch', max_vegpatches), dim_spec_t('plantcarbon', ncp)] + var_shape_x_y_patch_soilcarbon = [dim_spec_t('x', xdimsize), dim_spec_t('y', ydimsize), dim_spec_t('patch', max_vegpatches), dim_spec_t('soilcarbon', ncs)] + var_shape_land = [dim_spec_t('land', mland_global)] + var_shape_land_soil = [dim_spec_t('land', mland_global), dim_spec_t('soil', ms)] + var_shape_land_snow = [dim_spec_t('land', mland_global), dim_spec_t('snow', msn)] + var_shape_land_rad = [dim_spec_t('land', mland_global), dim_spec_t('rad', nrb)] + var_shape_land_plantcarbon = [dim_spec_t('land', mland_global), dim_spec_t('plantcarbon', ncp)] + var_shape_land_soilcarbon = [dim_spec_t('land', mland_global), dim_spec_t('soilcarbon', ncs)] + var_shape_land_patch = [dim_spec_t('land', mland_global)] + var_shape_land_patch_soil = [dim_spec_t('land', mland_global), dim_spec_t('patch', max_vegpatches), dim_spec_t('soil', ms)] + var_shape_land_patch_snow = [dim_spec_t('land', mland_global), dim_spec_t('patch', max_vegpatches), dim_spec_t('snow', msn)] + var_shape_land_patch_rad = [dim_spec_t('land', mland_global), dim_spec_t('patch', max_vegpatches), dim_spec_t('rad', nrb)] + var_shape_land_patch_plantcarbon = [dim_spec_t('land', mland_global), dim_spec_t('patch', max_vegpatches), dim_spec_t('plantcarbon', ncp)] + var_shape_land_patch_soilcarbon = [dim_spec_t('land', mland_global), dim_spec_t('patch', max_vegpatches), dim_spec_t('soilcarbon', ncs)] + var_shape_patch = [dim_spec_t('patch', mp_global)] + var_shape_patch_soil = [dim_spec_t('patch', mp_global), dim_spec_t('soil', ms)] + var_shape_patch_snow = [dim_spec_t('patch', mp_global), dim_spec_t('snow', msn)] + var_shape_patch_rad = [dim_spec_t('patch', mp_global), dim_spec_t('rad', nrb)] + var_shape_patch_plantcarbon = [dim_spec_t('patch', mp_global), dim_spec_t('plantcarbon', ncp)] + var_shape_patch_soilcarbon = [dim_spec_t('patch', mp_global), dim_spec_t('soilcarbon', ncs)] + + io_decomp%land_to_x_y_int32 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land, var_shape_x_y, CABLE_NETCDF_INT) + io_decomp%land_to_x_y_real32 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land, var_shape_x_y, CABLE_NETCDF_FLOAT) + io_decomp%land_to_x_y_real64 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land, var_shape_x_y, CABLE_NETCDF_DOUBLE) + io_decomp%land_soil_to_x_y_soil_int32 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_soil, var_shape_x_y_soil, CABLE_NETCDF_INT) + io_decomp%land_soil_to_x_y_soil_real32 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_soil, var_shape_x_y_soil, CABLE_NETCDF_FLOAT) + io_decomp%land_soil_to_x_y_soil_real64 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_soil, var_shape_x_y_soil, CABLE_NETCDF_DOUBLE) + io_decomp%land_snow_to_x_y_snow_int32 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_snow, var_shape_x_y_snow, CABLE_NETCDF_INT) + io_decomp%land_snow_to_x_y_snow_real32 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_snow, var_shape_x_y_snow, CABLE_NETCDF_FLOAT) + io_decomp%land_snow_to_x_y_snow_real64 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_snow, var_shape_x_y_snow, CABLE_NETCDF_DOUBLE) + io_decomp%land_rad_to_x_y_rad_int32 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_rad, var_shape_x_y_rad, CABLE_NETCDF_INT) + io_decomp%land_rad_to_x_y_rad_real32 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_rad, var_shape_x_y_rad, CABLE_NETCDF_FLOAT) + io_decomp%land_rad_to_x_y_rad_real64 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_rad, var_shape_x_y_rad, CABLE_NETCDF_DOUBLE) + io_decomp%land_plantcarbon_to_x_y_plantcarbon_int32 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_plantcarbon, var_shape_x_y_plantcarbon, CABLE_NETCDF_INT) + io_decomp%land_plantcarbon_to_x_y_plantcarbon_real32 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_plantcarbon, var_shape_x_y_plantcarbon, CABLE_NETCDF_FLOAT) + io_decomp%land_plantcarbon_to_x_y_plantcarbon_real64 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_plantcarbon, var_shape_x_y_plantcarbon, CABLE_NETCDF_DOUBLE) + io_decomp%land_soilcarbon_to_x_y_soilcarbon_int32 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_soilcarbon, var_shape_x_y_soilcarbon, CABLE_NETCDF_INT) + io_decomp%land_soilcarbon_to_x_y_soilcarbon_real32 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_soilcarbon, var_shape_x_y_soilcarbon, CABLE_NETCDF_FLOAT) + io_decomp%land_soilcarbon_to_x_y_soilcarbon_real64 = io_decomp_land_to_x_y(land_x, land_y, mem_shape_land_soilcarbon, var_shape_x_y_soilcarbon, CABLE_NETCDF_DOUBLE) + + io_decomp%land_to_land_int32 = io_decomp_land_to_land(land_decomp_start, mem_shape_land, var_shape_land, CABLE_NETCDF_INT) + io_decomp%land_to_land_real32 = io_decomp_land_to_land(land_decomp_start, mem_shape_land, var_shape_land, CABLE_NETCDF_FLOAT) + io_decomp%land_to_land_real64 = io_decomp_land_to_land(land_decomp_start, mem_shape_land, var_shape_land, CABLE_NETCDF_DOUBLE) + io_decomp%land_soil_to_land_soil_int32 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_soil, var_shape_land_soil, CABLE_NETCDF_INT) + io_decomp%land_soil_to_land_soil_real32 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_soil, var_shape_land_soil, CABLE_NETCDF_FLOAT) + io_decomp%land_soil_to_land_soil_real64 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_soil, var_shape_land_soil, CABLE_NETCDF_DOUBLE) + io_decomp%land_snow_to_land_snow_int32 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_snow, var_shape_land_snow, CABLE_NETCDF_INT) + io_decomp%land_snow_to_land_snow_real32 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_snow, var_shape_land_snow, CABLE_NETCDF_FLOAT) + io_decomp%land_snow_to_land_snow_real64 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_snow, var_shape_land_snow, CABLE_NETCDF_DOUBLE) + io_decomp%land_rad_to_land_rad_int32 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_rad, var_shape_land_rad, CABLE_NETCDF_INT) + io_decomp%land_rad_to_land_rad_real32 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_rad, var_shape_land_rad, CABLE_NETCDF_FLOAT) + io_decomp%land_rad_to_land_rad_real64 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_rad, var_shape_land_rad, CABLE_NETCDF_DOUBLE) + io_decomp%land_plantcarbon_to_land_plantcarbon_int32 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_plantcarbon, var_shape_land_plantcarbon, CABLE_NETCDF_INT) + io_decomp%land_plantcarbon_to_land_plantcarbon_real32 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_plantcarbon, var_shape_land_plantcarbon, CABLE_NETCDF_FLOAT) + io_decomp%land_plantcarbon_to_land_plantcarbon_real64 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_plantcarbon, var_shape_land_plantcarbon, CABLE_NETCDF_DOUBLE) + io_decomp%land_soilcarbon_to_land_soilcarbon_int32 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_soilcarbon, var_shape_land_soilcarbon, CABLE_NETCDF_INT) + io_decomp%land_soilcarbon_to_land_soilcarbon_real32 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_soilcarbon, var_shape_land_soilcarbon, CABLE_NETCDF_FLOAT) + io_decomp%land_soilcarbon_to_land_soilcarbon_real64 = io_decomp_land_to_land(land_decomp_start, mem_shape_land_soilcarbon, var_shape_land_soilcarbon, CABLE_NETCDF_DOUBLE) + + io_decomp%patch_to_x_y_patch_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch, var_shape_x_y_patch, CABLE_NETCDF_INT) + io_decomp%patch_to_x_y_patch_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch, var_shape_x_y_patch, CABLE_NETCDF_FLOAT) + io_decomp%patch_to_x_y_patch_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch, var_shape_x_y_patch, CABLE_NETCDF_DOUBLE) + io_decomp%patch_soil_to_x_y_patch_soil_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_x_y_soil, CABLE_NETCDF_INT) + io_decomp%patch_soil_to_x_y_patch_soil_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_x_y_soil, CABLE_NETCDF_FLOAT) + io_decomp%patch_soil_to_x_y_patch_soil_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_x_y_soil, CABLE_NETCDF_DOUBLE) + io_decomp%patch_snow_to_x_y_patch_snow_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_x_y_snow, CABLE_NETCDF_INT) + io_decomp%patch_snow_to_x_y_patch_snow_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_x_y_snow, CABLE_NETCDF_FLOAT) + io_decomp%patch_snow_to_x_y_patch_snow_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_x_y_snow, CABLE_NETCDF_DOUBLE) + io_decomp%patch_rad_to_x_y_patch_rad_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_x_y_rad, CABLE_NETCDF_INT) + io_decomp%patch_rad_to_x_y_patch_rad_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_x_y_rad, CABLE_NETCDF_FLOAT) + io_decomp%patch_rad_to_x_y_patch_rad_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_x_y_rad, CABLE_NETCDF_DOUBLE) + io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_x_y_plantcarbon, CABLE_NETCDF_INT) + io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_x_y_plantcarbon, CABLE_NETCDF_FLOAT) + io_decomp%patch_plantcarbon_to_x_y_patch_plantcarbon_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_x_y_plantcarbon, CABLE_NETCDF_DOUBLE) + io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_int32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_x_y_soilcarbon, CABLE_NETCDF_INT) + io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_real32 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_x_y_soilcarbon, CABLE_NETCDF_FLOAT) + io_decomp%patch_soilcarbon_to_x_y_patch_soilcarbon_real64 = io_decomp_patch_to_x_y_patch(land_x, land_y, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_x_y_soilcarbon, CABLE_NETCDF_DOUBLE) + + io_decomp%patch_to_land_patch_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch, var_shape_land_patch, CABLE_NETCDF_INT) + io_decomp%patch_to_land_patch_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch, var_shape_land_patch, CABLE_NETCDF_FLOAT) + io_decomp%patch_to_land_patch_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch, var_shape_land_patch, CABLE_NETCDF_DOUBLE) + io_decomp%patch_soil_to_land_patch_soil_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_land_soil, CABLE_NETCDF_INT) + io_decomp%patch_soil_to_land_patch_soil_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_land_soil, CABLE_NETCDF_FLOAT) + io_decomp%patch_soil_to_land_patch_soil_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soil, var_shape_land_soil, CABLE_NETCDF_DOUBLE) + io_decomp%patch_snow_to_land_patch_snow_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_land_snow, CABLE_NETCDF_INT) + io_decomp%patch_snow_to_land_patch_snow_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_land_snow, CABLE_NETCDF_FLOAT) + io_decomp%patch_snow_to_land_patch_snow_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_snow, var_shape_land_snow, CABLE_NETCDF_DOUBLE) + io_decomp%patch_rad_to_land_patch_rad_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_land_rad, CABLE_NETCDF_INT) + io_decomp%patch_rad_to_land_patch_rad_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_land_rad, CABLE_NETCDF_FLOAT) + io_decomp%patch_rad_to_land_patch_rad_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_rad, var_shape_land_rad, CABLE_NETCDF_DOUBLE) + io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_land_plantcarbon, CABLE_NETCDF_INT) + io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_land_plantcarbon, CABLE_NETCDF_FLOAT) + io_decomp%patch_plantcarbon_to_land_patch_plantcarbon_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_plantcarbon, var_shape_land_plantcarbon, CABLE_NETCDF_DOUBLE) + io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_int32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_land_soilcarbon, CABLE_NETCDF_INT) + io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_real32 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_land_soilcarbon, CABLE_NETCDF_FLOAT) + io_decomp%patch_soilcarbon_to_land_patch_soilcarbon_real64 = io_decomp_patch_to_land_patch(land_decomp_start, landpt(:)%cstart, landpt(:)%nap, mem_shape_patch_soilcarbon, var_shape_land_soilcarbon, CABLE_NETCDF_DOUBLE) + + io_decomp%patch_to_patch_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch, var_shape_patch, CABLE_NETCDF_INT) + io_decomp%patch_to_patch_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch, var_shape_patch, CABLE_NETCDF_FLOAT) + io_decomp%patch_to_patch_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch, var_shape_patch, CABLE_NETCDF_DOUBLE) + io_decomp%patch_soil_to_patch_soil_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soil, var_shape_patch_soil, CABLE_NETCDF_INT) + io_decomp%patch_soil_to_patch_soil_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soil, var_shape_patch_soil, CABLE_NETCDF_FLOAT) + io_decomp%patch_soil_to_patch_soil_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soil, var_shape_patch_soil, CABLE_NETCDF_DOUBLE) + io_decomp%patch_snow_to_patch_snow_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_snow, var_shape_patch_snow, CABLE_NETCDF_INT) + io_decomp%patch_snow_to_patch_snow_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_snow, var_shape_patch_snow, CABLE_NETCDF_FLOAT) + io_decomp%patch_snow_to_patch_snow_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_snow, var_shape_patch_snow, CABLE_NETCDF_DOUBLE) + io_decomp%patch_rad_to_patch_rad_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_rad, var_shape_patch_rad, CABLE_NETCDF_INT) + io_decomp%patch_rad_to_patch_rad_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_rad, var_shape_patch_rad, CABLE_NETCDF_FLOAT) + io_decomp%patch_rad_to_patch_rad_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_rad, var_shape_patch_rad, CABLE_NETCDF_DOUBLE) + io_decomp%patch_plantcarbon_to_patch_plantcarbon_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_plantcarbon, var_shape_patch_plantcarbon, CABLE_NETCDF_INT) + io_decomp%patch_plantcarbon_to_patch_plantcarbon_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_plantcarbon, var_shape_patch_plantcarbon, CABLE_NETCDF_FLOAT) + io_decomp%patch_plantcarbon_to_patch_plantcarbon_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_plantcarbon, var_shape_patch_plantcarbon, CABLE_NETCDF_DOUBLE) + io_decomp%patch_soilcarbon_to_patch_soilcarbon_int32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soilcarbon, var_shape_patch_soilcarbon, CABLE_NETCDF_INT) + io_decomp%patch_soilcarbon_to_patch_soilcarbon_real32 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soilcarbon, var_shape_patch_soilcarbon, CABLE_NETCDF_FLOAT) + io_decomp%patch_soilcarbon_to_patch_soilcarbon_real64 = io_decomp_patch_to_patch(patch_decomp_start, mem_shape_patch_soilcarbon, var_shape_patch_soilcarbon, CABLE_NETCDF_DOUBLE) + + end subroutine + +end module diff --git a/src/offline/cable_iovars.F90 b/src/offline/cable_iovars.F90 index a2ca5247a..a28d731ed 100644 --- a/src/offline/cable_iovars.F90 +++ b/src/offline/cable_iovars.F90 @@ -57,7 +57,11 @@ MODULE cable_IO_vars_module INTEGER,POINTER,DIMENSION(:,:) :: mask ! land/sea mask from met file - INTEGER,POINTER,DIMENSION(:) :: land_x,land_y ! indicies of land in mask + INTEGER, POINTER, DIMENSION(:) :: land_x, land_y + !! Indexes into the global lat lon grid for each land point in the local land grid of this MPI rank + + INTEGER, POINTER, DIMENSION(:) :: land_x_global, land_y_global + !! Indexes into the global lat lon grid for each land point in the global land grid INTEGER :: & xdimsize,ydimsize, & ! sizes of x and y dimensions @@ -86,13 +90,25 @@ MODULE cable_IO_vars_module END TYPE land_type - TYPE(land_type),DIMENSION(:),POINTER :: landpt + TYPE(land_type), DIMENSION(:), POINTER :: landpt + !! Land information for each land point in the local grid of this MPI rank + TYPE(land_type), DIMENSION(:), POINTER :: landpt_global + !! Land information for each land point in the global grid TYPE(patch_type), DIMENSION(:), POINTER :: patch INTEGER :: & max_vegpatches, & ! The maximum # of patches in any grid cell nmetpatches ! size of patch dimension in met file, if exists + INTEGER :: land_decomp_start + !! Starting land point index of this MPI rank in global land array + INTEGER :: land_decomp_end + !! Ending land point index of this MPI rank in global land array + INTEGER :: patch_decomp_start + !! Starting patch index of this MPI rank in global patch array + INTEGER :: patch_decomp_end + !! Ending patch index of this MPI rank in global patch array + ! =============== File details ========================== TYPE globalMet_type LOGICAL :: & @@ -553,4 +569,11 @@ SUBROUTINE set_group_output_values END SUBROUTINE set_group_output_values + FUNCTION to_land_index_global(land_index_local) RESULT(land_index_global) + !! Translate local land index on current MPI rank to global land index + INTEGER, INTENT(IN) :: land_index_local + INTEGER :: land_index_global + land_index_global = land_decomp_start + land_index_local - 1 + END FUNCTION to_land_index_global + END MODULE cable_IO_vars_module diff --git a/src/offline/cable_mpi.F90 b/src/offline/cable_mpi.F90 index 034ecbb41..be32b3ca3 100644 --- a/src/offline/cable_mpi.F90 +++ b/src/offline/cable_mpi.F90 @@ -17,7 +17,8 @@ MODULE cable_mpi_mod mpi_grp_t, & mpi_mod_init, & mpi_mod_end, & - mpi_check_error + mpi_check_error, & + MPI_COMM_UNDEFINED TYPE(MPI_Comm), PARAMETER :: MPI_COMM_UNDEFINED = MPI_COMM_NULL @@ -32,11 +33,13 @@ MODULE cable_mpi_mod INTEGER :: size = -1 !! Size of the communicator CONTAINS PROCEDURE :: abort => mpi_grp_abort !! Send abort signal to processes in this group + PROCEDURE :: split => mpi_grp_split !! Split this group into sub-groups END TYPE mpi_grp_t INTERFACE mpi_grp_t !* Overload the default construct for mpi_grp_t PROCEDURE mpi_grp_constructor + PROCEDURE mpi_grp_constructor_legacy END INTERFACE mpi_grp_t CONTAINS @@ -120,12 +123,23 @@ FUNCTION mpi_grp_constructor(comm) RESULT(mpi_grp) END FUNCTION mpi_grp_constructor + FUNCTION mpi_grp_constructor_legacy(comm) RESULT(mpi_grp) + !* Contructor for mpi_grp_t using the legacy communicator type. + INTEGER, INTENT(IN) :: comm !! MPI communicator + TYPE(mpi_grp_t) :: mpi_grp + mpi_grp = mpi_grp_constructor(MPI_Comm(comm)) + END FUNCTION mpi_grp_constructor_legacy + SUBROUTINE mpi_grp_abort(this) !* Class method to abort execution of an MPI group. CLASS(mpi_grp_t), INTENT(IN) :: this INTEGER :: ierr +#ifndef __MPI__ + STOP 999 +#endif + IF (this%comm /= MPI_COMM_UNDEFINED) THEN ! Here we use an arbitrary error code #ifdef __MPI__ @@ -136,6 +150,27 @@ SUBROUTINE mpi_grp_abort(this) END SUBROUTINE mpi_grp_abort + SUBROUTINE mpi_grp_split(this, color, key, new_grp) + !* Class method to split an MPI group. + CLASS(mpi_grp_t), INTENT(IN) :: this + INTEGER, INTENT(IN) :: color, key + TYPE(mpi_grp_t), INTENT(OUT) :: new_grp + + TYPE(MPI_Comm) :: new_comm + INTEGER :: ierr + + IF (this%comm /= MPI_COMM_UNDEFINED) THEN +#ifdef __MPI__ + CALL MPI_Comm_split(this%comm, color, key, new_comm, ierr) +#endif + call mpi_check_error(ierr) + new_grp = mpi_grp_t(new_comm) + ELSE + new_grp = mpi_grp_t() + END IF + + END SUBROUTINE mpi_grp_split + SUBROUTINE mpi_check_error(ierr) !* Check if an MPI return code signaled an error. If so, print the ! corresponding message and abort the execution. diff --git a/src/offline/cable_mpimaster.F90 b/src/offline/cable_mpimaster.F90 index 591caba01..cccdcedea 100644 --- a/src/offline/cable_mpimaster.F90 +++ b/src/offline/cable_mpimaster.F90 @@ -91,9 +91,11 @@ MODULE cable_mpimaster compare_consistency_check_values USE cable_mpicommon USE cable_IO_vars_module, ONLY : NO_CHECK + USE cable_io_decomp_mod, ONLY: io_decomp_t, cable_io_decomp_init USE casa_cable USE casa_inout_module USE cable_checks_module, ONLY: constant_check_range + USE cable_mpi_mod, ONLY: mpi_grp_t IMPLICIT NONE @@ -166,7 +168,7 @@ MODULE cable_mpimaster CONTAINS - SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU) + SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) USE mpi @@ -233,6 +235,7 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU) INTEGER, INTENT(INOUT) :: kend !! No. of time steps in run TYPE(PLUME_MIP_TYPE), INTENT(IN) :: PLUME TYPE(CRU_TYPE), INTENT(IN) :: CRU + TYPE(mpi_grp_t), INTENT(INOUT) :: mpi_grp_master ! timing variables INTEGER, PARAMETER :: kstart = 1 ! start of simulation @@ -329,7 +332,7 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU) integer, dimension(:), allocatable, save :: cstart,cend,nap real(r_2), dimension(:,:,:), allocatable, save :: patchfrac_new - + type(io_decomp_t) :: io_decomp ! END header @@ -413,7 +416,7 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU) bal, logn, vegparmnew, casabiome, casapool, & casaflux, sum_casapool, sum_casaflux, & casamet, casabal, phen, POP, spinup, & - CEMSOIL, CTFRZ, LUC_EXPT, POPLUC ) + CEMSOIL, CTFRZ, LUC_EXPT, POPLUC, mpi_grp_master) IF (check%ranges /= NO_CHECK) THEN WRITE (*, *) "Checking parameter ranges" @@ -629,6 +632,7 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU) ktau = 0 ENDIF + call cable_io_decomp_init(io_decomp) ! MPI: mostly original serial code follows... ENDIF ! CALL1 diff --git a/src/offline/cable_mpimaster_stub.F90 b/src/offline/cable_mpimaster_stub.F90 index d290d4e1b..0ec3ab18c 100644 --- a/src/offline/cable_mpimaster_stub.F90 +++ b/src/offline/cable_mpimaster_stub.F90 @@ -4,6 +4,7 @@ MODULE cable_mpimaster !! Stub for the master driver when MPI is not available. + USE cable_mpi_mod, ONLY : mpi_grp_t USE CABLE_PLUME_MIP, ONLY : PLUME_MIP_TYPE USE CABLE_CRU, ONLY : CRU_TYPE IMPLICIT NONE @@ -13,7 +14,7 @@ MODULE cable_mpimaster CONTAINS - SUBROUTINE mpidrv_master(comm, dels, koffset, kend, PLUME, CRU) + SUBROUTINE mpidrv_master(comm, dels, koffset, kend, PLUME, CRU, mpi_grp_master) !! Stub for when MPI is not available INTEGER, INTENT(IN) :: comm REAL, INTENT(INOUT) :: dels @@ -21,6 +22,7 @@ SUBROUTINE mpidrv_master(comm, dels, koffset, kend, PLUME, CRU) INTEGER, INTENT(INOUT) :: kend TYPE(PLUME_MIP_TYPE), INTENT(IN) :: PLUME TYPE(CRU_TYPE), INTENT(IN) :: CRU + TYPE(mpi_grp_t), INTENT(INOUT) :: mpi_grp_master ! This should never be called! STOP diff --git a/src/offline/cable_offline_driver.F90 b/src/offline/cable_offline_driver.F90 index d63e4fe13..8b8d3dd1b 100644 --- a/src/offline/cable_offline_driver.F90 +++ b/src/offline/cable_offline_driver.F90 @@ -22,7 +22,7 @@ PROGRAM cable_offline_driver IMPLICIT NONE REAL :: etime ! Declare the type of etime() - TYPE(mpi_grp_t) :: mpi_grp + TYPE(mpi_grp_t) :: mpi_grp, mpi_grp_master, mpi_grp_worker INTEGER :: NRRRR !! Number of repeated spin-up cycles REAL :: dels !! Time step size in seconds INTEGER :: koffset = 0 !! Timestep to start at @@ -32,6 +32,8 @@ PROGRAM cable_offline_driver TYPE(CRU_TYPE) :: CRU TYPE (site_TYPE) :: site + INTEGER, PARAMETER :: COLOR_MASTER = 0, COLOR_WORKER = 1 + call mpi_mod_init() mpi_grp = mpi_grp_t() @@ -58,12 +60,14 @@ PROGRAM cable_offline_driver STOP END SELECT - IF (mpi_grp%size == 1) THEN - CALL serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site) + IF (mpi_grp%size == 1 .OR. .NOT. cable_user%mpi_legacy) THEN + CALL serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi_grp) ELSE IF (mpi_grp%rank == 0) THEN - CALL mpidrv_master(mpi_grp%comm%mpi_val, dels, koffset, kend, PLUME, CRU) + CALL mpi_grp%split(COLOR_MASTER, mpi_grp%rank, mpi_grp_master) + CALL mpidrv_master(mpi_grp%comm%mpi_val, dels, koffset, kend, PLUME, CRU, mpi_grp_master) ELSE + CALL mpi_grp%split(COLOR_WORKER, mpi_grp%rank, mpi_grp_worker) CALL mpidrv_worker(mpi_grp%comm%mpi_val) END IF END IF diff --git a/src/offline/cable_output.F90 b/src/offline/cable_output.F90 index b7ada0c57..ed402645a 100644 --- a/src/offline/cable_output.F90 +++ b/src/offline/cable_output.F90 @@ -36,7 +36,7 @@ MODULE cable_output_module - USE cable_abort_module, ONLY: abort, nc_abort + USE cable_abort_module, ONLY: cable_abort, nc_abort USE cable_def_types_mod USE casavariable, ONLY: casa_pool, casa_flux, casa_met USE cable_IO_vars_module @@ -1316,7 +1316,7 @@ SUBROUTINE open_output_file(dels, soil, veg, bgc, rough, met) ! Set output interval to be # time steps in 24 hours: output%interval = 3600*24/INT(dels) ELSE - CALL abort ('Unknown output averaging interval specified '// & + CALL cable_abort ('Unknown output averaging interval specified '// & 'in namelist file. (SUBROUTINE open_output_file)') END IF @@ -1756,7 +1756,7 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss ELSE ! type of output aggregation - CALL abort('Unknown output averaging request in namelist file.'// & + CALL cable_abort('Unknown output averaging request in namelist file.'// & '(SUBROUTINE write_output)') END IF @@ -1778,7 +1778,7 @@ SUBROUTINE write_output(dels, ktau, met, canopy, casaflux, casapool, casamet, ss ! Arguments to generate_out_write_acc: current time step; output file netcdf file ID; ! netcdf variable ID; variable name; variable data; variable ranges; ! non-land fill value; include patch info for this var; any specific - ! formatting info; met variables for reporting in case of abort. + ! formatting info; met variables for reporting in case of cable_abort. !-----------------------WRITE MET DATA------------------------------------- out_settings%dimswitch = 'default' diff --git a/src/offline/cable_parameters.F90 b/src/offline/cable_parameters.F90 index 44ebc6b9d..0e1d1f101 100644 --- a/src/offline/cable_parameters.F90 +++ b/src/offline/cable_parameters.F90 @@ -63,6 +63,8 @@ MODULE cable_param_module USE cable_pft_params_mod USE cable_soil_params_mod USE CABLE_LUC_EXPT, ONLY: LUC_EXPT, LUC_EXPT_TYPE, LUC_EXPT_SET_TILES + USE cable_mpi_mod, ONLY: mpi_grp_t + USE cable_array_utils_mod, ONLY: array_partition IMPLICIT NONE PRIVATE PUBLIC get_default_params, write_default_params, derived_parameters, & @@ -136,12 +138,12 @@ MODULE cable_param_module CONTAINS - SUBROUTINE get_default_params(logn, vegparmnew, LUC_EXPT) + SUBROUTINE get_default_params(logn, vegparmnew, LUC_EXPT, mpi_grp) USE cable_common_module, ONLY : filename, & calcsoilalbedo,cable_user ! Load parameters for each veg type and each soil type. (get_type_parameters) ! Also read in initial information for each grid point. (read_gridinfo) - ! Count to obtain 'landpt', 'max_vegpatches' and 'mp'. (countPatch) + ! Count to obtain 'landpt_global', 'max_vegpatches' and 'mp_global'. (countPatch) ! ! New input structure using netcdf and introduced 'month' to initialize ! soil profiles with the correct monthly average values (BP apr2010) @@ -150,6 +152,7 @@ SUBROUTINE get_default_params(logn, vegparmnew, LUC_EXPT) INTEGER, INTENT(IN) :: logn ! log file unit number LOGICAL, INTENT(IN) :: vegparmnew ! new format input file (BP dec2007) TYPE (LUC_EXPT_TYPE), INTENT(INOUT) :: LUC_EXPT + TYPE(mpi_grp_t), INTENT(IN) :: mpi_grp ! local variables INTEGER :: npatch @@ -188,9 +191,11 @@ SUBROUTINE get_default_params(logn, vegparmnew, LUC_EXPT) CALL read_soilcolor(logn) END IF - ! count to obtain 'landpt', 'max_vegpatches' and 'mp' + ! count to obtain 'landpt_global', 'max_vegpatches' and 'mp_global' CALL countPatch(nlon, nlat, npatch) + CALL init_local_structure_variables(mpi_grp) + END SUBROUTINE get_default_params !============================================================================= SUBROUTINE read_gridinfo(nlon, nlat, npatch) @@ -272,7 +277,7 @@ SUBROUTINE read_gridinfo(nlon, nlat, npatch) PRINT *, 'nslayer and ms = ', nslayer, ms PRINT *, 'ntime not equal 12 months: ', ntime IF (ntime /=12) THEN - CALL abort('Variable dimensions do not match (read_gridinfo)') + CALL cable_abort('Variable dimensions do not match (read_gridinfo)') ELSE PRINT*, 'warning: soil layers below nslayer will be initialsed with moisture' PRINT*, 'and temperature of lowest layer in grid_info' @@ -929,7 +934,7 @@ END SUBROUTINE NSflip !============================================================================= SUBROUTINE get_land_index(nlon, nlat) ! - ! fill the index variable 'landpt%ilat, landpt%ilon' + ! fill the index variable 'landpt_global%ilat, landpt_global%ilon' ! ! Input variables: ! nlon - # longitudes in input data set @@ -937,14 +942,14 @@ SUBROUTINE get_land_index(nlon, nlat) ! npatch - # patches in each grid from input data set ! inLon - via cable_param_module ! inLat - via cable_param_module - ! longitude - via cable_IO_vars_module, dim(mland), not patches - ! latitude - via cable_IO_vars_module, dim(mland), not patches + ! longitude - via cable_IO_vars_module, dim(mland_global), not patches + ! latitude - via cable_IO_vars_module, dim(mland_global), not patches ! nmetpatches - via cable_IO_vars_module - ! vegtype_metfile - via cable_IO_vars_module, dim(mland,nmetpatches) - ! soiltype_metfile- via cable_IO_vars_module, dim(mland,nmetpatches) + ! vegtype_metfile - via cable_IO_vars_module, dim(mland_global,nmetpatches) + ! soiltype_metfile- via cable_IO_vars_module, dim(mland_global,nmetpatches) ! Output variables: ! max_vegpatches - via cable_IO_vars_module - ! landpt%type - via cable_IO_vars_module (%nap,cstart,cend,ilon,ilat) + ! landpt_global%type - via cable_IO_vars_module (%nap,cstart,cend,ilon,ilat) IMPLICIT NONE INTEGER, INTENT(IN) :: nlon, nlat @@ -955,10 +960,10 @@ SUBROUTINE get_land_index(nlon, nlat) ! range of longitudes from input file (inLon) should be -180 to 180, ! and longitude(:) has already been converted to -180 to 180 for CABLE. - landpt(:)%ilon = -999 - landpt(:)%ilat = -999 + landpt_global(:)%ilon = -999 + landpt_global(:)%ilat = -999 ncount = 0 - DO kk = 1, mland + DO kk = 1, mland_global distance = 5300.0 ! initialise, units are degrees DO jj = 1, nlat DO ii = 1, nlon @@ -967,13 +972,13 @@ SUBROUTINE get_land_index(nlon, nlat) + (inLat(jj) - latitude(kk))**2) IF (newLength < distance) THEN distance = newLength - landpt(kk)%ilon = ii - landpt(kk)%ilat = jj + landpt_global(kk)%ilon = ii + landpt_global(kk)%ilat = jj END IF END IF END DO END DO - IF (landpt(kk)%ilon < -900 .OR. landpt(kk)%ilat < -900) THEN + IF (landpt_global(kk)%ilon < -900 .OR. landpt_global(kk)%ilat < -900) THEN PRINT *, 'Land point ', kk, ' cannot find the nearest grid!' PRINT *, 'lon, lat = ', longitude(kk), latitude(kk) PRINT *, 'inLon range:', MINVAL(inLon), MAXVAL(inLon) @@ -991,7 +996,7 @@ END SUBROUTINE get_land_index SUBROUTINE countPatch(nlon, nlat, npatch) ! count the total number of active patches and - ! fill the index variable 'landpt' + ! fill the index variable 'landpt_global' ! ! Input variables: ! nlon - # longitudes in input data set @@ -999,14 +1004,14 @@ SUBROUTINE countPatch(nlon, nlat, npatch) ! npatch - # patches in each grid from input data set ! inLon - via cable_param_module ! inLat - via cable_param_module - ! longitude - via cable_IO_vars_module, dim(mland), not patches - ! latitude - via cable_IO_vars_module, dim(mland), not patches + ! longitude - via cable_IO_vars_module, dim(mland_global), not patches + ! latitude - via cable_IO_vars_module, dim(mland_global), not patches ! nmetpatches - via cable_IO_vars_module - ! vegtype_metfile - via cable_IO_vars_module, dim(mland,nmetpatches) - ! soiltype_metfile- via cable_IO_vars_module, dim(mland,nmetpatches) + ! vegtype_metfile - via cable_IO_vars_module, dim(mland_global,nmetpatches) + ! soiltype_metfile- via cable_IO_vars_module, dim(mland_global,nmetpatches) ! Output variables: ! max_vegpatches - via cable_IO_vars_module - ! landpt%type - via cable_IO_vars_module (%nap,cstart,cend,ilon,ilat) + ! landpt_global%type - via cable_IO_vars_module (%nap,cstart,cend,ilon,ilat) IMPLICIT NONE INTEGER, INTENT(IN) :: nlon, nlat, npatch @@ -1023,10 +1028,10 @@ SUBROUTINE countPatch(nlon, nlat, npatch) ! range of longitudes from input file (inLon) should be -180 to 180, ! and longitude(:) has already been converted to -180 to 180 for CABLE. - landpt(:)%ilon = -999 - landpt(:)%ilat = -999 + landpt_global(:)%ilon = -999 + landpt_global(:)%ilat = -999 ncount = 0 - DO kk = 1, mland + DO kk = 1, mland_global distance = 300.0 ! initialise, units are degrees DO jj = 1, nlat DO ii = 1, nlon @@ -1035,13 +1040,13 @@ SUBROUTINE countPatch(nlon, nlat, npatch) + (inLat(jj) - latitude(kk))**2) IF (newLength < distance) THEN distance = newLength - landpt(kk)%ilon = ii - landpt(kk)%ilat = jj + landpt_global(kk)%ilon = ii + landpt_global(kk)%ilat = jj END IF END IF END DO END DO - IF (landpt(kk)%ilon < -900 .OR. landpt(kk)%ilat < -900) THEN + IF (landpt_global(kk)%ilon < -900 .OR. landpt_global(kk)%ilat < -900) THEN PRINT *, 'Land point ', kk, ' cannot find the nearest grid!' PRINT *, 'lon, lat = ', longitude(kk), latitude(kk) PRINT *, 'inLon range:', MINVAL(inLon), MAXVAL(inLon) @@ -1049,34 +1054,34 @@ SUBROUTINE countPatch(nlon, nlat, npatch) STOP END IF - landpt(kk)%nap = 0 - landpt(kk)%cstart = ncount + 1 + landpt_global(kk)%nap = 0 + landpt_global(kk)%cstart = ncount + 1 IF (ASSOCIATED(vegtype_metfile)) THEN DO tt = 1, nmetpatches IF (vegtype_metfile(kk,tt) > 0) ncount = ncount + 1 - landpt(kk)%nap = landpt(kk)%nap + 1 + landpt_global(kk)%nap = landpt_global(kk)%nap + 1 END DO - landpt(kk)%cend = ncount - IF (landpt(kk)%cend < landpt(kk)%cstart) THEN + landpt_global(kk)%cend = ncount + IF (landpt_global(kk)%cend < landpt_global(kk)%cstart) THEN PRINT *, 'Land point ', kk, ' does not have veg type!' - PRINT *, 'landpt%cstart, cend = ', landpt(kk)%cstart, landpt(kk)%cend + PRINT *, 'landpt_global%cstart, cend = ', landpt_global(kk)%cstart, landpt_global(kk)%cend PRINT *, 'vegtype_metfile = ', vegtype_metfile(kk,:) STOP END IF ! CLN added for npatches ELSE IF ( npatch .GT. 1 ) THEN - landpt(kk)%nap = 0 + landpt_global(kk)%nap = 0 DO tt = 1, npatch - IF (inVeg(landpt(kk)%ilon,landpt(kk)%ilat,tt) > 0) THEN - landpt(kk)%nap = landpt(kk)%nap + 1 + IF (inVeg(landpt_global(kk)%ilon,landpt_global(kk)%ilat,tt) > 0) THEN + landpt_global(kk)%nap = landpt_global(kk)%nap + 1 ENDIF END DO - ncount = ncount + landpt(kk)%nap - landpt(kk)%cend = ncount - IF (landpt(kk)%cend < landpt(kk)%cstart) THEN + ncount = ncount + landpt_global(kk)%nap + landpt_global(kk)%cend = ncount + IF (landpt_global(kk)%cend < landpt_global(kk)%cstart) THEN PRINT *, 'Land point ', kk, ' does not have veg type!' - PRINT *, 'landpt%cstart, cend = ', landpt(kk)%cstart, landpt(kk)%cend + PRINT *, 'landpt_global%cstart, cend = ', landpt_global(kk)%cstart, landpt_global(kk)%cend PRINT *, 'vegtype_metfile = ', vegtype_metfile(kk,:) STOP END IF @@ -1084,8 +1089,8 @@ SUBROUTINE countPatch(nlon, nlat, npatch) ! assume nmetpatches to be 1 IF (nmetpatches == 1) THEN ncount = ncount + 1 - landpt(kk)%nap = 1 - landpt(kk)%cend = ncount + landpt_global(kk)%nap = 1 + landpt_global(kk)%cend = ncount ELSE PRINT *, 'nmetpatches = ', nmetpatches, '. Should be 1.' PRINT *, 'If soil patches exist, add new code.' @@ -1093,16 +1098,16 @@ SUBROUTINE countPatch(nlon, nlat, npatch) END IF END IF END DO - ! CLN IF (ncount > mland * nmetpatches) THEN - IF (ncount > mland * nmetpatches .AND. npatch == 1) THEN - PRINT *, ncount, ' should not be greater than mland*nmetpatches.' - PRINT *, 'mland, nmetpatches = ', mland, nmetpatches + ! CLN IF (ncount > mland_global * nmetpatches) THEN + IF (ncount > mland_global * nmetpatches .AND. npatch == 1) THEN + PRINT *, ncount, ' should not be greater than mland_global*nmetpatches.' + PRINT *, 'mland_global, nmetpatches = ', mland_global, nmetpatches STOP END IF DEALLOCATE(inLon, inLat) ! Set the maximum number of active patches to that read from met file: - max_vegpatches = MAXVAL(landpt(:)%nap) + max_vegpatches = MAXVAL(landpt_global(:)%nap) ! mpatch setting below introduced by rk4417 - phase2 mpatch = max_vegpatches ! MMY@13April keep this line, it is an update of mpatch to consider @@ -1120,10 +1125,35 @@ SUBROUTINE countPatch(nlon, nlat, npatch) END IF ! Write to total # patches - used to allocate all of CABLE's variables: - mp = ncount + mp_global = ncount PRINT *, 'Total number of patches (countPatch): ', ncount END SUBROUTINE countPatch + + SUBROUTINE init_local_structure_variables(mpi_grp) + !! Initialise local structure variables for the current MPI rank + TYPE(mpi_grp_t), INTENT(IN) :: mpi_grp + + CALL array_partition(mland_global, mpi_grp%size, mpi_grp%rank, land_decomp_start, mland) + + land_decomp_end = land_decomp_start + mland - 1 + + ALLOCATE(land_x(mland), source=land_x_global(land_decomp_start:land_decomp_end)) + ALLOCATE(land_y(mland), source=land_y_global(land_decomp_start:land_decomp_end)) + + patch_decomp_start = landpt_global(land_decomp_start)%cstart + patch_decomp_end = landpt_global(land_decomp_end)%cend + mp = patch_decomp_end - patch_decomp_start + 1 + + ALLOCATE(landpt(mland)) + landpt(:)%cstart = landpt_global(land_decomp_start:land_decomp_end)%cstart - patch_decomp_start + 1 + landpt(:)%cend = landpt_global(land_decomp_start:land_decomp_end)%cend - patch_decomp_start + 1 + landpt(:)%nap = landpt_global(land_decomp_start:land_decomp_end)%nap + landpt(:)%ilon = landpt_global(land_decomp_start:land_decomp_end)%ilon + landpt(:)%ilat = landpt_global(land_decomp_start:land_decomp_end)%ilat + + END SUBROUTINE init_local_structure_variables + !============================================================================= SUBROUTINE write_default_params(met, air, ssnow, veg, bgc, & soil, canopy, rough, rad, logn, & @@ -1139,11 +1169,11 @@ SUBROUTINE write_default_params(met, air, ssnow, veg, bgc, & ! soil profiles with the correct monthly average values (BP apr2010) ! ! Input variables: - ! longitude - via cable_IO_vars_module, dim(mland), not patches - ! latitude - via cable_IO_vars_module, dim(mland), not patches + ! longitude - via cable_IO_vars_module, dim(mland_global), not patches + ! latitude - via cable_IO_vars_module, dim(mland_global), not patches ! nmetpatches - via cable_IO_vars_module - ! vegtype_metfile - via cable_IO_vars_module, dim(mland,nmetpatches) - ! soiltype_metfile- via cable_IO_vars_module, dim(mland,nmetpatches) + ! vegtype_metfile - via cable_IO_vars_module, dim(mland_global,nmetpatches) + ! soiltype_metfile- via cable_IO_vars_module, dim(mland_global,nmetpatches) ! Output variables: ! max_vegpatches - via cable_IO_vars_module ! landpt(mp)%type- via cable_IO_vars_module (%nap,cstart,cend,ilon,ilat) @@ -1304,8 +1334,8 @@ SUBROUTINE write_default_params(met, air, ssnow, veg, bgc, & END IF END IF - patch(landpt(e)%cstart:landpt(e)%cend)%longitude = longitude(e) - patch(landpt(e)%cstart:landpt(e)%cend)%latitude = latitude(e) + patch(landpt(e)%cstart:landpt(e)%cend)%longitude = longitude(to_land_index_global(e)) + patch(landpt(e)%cstart:landpt(e)%cend)%latitude = latitude(to_land_index_global(e)) soil%isoilm(landpt(e)%cstart:landpt(e)%cend) = & inSoil(landpt(e)%ilon, landpt(e)%ilat) ! Set initial soil temperature and moisture according to starting month @@ -1467,12 +1497,12 @@ SUBROUTINE write_default_params(met, air, ssnow, veg, bgc, & IF(ASSOCIATED(vegtype_metfile)) THEN ! i.e. iveg found in the met file ! Overwrite iveg for those patches available in met file, ! which are currently set to def values above: - veg%iveg(landpt(e)%cstart:landpt(e)%cstart + nmetpatches - 1) = & - vegtype_metfile(e, :) + veg%iveg(landpt(e)%cstart:landpt(e)%cstart + nmetpatches - 1) = & + vegtype_metfile(to_land_index_global(e), :) IF(exists%patch) & - patch(landpt(e)%cstart:landpt(e)%cstart)%frac = & - vegpatch_metfile(e,landpt(e)%cstart:landpt(e)%cstart ) + patch(landpt(e)%cstart:landpt(e)%cstart)%frac = & + vegpatch_metfile(to_land_index_global(e), landpt(e)%cstart:landpt(e)%cstart) ! In case gridinfo file provides more patches than met file(BP may08) DO f = nmetpatches+1, landpt(e)%nap @@ -1486,7 +1516,7 @@ SUBROUTINE write_default_params(met, air, ssnow, veg, bgc, & ! Similarly, if user defined soil types are present then use them: IF(ASSOCIATED(soiltype_metfile)) THEN ! i.e. isoil found in the met file soil%isoilm(landpt(e)%cstart:landpt(e)%cstart + nmetpatches - 1) = & - soiltype_metfile(e, :) + soiltype_metfile(to_land_index_global(e), :) END IF ! offline only above !call veg% init that is common @@ -1535,9 +1565,9 @@ SUBROUTINE write_default_params(met, air, ssnow, veg, bgc, & soil%GWwatr(h) = 0.01 END IF - rad%latitude(h) = latitude(e) + rad%latitude(h) = latitude(to_land_index_global(e)) !IF(hide%Ticket49Bug4) & - rad%longitude(h) = longitude(e) + rad%longitude(h) = longitude(to_land_index_global(e)) !jhan:is this done online? YES veg%ejmax(h) = 2.0 * veg%vcmax(h) END DO ! over each veg patch in land point @@ -1546,9 +1576,9 @@ SUBROUTINE write_default_params(met, air, ssnow, veg, bgc, & ! check tgg and alb IF(ANY(ssnow%tgg > 350.0) .OR. ANY(ssnow%tgg < 180.0)) & - CALL abort('Soil temps nuts') + CALL cable_abort('Soil temps nuts') IF(ANY(ssnow%albsoilsn > 1.0) .OR. ANY(ssnow%albsoilsn < 0.0)) & - CALL abort('Albedo nuts') + CALL cable_abort('Albedo nuts') WRITE(logn, *) @@ -2360,7 +2390,7 @@ SUBROUTINE check_parameter_values(soil, veg, ssnow) WRITE(*, *) 'Land point number:', i WRITE(*, *) 'Veg types:', veg%iveg(landpt(i)%cstart: & (landpt(i)%cstart + landpt(i)%nap - 1)) - CALL abort('Unknown vegetation type! Aborting.') + CALL cable_abort('Unknown vegetation type! Aborting.') END IF ! Check all soil types make sense: IF(ANY(soil%isoilm(landpt(i)%cstart:(landpt(i)%cstart + landpt(i)%nap & @@ -2368,7 +2398,7 @@ SUBROUTINE check_parameter_values(soil, veg, ssnow) + landpt(i)%nap - 1)) > mstype)) THEN WRITE(*,*) 'SUBROUTINE load_parameters:' WRITE(*,*) 'Land point number:',i - CALL abort('Unknown soil type! Aborting.') + CALL cable_abort('Unknown soil type! Aborting.') END IF ! Check patch fractions sum to 1 in each grid cell: IF((SUM(patch(landpt(i)%cstart:landpt(i)%cend)%frac) - 1.0) & @@ -2384,14 +2414,14 @@ SUBROUTINE check_parameter_values(soil, veg, ssnow) patch(landpt(i)%cstart:landpt(i)%cend)%longitude WRITE(*,*) 'patch latitudes are: ', & patch(landpt(i)%cstart:landpt(i)%cend)%latitude - CALL abort ('Sum of fractional coverage of vegetation patches /= 1!') + CALL cable_abort ('Sum of fractional coverage of vegetation patches /= 1!') END IF ! ! Check sum of surface type fractions is 1: ! IF(landpt(i)%veg%frac + landpt(i)%urban%frac + & ! landpt(i)%lake%frac + landpt(i)%ice%frac /= 1) THEN ! WRITE(*,*) 'SUBROUTINE load_parameters:' ! WRITE(*,*) 'At land point number', i - ! CALL abort ('Sum of fractional coverage of surface types /= 1!') + ! CALL cable_abort ('Sum of fractional coverage of surface types /= 1!') ! END IF END DO ! Check sand+soil+clay fractions sum to 1: @@ -2444,7 +2474,7 @@ SUBROUTINE check_parameter_values(soil, veg, ssnow) soil%ssat(landpt(i)%cstart + j - 1)) THEN WRITE(*, *) 'SUBROUTINE load_parameters:' WRITE(*, *) 'At land point number', i, 'patch:', j - CALL abort ('Wilting pt < field capacity < saturation '// & + CALL cable_abort ('Wilting pt < field capacity < saturation '// & 'violated!') END IF END DO diff --git a/src/offline/cable_read.F90 b/src/offline/cable_read.F90 index 23553be06..3bf5bcc00 100644 --- a/src/offline/cable_read.F90 +++ b/src/offline/cable_read.F90 @@ -133,7 +133,7 @@ SUBROUTINE readpar_i(ncid, parname, completeSet, var_i, filename, & END DO DEALLOCATE(tmp2i) ELSE - CALL abort('Dimension of '//parname//' parameter in '// & + CALL cable_abort('Dimension of '//parname//' parameter in '// & TRIM(filename)//' unknown.') END IF ELSE IF(metGrid == 'mask') THEN ! Get data from land/sea mask type grid: @@ -165,7 +165,7 @@ SUBROUTINE readpar_i(ncid, parname, completeSet, var_i, filename, & END DO DEALLOCATE(tmp3i) ELSE - CALL abort('Dimension of '//parname//' parameter in met file '// & + CALL cable_abort('Dimension of '//parname//' parameter in met file '// & 'unknown.') END IF END IF ! gridtype land or mask @@ -246,7 +246,7 @@ SUBROUTINE readpar_r(ncid, parname, completeSet, var_r, filename, & END DO DEALLOCATE(tmp2r) ELSE - CALL abort('Dimension of '//parname// & + CALL cable_abort('Dimension of '//parname// & ' parameter in met file unknown.') END IF ELSE IF(metGrid == 'mask') THEN ! Get data from land/sea mask type @@ -279,7 +279,7 @@ SUBROUTINE readpar_r(ncid, parname, completeSet, var_r, filename, & END DO DEALLOCATE(tmp3r) ELSE - CALL abort('Dimension of '//parname// & + CALL cable_abort('Dimension of '//parname// & ' parameter in met file unknown.') END IF END IF ! gridtype land or mask @@ -305,7 +305,7 @@ SUBROUTINE readpar_r(ncid, parname, completeSet, var_r, filename, & (ok,'Error reading '//parname//' in file ' & //TRIM(filename)//' (SUBROUTINE readpar_r)') ELSE - CALL abort('Parameter or initial state '//parname// & + CALL cable_abort('Parameter or initial state '//parname// & ' called with unknown dimension switch - '//dimswitch// & ' - in INTERFACE readpar') END IF ! dimension of parameter i.e. is this zse or ratecp or ratecs @@ -401,7 +401,7 @@ SUBROUTINE readpar_rd(ncid, parname, completeSet, var_rd, filename, & END DO DEALLOCATE(tmp2r) ELSE - CALL abort('Dimension of '//parname// & + CALL cable_abort('Dimension of '//parname// & ' parameter in met file unknown.') END IF ELSE IF(metGrid == 'mask') THEN ! Get data from land/sea mask type @@ -438,11 +438,11 @@ SUBROUTINE readpar_rd(ncid, parname, completeSet, var_rd, filename, & END DO DEALLOCATE(tmp3r) ELSE - CALL abort('Dimension of '//parname// & + CALL cable_abort('Dimension of '//parname// & ' parameter in met file unknown.') END IF ELSE - CALL abort('Prescribed input grid '//metGrid//' unknown.') + CALL cable_abort('Prescribed input grid '//metGrid//' unknown.') END IF ! gridtype land or mask ELSE IF(dimswitch(1:2) == 'ms') THEN ! ie par has only soil dimension, @@ -476,7 +476,7 @@ SUBROUTINE readpar_rd(ncid, parname, completeSet, var_rd, filename, & var_rd(i) = REAL(data1r(1), r_2) END DO ELSE - CALL abort('Parameter or initial state '//parname// & + CALL cable_abort('Parameter or initial state '//parname// & ' called with unknown dimension switch - '//dimswitch// & ' - in INTERFACE readpar') END IF ! dimension of parameter i.e. is this zse or ratecp or ratecs @@ -532,7 +532,7 @@ SUBROUTINE readpar_r2(ncid, parname, completeSet, var_r2, filename, & ELSE IF(dimswitch == 'ncs') THEN dimctr = ncs ! i.e. horizontal spatial and soil carbon pools ELSE - CALL abort('Parameter or initial state '//parname// & + CALL cable_abort('Parameter or initial state '//parname// & ' called with unknown dimension switch - '//dimswitch// & ' - in INTERFACE readpar SUBROUTINE readpar_r2') END IF @@ -581,7 +581,7 @@ SUBROUTINE readpar_r2(ncid, parname, completeSet, var_r2, filename, & END DO DEALLOCATE(tmp3r) ELSE - CALL abort('Dimension of '//parname//' parameter in met file '// & + CALL cable_abort('Dimension of '//parname//' parameter in met file '// & 'unknown.') END IF ELSEIF(metGrid == 'mask') THEN ! Get data from land/sea mask type grid: @@ -644,7 +644,7 @@ SUBROUTINE readpar_r2(ncid, parname, completeSet, var_r2, filename, & END IF END IF ELSE - CALL abort('Dimension of '//parname//' parameter in met file '// & + CALL cable_abort('Dimension of '//parname//' parameter in met file '// & 'unknown.') END IF END IF ! gridtype land or mask @@ -701,7 +701,7 @@ SUBROUTINE readpar_r2d(ncid, parname, completeSet, var_r2d, filename, & ELSE IF(dimswitch(1:3) == 'ncs') THEN dimctr = ncs ! i.e. horizontal spatial and soil carbon pools ELSE - CALL abort('Parameter or initial state '//parname// & + CALL cable_abort('Parameter or initial state '//parname// & ' called with unknown dimension switch - '//dimswitch// & ' - in INTERFACE readpar') END IF @@ -775,7 +775,7 @@ SUBROUTINE readpar_r2d(ncid, parname, completeSet, var_r2d, filename, & END DO DEALLOCATE(tmp3r) ELSE - CALL abort('Dimension of '//parname//' parameter in met file'// & + CALL cable_abort('Dimension of '//parname//' parameter in met file'// & 'unknown.') END IF ELSEIF(metGrid == 'mask') THEN ! Get data from land/sea mask type grid: @@ -817,7 +817,7 @@ SUBROUTINE readpar_r2d(ncid, parname, completeSet, var_r2d, filename, & END DO DEALLOCATE(tmp4r) ELSE - CALL abort('Dimension of '//parname//' parameter in met file'// & + CALL cable_abort('Dimension of '//parname//' parameter in met file'// & 'unknown.') END IF END IF ! gridtype land or mask diff --git a/src/offline/cable_serial.F90 b/src/offline/cable_serial.F90 index 366aa58de..14aa29449 100644 --- a/src/offline/cable_serial.F90 +++ b/src/offline/cable_serial.F90 @@ -78,12 +78,15 @@ MODULE cable_serial prepareFiles_princeton, & LUCdriver, & compare_consistency_check_values + USE cable_mpi_mod, ONLY: mpi_grp_t USE cable_def_types_mod USE cable_IO_vars_module, ONLY: logn,gswpfile,ncciy,leaps, & fixedCO2,output,check,& patch_type,landpt,& defaultLAI, sdoy, smoy, syear, timeunits, calendar, & NO_CHECK + USE cable_io_decomp_mod, ONLY: io_decomp_t + USE cable_io_decomp_mod, ONLY: cable_io_decomp_init USE casa_ncdf_module, ONLY: is_casa_time USE cable_common_module, ONLY: ktau_gl, kend_gl, knode_gl, cable_user, & filename, myhome, & @@ -157,7 +160,7 @@ MODULE cable_serial CONTAINS -SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site) +SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site, mpi_grp) !! Offline serial driver. INTEGER, INTENT(IN) :: NRRRR !! Number of repeated spin-up cycles REAL, INTENT(INOUT) :: dels !! Time step size in seconds @@ -167,6 +170,7 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site) TYPE(PLUME_MIP_TYPE), INTENT(IN) :: PLUME TYPE(CRU_TYPE), INTENT(IN) :: CRU TYPE (site_TYPE), INTENT(IN) :: site + TYPE(mpi_grp_t), INTENT(IN) :: mpi_grp ! timing variables INTEGER, PARAMETER :: kstart = 1 ! start of simulation @@ -268,6 +272,7 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site) integer, dimension(:), allocatable, save :: cstart,cend,nap real(r_2), dimension(:,:,:), allocatable, save :: patchfrac_new + type(io_decomp_t) :: io_decomp ! END header ! INISTUFF @@ -392,7 +397,7 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site) bal, logn, vegparmnew, casabiome, casapool, & casaflux, sum_casapool, sum_casaflux, & casamet, casabal, phen, POP, spinup, & - CEMSOIL, CTFRZ, LUC_EXPT, POPLUC ) + CEMSOIL, CTFRZ, LUC_EXPT, POPLUC, mpi_grp) IF (check%ranges /= NO_CHECK) THEN WRITE (*, *) "Checking parameter ranges" @@ -455,7 +460,7 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site) ENDIF - + call cable_io_decomp_init(io_decomp) ENDIF ! CALL 1 diff --git a/src/offline/cable_write.F90 b/src/offline/cable_write.F90 index 56a1fb4e8..81dc84bec 100644 --- a/src/offline/cable_write.F90 +++ b/src/offline/cable_write.F90 @@ -45,7 +45,7 @@ MODULE cable_write_module - USE cable_abort_module, ONLY: nc_abort, abort + USE cable_abort_module, ONLY: nc_abort, cable_abort USE cable_def_types_mod USE cable_IO_vars_module, ONLY: landpt, patch, max_vegpatches, parID_type, & metGrid, land_x, land_y, logn, output, & @@ -257,7 +257,7 @@ SUBROUTINE define_output_variable_r1(ncid, varID, vname, & IF( .NOT. ASSOCIATED(otmp2lt)) ALLOCATE(otmp2lt(mland, 1)) END IF ELSE - CALL abort('Unknown grid specification (INTERFACE define_ovar)') + CALL cable_abort('Unknown grid specification (INTERFACE define_ovar)') END IF ! Define variable units: ok = NF90_PUT_ATT(ncid, varID, 'units', vunits) @@ -340,7 +340,7 @@ SUBROUTINE define_output_variable_r2(ncid, varID, vname, vunits, longname, & IF( .NOT. ASSOCIATED(otmp5xypsct)) & ALLOCATE(otmp5xypsct(xdimsize, ydimsize, max_vegpatches, ncs, 1)) ELSE - CALL abort('Variable '//vname// & + CALL cable_abort('Variable '//vname// & ' defined with unknown dimension switch - '//dimswitch// & ' - in SUBROUTINE define_output_variable_r2') END IF @@ -378,7 +378,7 @@ SUBROUTINE define_output_variable_r2(ncid, varID, vname, vunits, longname, & IF( .NOT. ASSOCIATED(otmp4xysct)) & ALLOCATE(otmp4xysct(xdimsize, ydimsize, ncs, 1)) ELSE - CALL abort('Variable '//vname// & + CALL cable_abort('Variable '//vname// & ' defined with unknown dimension switch - '//dimswitch// & ' - in SUBROUTINE define_output_variable_r2') END IF @@ -424,7 +424,7 @@ SUBROUTINE define_output_variable_r2(ncid, varID, vname, vunits, longname, & IF( .NOT. ASSOCIATED(otmp4xysct)) & ALLOCATE(otmp4xysct(mland, max_vegpatches, ncs, 1)) ELSE - CALL abort('Variable '//vname// & + CALL cable_abort('Variable '//vname// & ' defined with unknown dimension switch - '//dimswitch// & ' - in SUBROUTINE define_output_variable_r2') END IF @@ -457,13 +457,13 @@ SUBROUTINE define_output_variable_r2(ncid, varID, vname, vunits, longname, & ! of this dim: IF( .NOT. ASSOCIATED(otmp3lsct)) ALLOCATE(otmp3lsct(mland, ncs, 1)) ELSE - CALL abort('Variable '//vname// & + CALL cable_abort('Variable '//vname// & ' defined with unknown dimension switch - '//dimswitch// & ' - in SUBROUTINE define_output_variable_r2') END IF END IF ELSE - CALL abort('Unknown grid specification (SUBROUTINE '// & + CALL cable_abort('Unknown grid specification (SUBROUTINE '// & 'define_output_variable_r2)') END IF ! Define variable units: @@ -589,7 +589,7 @@ SUBROUTINE define_output_parameter_r1(ncid, parID, pname, punits, longname, & IF(.NOT. ASSOCIATED(otmp1l)) ALLOCATE(otmp1l(mland)) END IF ELSE - CALL abort('Unknown grid specification '// & + CALL cable_abort('Unknown grid specification '// & '(SUBROUTINE define_output_parameter_r1)') END IF ! Define variable units: @@ -777,7 +777,7 @@ SUBROUTINE define_output_parameter_r2(ncid, parID, pname, punits, longname, & END IF END IF ELSE - CALL abort('Unknown grid specification '// & + CALL cable_abort('Unknown grid specification '// & '(SUBROUTINE define_output_parameter_r2)') END IF ! Define variable units: @@ -917,7 +917,7 @@ SUBROUTINE write_output_variable_r1(ktau, ncid, varID, vname, var_r1, & start = (/1, ktau/), count = (/mland, 1/)) ! write data to file END IF ELSE - CALL abort('Unknown grid specification '// & + CALL cable_abort('Unknown grid specification '// & '(SUBROUTINE write_output_variable_r1)') END IF ! Check writing was successful: @@ -1051,7 +1051,7 @@ SUBROUTINE write_output_variable_r2(ktau, ncid, varID, vname, var_r2, & start = (/1, 1, 1, 1, ktau/), & count = (/xdimsize, ydimsize, max_vegpatches, ncs, 1/)) ELSE - CALL abort('Variable '//vname// & + CALL cable_abort('Variable '//vname// & ' defined with unknown dimension switch - '//dimswitch// & ' - in INTERFACE write_ovar') END IF @@ -1142,7 +1142,7 @@ SUBROUTINE write_output_variable_r2(ktau, ncid, varID, vname, var_r2, & start = (/1, 1, 1, ktau/), & count = (/xdimsize, ydimsize, ncs, 1/)) ! write data to file ELSE - CALL abort('Variable '//vname// & + CALL cable_abort('Variable '//vname// & ' defined with unknown dimension switch - '//dimswitch// & ' - in INTERFACE write_ovar') END IF @@ -1221,7 +1221,7 @@ SUBROUTINE write_output_variable_r2(ktau, ncid, varID, vname, var_r2, & start = (/1, 1, 1, ktau/), & count = (/mland, max_vegpatches, ncs, 1/)) ELSE - CALL abort('Variable '//vname// & + CALL cable_abort('Variable '//vname// & ' defined with unknown dimension switch - '//dimswitch// & ' - in INTERFACE write_ovar') END IF @@ -1291,13 +1291,13 @@ SUBROUTINE write_output_variable_r2(ktau, ncid, varID, vname, var_r2, & start = (/1, 1, ktau/), & count = (/mland, ncs, 1/)) ! write data to file ELSE - CALL abort('Variable '//vname// & + CALL cable_abort('Variable '//vname// & ' defined with unknown dimension switch - '//dimswitch// & ' - in SUBROUTINE write_output_variable_r2') END IF END IF ! patch info or no patch info ELSE - CALL abort('Unknown grid specification '// & + CALL cable_abort('Unknown grid specification '// & '(SUBROUTINE write_output_variable_r2)') END IF ! grid type @@ -1437,7 +1437,7 @@ SUBROUTINE write_output_parameter_r1(ncid, parID, pname, par_r1, & END IF ! If writing restart END IF ! If writing with a patch dimension in output file ELSE - CALL abort('Unknown grid specification '// & + CALL cable_abort('Unknown grid specification '// & '(SUBROUTINE write_output_parameter_r1)') END IF ! mask x-y or land-only grid ! Check writing was successful: @@ -1592,7 +1592,7 @@ SUBROUTINE write_output_parameter_r2(ncid, parID, pname, par_r2, & start = (/1, 1, 1, 1/), & count = (/xdimsize, ydimsize, max_vegpatches, nrb/)) ELSE - CALL abort('Parameter '//pname// & + CALL cable_abort('Parameter '//pname// & ' defined with unknown dimension switch - '//dimswitch// & ' - in INTERFACE write_ovar') END IF @@ -1659,7 +1659,7 @@ SUBROUTINE write_output_parameter_r2(ncid, parID, pname, par_r2, & start = (/1, 1, 1/), & count = (/xdimsize, ydimsize, 4/)) ! write data to file ELSE - CALL abort('Parameter '//pname// & + CALL cable_abort('Parameter '//pname// & ' defined with unknown dimension switch - '//dimswitch// & ' - in SUBROUTINE write_output_parameter_r2') END IF @@ -1733,7 +1733,7 @@ SUBROUTINE write_output_parameter_r2(ncid, parID, pname, par_r2, & ok = NF90_PUT_VAR(ncid, parID, REAL(otmp3lpsn(:, :, :), 4), & start = (/1, 1, 1/), count = (/mland, max_vegpatches, msn/)) ELSE - CALL abort('Parameter '//pname// & + CALL cable_abort('Parameter '//pname// & ' defined with unknown dimension switch - '//dimswitch// & ' - in SUBROUTINE write_output_parameter_r2') END IF @@ -1813,13 +1813,13 @@ SUBROUTINE write_output_parameter_r2(ncid, parID, pname, par_r2, & ok = NF90_PUT_VAR(ncid, parID, REAL(otmp2lsf, 4), & start = (/1, 1/), count = (/mland, 4/)) ! write data to file ELSE - CALL abort('Parameter '//pname// & + CALL cable_abort('Parameter '//pname// & ' defined with unknown dimension switch - '//dimswitch// & ' - in SUBROUTINE write_output_parameter_r2') END IF END IF ELSE - CALL abort('Unknown grid specification '// & + CALL cable_abort('Unknown grid specification '// & '(SUBROUTINE write_output_parameter_r2)') END IF ! Check writing was successful: @@ -1866,7 +1866,7 @@ SUBROUTINE write_output_parameter_r2d(ncid, parID, pname, par_r2d, & DEALLOCATE(tmpout) END IF ELSE - CALL abort('Parameter '//pname// & + CALL cable_abort('Parameter '//pname// & ' defined with unknown dimension switch - '//dimswitch// & ' - in SUBROUTINE write_output_parameter_r2d') END IF diff --git a/src/science/landuse/landuse3.F90 b/src/science/landuse/landuse3.F90 index faccd6a58..589d498e1 100644 --- a/src/science/landuse/landuse3.F90 +++ b/src/science/landuse/landuse3.F90 @@ -736,7 +736,7 @@ subroutine landuse_driver(mlon,mlat,landmask,arealand,ssnow,soil,veg,bal,canopy, cstart,cend,nap,lucmp) !! Main driver for the land-use change ! - USE cable_IO_vars_module, ONLY: mask,patch,landpt, latitude, longitude + USE cable_IO_vars_module, ONLY: mask,patch,landpt, latitude, longitude, to_land_index_global USE cable_def_types_mod, ONLY: mp,mvtype,mstype,mland,r_2,ms,msn,nrb,ncp,ncs, & soil_parameter_type, soil_snow_type, veg_parameter_type, & balances_type, canopy_type, bgc_pool_type, radiation_type @@ -951,8 +951,8 @@ subroutine landuse_driver(mlon,mlat,landmask,arealand,ssnow,soil,veg,bal,canopy, ! assign lucmp%lat lucmp%lon do p=1,mland do q=cstart(p),cend(p) - lucmp%lat(q) = latitude(p) - lucmp%lon(q) = longitude(p) + lucmp%lat(q) = latitude(to_land_index_global(p)) + lucmp%lon(q) = longitude(to_land_index_global(p)) enddo enddo diff --git a/src/util/cable_array_utils.F90 b/src/util/cable_array_utils.F90 new file mode 100644 index 000000000..c67c46a98 --- /dev/null +++ b/src/util/cable_array_utils.F90 @@ -0,0 +1,54 @@ +module cable_array_utils_mod + implicit none + +contains + + function array_offset(index, shape) result(offset) + integer, intent(in) :: index(:), shape(:) + integer :: i, offset, shape_factor + offset = 1 + shape_factor = 1 + do i = 1, size(index) + offset = offset + (index(i) - 1) * shape_factor + shape_factor = shape_factor * shape(i) + end do + end function + + subroutine array_index(offset_in, shape, index) + integer, intent(in) :: offset_in, shape(:) + integer, intent(inout) :: index(:) + integer :: i, offset + offset = offset_in + do i = 1, size(shape) + index(i) = mod(offset - 1, shape(i)) + 1 + offset = (offset - 1) / shape(i) + 1 + end do + end subroutine + + subroutine array_partition(n, k, p, start, count) + !* Compute start and count for the p'th partition of an array of size n + ! where p = 0, 1, ... , k - 1. + ! + ! For k partitions, an array of n elements can be partitioned into r + ! partitions of length q + 1, and k - r partitions of length q where q and r + ! are the quotient and remainder of n divided by k (i.e. n = q * k + r). + ! Note, we assume that the r partitions of length q + 1 precede the k - r + ! partitions of length q in the array. + integer, intent(in) :: n, k, p + integer, intent(out) :: start, count + integer :: q, r + + q = n / k + r = mod(n, k) + + if (p < r) then + count = q + 1 + start = 1 + (q + 1) * p + else + count = q + start = 1 + (q + 1) * r + q * (p - r) + end if + + end subroutine array_partition + +end module cable_array_utils_mod \ No newline at end of file diff --git a/src/util/cable_runtime_opts_mod.F90 b/src/util/cable_runtime_opts_mod.F90 index 8719cbc06..ef8d4480d 100644 --- a/src/util/cable_runtime_opts_mod.F90 +++ b/src/util/cable_runtime_opts_mod.F90 @@ -120,6 +120,8 @@ MODULE cable_runtime_opts_mod ! #338 https://github.com/CABLE-LSM/CABLE/issues/338 LOGICAL :: l_ice_consistency = .FALSE. + LOGICAL :: mpi_legacy = .TRUE. !! Enable the legacy MPI implementation of CABLE + END TYPE kbl_user_switches ! instantiate internal switches diff --git a/src/util/netcdf/cable_netcdf.F90 b/src/util/netcdf/cable_netcdf.F90 new file mode 100644 index 000000000..086c9c307 --- /dev/null +++ b/src/util/netcdf/cable_netcdf.F90 @@ -0,0 +1,653 @@ +module cable_netcdf_mod + use iso_fortran_env, only: CABLE_NETCDF_INT32_KIND => int32 + use iso_fortran_env, only: CABLE_NETCDF_REAL32_KIND => real32 + use iso_fortran_env, only: CABLE_NETCDF_REAL64_KIND => real64 + use cable_mpi_mod, only: mpi_grp_t + implicit none + + private + + public :: & + cable_netcdf_decomp_t, & + cable_netcdf_file_t, & + cable_netcdf_io_t + + public :: & + cable_netcdf_mod_init, & + cable_netcdf_mod_end, & + cable_netcdf_create_file, & + cable_netcdf_open_file, & + cable_netcdf_create_decomp + + public :: & + CABLE_NETCDF_INT32_KIND, & + CABLE_NETCDF_REAL32_KIND, & + CABLE_NETCDF_REAL64_KIND, & + CABLE_NETCDF_INT, & + CABLE_NETCDF_FLOAT, & + CABLE_NETCDF_DOUBLE, & + CABLE_NETCDF_MAX_STR_LEN_FILE, & + CABLE_NETCDF_MAX_STR_LEN_VAR, & + CABLE_NETCDF_MAX_STR_LEN_DIM, & + CABLE_NETCDF_MAX_RANK, & + CABLE_NETCDF_UNLIMITED + + enum, bind(c) + enumerator :: & + CABLE_NETCDF_INT, & + CABLE_NETCDF_FLOAT, & + CABLE_NETCDF_DOUBLE + end enum + + integer, parameter :: CABLE_NETCDF_MAX_STR_LEN_FILE = 200 + integer, parameter :: CABLE_NETCDF_MAX_STR_LEN_VAR = 80 + integer, parameter :: CABLE_NETCDF_MAX_STR_LEN_DIM = 20 + integer, parameter :: CABLE_NETCDF_UNLIMITED = -1 + integer, parameter :: CABLE_NETCDF_MAX_RANK = 3 + + type :: cable_netcdf_decomp_t + integer, allocatable :: compmap(:) + integer, allocatable :: dims(:) + integer :: type + end type + + type, abstract :: cable_netcdf_file_t + contains + procedure(cable_netcdf_file_close), deferred :: close + procedure(cable_netcdf_file_end_def), deferred :: end_def + procedure(cable_netcdf_file_sync), deferred :: sync + procedure(cable_netcdf_file_def_dims), deferred :: def_dims + procedure(cable_netcdf_file_def_var), deferred :: def_var + procedure(cable_netcdf_file_put_att_global_string), deferred :: put_att_global_string + procedure(cable_netcdf_file_put_att_global_int32), deferred :: put_att_global_int32 + procedure(cable_netcdf_file_put_att_global_real32), deferred :: put_att_global_real32 + procedure(cable_netcdf_file_put_att_global_real64), deferred :: put_att_global_real64 + procedure(cable_netcdf_file_put_att_var_string), deferred :: put_att_var_string + procedure(cable_netcdf_file_put_att_var_int32), deferred :: put_att_var_int32 + procedure(cable_netcdf_file_put_att_var_real32), deferred :: put_att_var_real32 + procedure(cable_netcdf_file_put_att_var_real64), deferred :: put_att_var_real64 + generic :: put_att => & + put_att_global_string, put_att_global_int32, put_att_global_real32, put_att_global_real64, & + put_att_var_string, put_att_var_int32, put_att_var_real32, put_att_var_real64 + procedure(cable_netcdf_file_get_att_global_string), deferred :: get_att_global_string + procedure(cable_netcdf_file_get_att_global_int32), deferred :: get_att_global_int32 + procedure(cable_netcdf_file_get_att_global_real32), deferred :: get_att_global_real32 + procedure(cable_netcdf_file_get_att_global_real64), deferred :: get_att_global_real64 + procedure(cable_netcdf_file_get_att_var_string), deferred :: get_att_var_string + procedure(cable_netcdf_file_get_att_var_int32), deferred :: get_att_var_int32 + procedure(cable_netcdf_file_get_att_var_real32), deferred :: get_att_var_real32 + procedure(cable_netcdf_file_get_att_var_real64), deferred :: get_att_var_real64 + generic :: get_att => & + get_att_global_string, get_att_global_int32, get_att_global_real32, get_att_global_real64, & + get_att_var_string, get_att_var_int32, get_att_var_real32, get_att_var_real64 + procedure(cable_netcdf_file_inq_dim_len), deferred :: inq_dim_len + procedure(cable_netcdf_file_put_var_int32_0d), deferred :: put_var_int32_0d + procedure(cable_netcdf_file_put_var_int32_1d), deferred :: put_var_int32_1d + procedure(cable_netcdf_file_put_var_int32_2d), deferred :: put_var_int32_2d + procedure(cable_netcdf_file_put_var_int32_3d), deferred :: put_var_int32_3d + procedure(cable_netcdf_file_put_var_real32_0d), deferred :: put_var_real32_0d + procedure(cable_netcdf_file_put_var_real32_1d), deferred :: put_var_real32_1d + procedure(cable_netcdf_file_put_var_real32_2d), deferred :: put_var_real32_2d + procedure(cable_netcdf_file_put_var_real32_3d), deferred :: put_var_real32_3d + procedure(cable_netcdf_file_put_var_real64_0d), deferred :: put_var_real64_0d + procedure(cable_netcdf_file_put_var_real64_1d), deferred :: put_var_real64_1d + procedure(cable_netcdf_file_put_var_real64_2d), deferred :: put_var_real64_2d + procedure(cable_netcdf_file_put_var_real64_3d), deferred :: put_var_real64_3d + generic :: put_var => & + put_var_int32_0d, put_var_int32_1d, put_var_int32_2d, put_var_int32_3d, & + put_var_real32_0d, put_var_real32_1d, put_var_real32_2d, put_var_real32_3d, & + put_var_real64_0d, put_var_real64_1d, put_var_real64_2d, put_var_real64_3d + procedure(cable_netcdf_file_write_darray_int32_1d), deferred :: write_darray_int32_1d + procedure(cable_netcdf_file_write_darray_int32_2d), deferred :: write_darray_int32_2d + procedure(cable_netcdf_file_write_darray_int32_3d), deferred :: write_darray_int32_3d + procedure(cable_netcdf_file_write_darray_real32_1d), deferred :: write_darray_real32_1d + procedure(cable_netcdf_file_write_darray_real32_2d), deferred :: write_darray_real32_2d + procedure(cable_netcdf_file_write_darray_real32_3d), deferred :: write_darray_real32_3d + procedure(cable_netcdf_file_write_darray_real64_1d), deferred :: write_darray_real64_1d + procedure(cable_netcdf_file_write_darray_real64_2d), deferred :: write_darray_real64_2d + procedure(cable_netcdf_file_write_darray_real64_3d), deferred :: write_darray_real64_3d + generic :: write_darray => & + write_darray_int32_1d, write_darray_int32_2d, write_darray_int32_3d, & + write_darray_real32_1d, write_darray_real32_2d, write_darray_real32_3d, & + write_darray_real64_1d, write_darray_real64_2d, write_darray_real64_3d + procedure(cable_netcdf_file_get_var_int32_0d), deferred :: get_var_int32_0d + procedure(cable_netcdf_file_get_var_int32_1d), deferred :: get_var_int32_1d + procedure(cable_netcdf_file_get_var_int32_2d), deferred :: get_var_int32_2d + procedure(cable_netcdf_file_get_var_int32_3d), deferred :: get_var_int32_3d + procedure(cable_netcdf_file_get_var_real32_0d), deferred :: get_var_real32_0d + procedure(cable_netcdf_file_get_var_real32_1d), deferred :: get_var_real32_1d + procedure(cable_netcdf_file_get_var_real32_2d), deferred :: get_var_real32_2d + procedure(cable_netcdf_file_get_var_real32_3d), deferred :: get_var_real32_3d + procedure(cable_netcdf_file_get_var_real64_0d), deferred :: get_var_real64_0d + procedure(cable_netcdf_file_get_var_real64_1d), deferred :: get_var_real64_1d + procedure(cable_netcdf_file_get_var_real64_2d), deferred :: get_var_real64_2d + procedure(cable_netcdf_file_get_var_real64_3d), deferred :: get_var_real64_3d + generic :: get_var => & + get_var_int32_0d, get_var_int32_1d, get_var_int32_2d, get_var_int32_3d, & + get_var_real32_0d, get_var_real32_1d, get_var_real32_2d, get_var_real32_3d, & + get_var_real64_0d, get_var_real64_1d, get_var_real64_2d, get_var_real64_3d + procedure(cable_netcdf_file_read_darray_int32_1d), deferred :: read_darray_int32_1d + procedure(cable_netcdf_file_read_darray_int32_2d), deferred :: read_darray_int32_2d + procedure(cable_netcdf_file_read_darray_int32_3d), deferred :: read_darray_int32_3d + procedure(cable_netcdf_file_read_darray_real32_1d), deferred :: read_darray_real32_1d + procedure(cable_netcdf_file_read_darray_real32_2d), deferred :: read_darray_real32_2d + procedure(cable_netcdf_file_read_darray_real32_3d), deferred :: read_darray_real32_3d + procedure(cable_netcdf_file_read_darray_real64_1d), deferred :: read_darray_real64_1d + procedure(cable_netcdf_file_read_darray_real64_2d), deferred :: read_darray_real64_2d + procedure(cable_netcdf_file_read_darray_real64_3d), deferred :: read_darray_real64_3d + generic :: read_darray => & + read_darray_int32_1d, read_darray_int32_2d, read_darray_int32_3d, & + read_darray_real32_1d, read_darray_real32_2d, read_darray_real32_3d, & + read_darray_real64_1d, read_darray_real64_2d, read_darray_real64_3d + end type + + abstract interface + subroutine cable_netcdf_file_close(this) + import cable_netcdf_file_t + class(cable_netcdf_file_t), intent(inout) :: this + end subroutine + subroutine cable_netcdf_file_end_def(this) + import cable_netcdf_file_t + class(cable_netcdf_file_t), intent(inout) :: this + end subroutine + subroutine cable_netcdf_file_sync(this) + import cable_netcdf_file_t + class(cable_netcdf_file_t), intent(inout) :: this + end subroutine + subroutine cable_netcdf_file_def_dims(this, dim_names, dim_lens) + import cable_netcdf_file_t + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: dim_names(:) + integer, intent(in) :: dim_lens(:) + end subroutine + subroutine cable_netcdf_file_def_var(this, var_name, dim_names, type) + import cable_netcdf_file_t + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, dim_names(:) + integer, intent(in) :: type + end subroutine + subroutine cable_netcdf_file_put_att_global_string(this, att_name, att_value) + import cable_netcdf_file_t + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name, att_value + end subroutine + subroutine cable_netcdf_file_put_att_global_int32(this, att_name, att_value) + import cable_netcdf_file_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: att_value + end subroutine + subroutine cable_netcdf_file_put_att_global_real32(this, att_name, att_value) + import cable_netcdf_file_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: att_value + end subroutine + subroutine cable_netcdf_file_put_att_global_real64(this, att_name, att_value) + import cable_netcdf_file_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: att_value + end subroutine + subroutine cable_netcdf_file_put_att_var_string(this, var_name, att_name, att_value) + import cable_netcdf_file_t + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name, att_value + end subroutine + subroutine cable_netcdf_file_put_att_var_int32(this, var_name, att_name, att_value) + import cable_netcdf_file_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: att_value + end subroutine + subroutine cable_netcdf_file_put_att_var_real32(this, var_name, att_name, att_value) + import cable_netcdf_file_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: att_value + end subroutine + subroutine cable_netcdf_file_put_att_var_real64(this, var_name, att_name, att_value) + import cable_netcdf_file_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: att_value + end subroutine + subroutine cable_netcdf_file_get_att_global_string(this, att_name, att_value) + import cable_netcdf_file_t + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + character(len=*), intent(out) :: att_value + end subroutine + subroutine cable_netcdf_file_get_att_global_int32(this, att_name, att_value) + import cable_netcdf_file_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: att_value + end subroutine + subroutine cable_netcdf_file_get_att_global_real32(this, att_name, att_value) + import cable_netcdf_file_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: att_value + end subroutine + subroutine cable_netcdf_file_get_att_global_real64(this, att_name, att_value) + import cable_netcdf_file_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: att_value + end subroutine + subroutine cable_netcdf_file_get_att_var_string(this, var_name, att_name, att_value) + import cable_netcdf_file_t + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + character(len=*), intent(out) :: att_value + end subroutine + subroutine cable_netcdf_file_get_att_var_int32(this, var_name, att_name, att_value) + import cable_netcdf_file_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: att_value + end subroutine + subroutine cable_netcdf_file_get_att_var_real32(this, var_name, att_name, att_value) + import cable_netcdf_file_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: att_value + end subroutine + subroutine cable_netcdf_file_get_att_var_real64(this, var_name, att_name, att_value) + import cable_netcdf_file_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: att_value + end subroutine + subroutine cable_netcdf_file_inq_dim_len(this, dim_name, dim_len) + import cable_netcdf_file_t + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: dim_name + integer, intent(out) :: dim_len + end subroutine + subroutine cable_netcdf_file_put_var_int32_0d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_put_var_int32_1d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_put_var_int32_2d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_put_var_int32_3d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_put_var_real32_0d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_put_var_real32_1d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_put_var_real32_2d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_put_var_real32_3d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_put_var_real64_0d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_put_var_real64_1d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_put_var_real64_2d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_put_var_real64_3d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_write_darray_int32_1d(this, var_name, values, decomp, fill_value, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_write_darray_int32_2d(this, var_name, values, decomp, fill_value, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_write_darray_int32_3d(this, var_name, values, decomp, fill_value, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_write_darray_real32_1d(this, var_name, values, decomp, fill_value, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_write_darray_real32_2d(this, var_name, values, decomp, fill_value, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_write_darray_real32_3d(this, var_name, values, decomp, fill_value, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_write_darray_real64_1d(this, var_name, values, decomp, fill_value, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_write_darray_real64_2d(this, var_name, values, decomp, fill_value, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_write_darray_real64_3d(this, var_name, values, decomp, fill_value, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_get_var_int32_0d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_get_var_int32_1d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_get_var_int32_2d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_get_var_int32_3d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_get_var_real32_0d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_get_var_real32_1d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_get_var_real32_2d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_get_var_real32_3d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_get_var_real64_0d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_get_var_real64_1d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_get_var_real64_2d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_get_var_real64_3d(this, var_name, values, start, count) + import cable_netcdf_file_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + subroutine cable_netcdf_file_read_darray_int32_1d(this, var_name, values, decomp, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_read_darray_int32_2d(this, var_name, values, decomp, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_read_darray_int32_3d(this, var_name, values, decomp, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_INT32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_read_darray_real32_1d(this, var_name, values, decomp, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_read_darray_real32_2d(this, var_name, values, decomp, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_read_darray_real32_3d(this, var_name, values, decomp, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_REAL32_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_read_darray_real64_1d(this, var_name, values, decomp, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_read_darray_real64_2d(this, var_name, values, decomp, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + end subroutine + subroutine cable_netcdf_file_read_darray_real64_3d(this, var_name, values, decomp, frame) + import cable_netcdf_file_t, cable_netcdf_decomp_t, CABLE_NETCDF_REAL64_KIND + class(cable_netcdf_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + end subroutine + end interface + + type, abstract :: cable_netcdf_io_t + contains + procedure(cable_netcdf_io_init), deferred :: init + procedure(cable_netcdf_io_finalise), deferred :: finalise + procedure(cable_netcdf_io_create_file), deferred :: create_file + procedure(cable_netcdf_io_open_file), deferred :: open_file + procedure(cable_netcdf_io_create_decomp), deferred :: create_decomp + end type + + abstract interface + subroutine cable_netcdf_io_init(this) + import cable_netcdf_io_t + class(cable_netcdf_io_t), intent(inout) :: this + end subroutine + subroutine cable_netcdf_io_finalise(this) + import cable_netcdf_io_t + class(cable_netcdf_io_t), intent(inout) :: this + end subroutine + function cable_netcdf_io_create_file(this, path) result(file) + import cable_netcdf_io_t, cable_netcdf_file_t + class(cable_netcdf_io_t), intent(inout) :: this + character(len=*), intent(in) :: path + class(cable_netcdf_file_t), allocatable :: file + end function + function cable_netcdf_io_open_file(this, path) result(file) + import cable_netcdf_io_t, cable_netcdf_file_t + class(cable_netcdf_io_t), intent(inout) :: this + character(len=*), intent(in) :: path + class(cable_netcdf_file_t), allocatable :: file + end function + function cable_netcdf_io_create_decomp(this, compmap, dims, type) result(decomp) + import cable_netcdf_io_t, cable_netcdf_decomp_t + class(cable_netcdf_io_t), intent(inout) :: this + integer, intent(in) :: compmap(:), dims(:) + integer, intent(in) :: type + class(cable_netcdf_decomp_t), allocatable :: decomp + end function + end interface + + interface + module subroutine cable_netcdf_mod_init(mpi_grp) + type(mpi_grp_t), intent(in) :: mpi_grp + end subroutine + module subroutine cable_netcdf_mod_end() + end subroutine + module function cable_netcdf_create_file(path) result(file) + character(len=*), intent(in) :: path + class(cable_netcdf_file_t), allocatable :: file + end function + module function cable_netcdf_open_file(path) result(file) + character(len=*), intent(in) :: path + class(cable_netcdf_file_t), allocatable :: file + end function + module function cable_netcdf_create_decomp(compmap, dims, type) result(decomp) + integer, intent(in) :: compmap(:), dims(:), type + class(cable_netcdf_decomp_t), allocatable :: decomp + end function + end interface + + class(cable_netcdf_io_t), allocatable :: cable_netcdf_io_handler + +end module cable_netcdf_mod diff --git a/src/util/netcdf/cable_netcdf_decomp_util.F90 b/src/util/netcdf/cable_netcdf_decomp_util.F90 new file mode 100644 index 000000000..55135a044 --- /dev/null +++ b/src/util/netcdf/cable_netcdf_decomp_util.F90 @@ -0,0 +1,253 @@ +module cable_netcdf_decomp_util_mod + use cable_netcdf_mod, only: cable_netcdf_decomp_t, cable_netcdf_create_decomp, CABLE_NETCDF_MAX_STR_LEN_DIM + use cable_array_utils_mod, only: array_index, array_offset + use cable_abort_module, only: cable_abort + implicit none + + private + + public & + io_decomp_land_to_x_y, & + io_decomp_patch_to_x_y_patch, & + io_decomp_land_to_land, & + io_decomp_patch_to_land_patch, & + io_decomp_patch_to_patch, & + dim_spec_t + + type dim_spec_t + character(CABLE_NETCDF_MAX_STR_LEN_DIM) :: name + integer :: size + end type + +contains + + integer function subscript(shape_spec, name) + type(dim_spec_t), intent(in) :: shape_spec(:) + character(*), intent(in) :: name + integer i + do i = 1, size(shape_spec) + if (shape_spec(i)%name == name) then + subscript = i + return + end if + end do + call cable_abort("Name '" // name // "' not found in shape_spec.", file=__FILE__, line=__LINE__) + subscript = -1 + end function + + integer function patch_land_index(cstart, nap, patch_index) + integer, intent(in) :: cstart(:), nap(:), patch_index + integer i + do i = 1, size(cstart) + if (patch_index >= cstart(i) .and. patch_index <= cstart(i) + nap(i) - 1) then + patch_land_index = i + return + end if + end do + call cable_abort("Patch index does not lie on any land point.", file=__FILE__, line=__LINE__) + patch_land_index = -1 + end function + + function io_decomp_land_to_x_y(land_x, land_y, mem_shape_spec, var_shape_spec, type) result(decomp) + integer, intent(in) :: land_x(:), land_y(:) + type(dim_spec_t), intent(in) :: mem_shape_spec(:), var_shape_spec(:) + integer, intent(in) :: type + class(cable_netcdf_decomp_t), allocatable :: decomp + + integer, allocatable :: compmap(:) + integer, allocatable :: mem_index(:), mem_shape(:) + integer, allocatable :: grid_index(:), grid_shape(:) + integer :: mem_land_subscript + integer :: i, mem_offset + + mem_land_subscript = subscript(mem_shape_spec, 'land') + + mem_shape = mem_shape_spec(:)%size + grid_shape = var_shape_spec(:)%size + + allocate(mem_index, mold=mem_shape) + allocate(grid_index, mold=grid_shape) + allocate(compmap(product(mem_shape))) + + do mem_offset = 1, size(compmap) + call array_index(mem_offset, mem_shape, mem_index) + do i = 1, size(var_shape_spec) + select case (var_shape_spec(i)%name) + case ('x') + grid_index(i) = land_x(mem_index(mem_land_subscript)) + case ('y') + grid_index(i) = land_y(mem_index(mem_land_subscript)) + case default + grid_index(i) = mem_index(subscript(mem_shape_spec, var_shape_spec(i)%name)) + end select + end do + compmap(mem_offset) = array_offset(grid_index, grid_shape) + end do + + decomp = cable_netcdf_create_decomp(compmap, grid_shape, type) + + end function + + function io_decomp_patch_to_x_y_patch(land_x, land_y, cstart, nap, mem_shape_spec, var_shape_spec, type) result(decomp) + integer, intent(in) :: land_x(:), land_y(:) + integer, intent(in) :: cstart(:), nap(:) !! These are required to (a) get the land index of each patch index, and (b) get the patch offset value relative to cstart + type(dim_spec_t), intent(in) :: mem_shape_spec(:), var_shape_spec(:) + integer, intent(in) :: type + class(cable_netcdf_decomp_t), allocatable :: decomp + + integer, allocatable :: compmap(:) + integer, allocatable :: mem_index(:), mem_shape(:) + integer, allocatable :: grid_index(:), grid_shape(:) + integer :: mem_patch_subscript + integer :: i, mem_offset, land_index + + mem_patch_subscript = subscript(mem_shape_spec, 'patch') + + mem_shape = mem_shape_spec(:)%size + grid_shape = var_shape_spec(:)%size + + allocate(mem_index, mold=mem_shape) + allocate(grid_index, mold=grid_shape) + allocate(compmap(product(mem_shape))) + + do mem_offset = 1, size(compmap) + call array_index(mem_offset, mem_shape, mem_index) + land_index = patch_land_index(cstart, nap, mem_index(mem_patch_subscript)) + do i = 1, size(var_shape_spec) + select case (var_shape_spec(i)%name) + case ('x') + grid_index(i) = land_x(land_index) + case ('y') + grid_index(i) = land_y(land_index) + case ('patch') + grid_index(i) = mem_index(mem_patch_subscript) - cstart(land_index) + 1 + case default + grid_index(i) = mem_index(subscript(mem_shape_spec, var_shape_spec(i)%name)) + end select + end do + compmap(mem_offset) = array_offset(grid_index, grid_shape) + end do + + decomp = cable_netcdf_create_decomp(compmap, grid_shape, type) + + end function + + function io_decomp_land_to_land(land_decomp_start, mem_shape_spec, var_shape_spec, type) result(decomp) + integer, intent(in) :: land_decomp_start + type(dim_spec_t), intent(in) :: mem_shape_spec(:), var_shape_spec(:) + integer, intent(in) :: type + class(cable_netcdf_decomp_t), allocatable :: decomp + + integer, allocatable :: compmap(:) + integer, allocatable :: mem_index(:), mem_shape(:) + integer, allocatable :: grid_index(:), grid_shape(:) + integer :: mem_land_subscript + integer :: i, mem_offset + + mem_land_subscript = subscript(mem_shape_spec, 'land') + + mem_shape = mem_shape_spec(:)%size + grid_shape = var_shape_spec(:)%size + + allocate(mem_index, mold=mem_shape) + allocate(grid_index, mold=grid_shape) + allocate(compmap(product(mem_shape))) + + do mem_offset = 1, size(compmap) + call array_index(mem_offset, mem_shape, mem_index) + do i = 1, size(var_shape_spec) + select case (var_shape_spec(i)%name) + case ('land') + grid_index(i) = land_decomp_start + mem_index(mem_land_subscript) - 1 + case default + grid_index(i) = mem_index(subscript(mem_shape_spec, var_shape_spec(i)%name)) + end select + end do + compmap(mem_offset) = array_offset(grid_index, grid_shape) + end do + + decomp = cable_netcdf_create_decomp(compmap, grid_shape, type) + + end function + + function io_decomp_patch_to_land_patch(land_decomp_start, cstart, nap, mem_shape_spec, var_shape_spec, type) result(decomp) + integer, intent(in) :: land_decomp_start + integer, intent(in) :: cstart(:), nap(:) + type(dim_spec_t), intent(in) :: mem_shape_spec(:), var_shape_spec(:) + integer, intent(in) :: type + class(cable_netcdf_decomp_t), allocatable :: decomp + + integer, allocatable :: compmap(:) + integer, allocatable :: mem_index(:), mem_shape(:) + integer, allocatable :: grid_index(:), grid_shape(:) + integer :: mem_patch_subscript + integer :: i, mem_offset, land_index + + mem_patch_subscript = subscript(mem_shape_spec, 'patch') + + mem_shape = mem_shape_spec(:)%size + grid_shape = var_shape_spec(:)%size + + allocate(mem_index, mold=mem_shape) + allocate(grid_index, mold=grid_shape) + allocate(compmap(product(mem_shape))) + + do mem_offset = 1, size(compmap) + call array_index(mem_offset, mem_shape, mem_index) + land_index = patch_land_index(cstart, nap, mem_index(mem_patch_subscript)) + do i = 1, size(var_shape_spec) + select case (var_shape_spec(i)%name) + case ('land') + grid_index(i) = land_decomp_start + land_index - 1 + case ('patch') + grid_index(i) = mem_index(mem_patch_subscript) - cstart(land_index) + 1 + case default + grid_index(i) = mem_index(subscript(mem_shape_spec, var_shape_spec(i)%name)) + end select + end do + compmap(mem_offset) = array_offset(grid_index, grid_shape) + end do + + decomp = cable_netcdf_create_decomp(compmap, grid_shape, type) + + end function + + function io_decomp_patch_to_patch(patch_decomp_start, mem_shape_spec, var_shape_spec, type) result(decomp) + integer, intent(in) :: patch_decomp_start + type(dim_spec_t), intent(in) :: mem_shape_spec(:), var_shape_spec(:) + integer, intent(in) :: type + class(cable_netcdf_decomp_t), allocatable :: decomp + + integer, allocatable :: compmap(:) + integer, allocatable :: mem_index(:), mem_shape(:) + integer, allocatable :: grid_index(:), grid_shape(:) + integer :: mem_patch_subscript + integer :: i, mem_offset + + mem_patch_subscript = subscript(mem_shape_spec, 'patch') + + mem_shape = mem_shape_spec(:)%size + grid_shape = var_shape_spec(:)%size + + allocate(mem_index, mold=mem_shape) + allocate(grid_index, mold=grid_shape) + allocate(compmap(product(mem_shape))) + + do mem_offset = 1, size(compmap) + call array_index(mem_offset, mem_shape, mem_index) + do i = 1, size(var_shape_spec) + select case (var_shape_spec(i)%name) + case ('patch') + grid_index(i) = patch_decomp_start + mem_index(mem_patch_subscript) - 1 + case default + grid_index(i) = mem_index(subscript(mem_shape_spec, var_shape_spec(i)%name)) + end select + end do + compmap(mem_offset) = array_offset(grid_index, grid_shape) + end do + + decomp = cable_netcdf_create_decomp(compmap, grid_shape, type) + + end function + +end module diff --git a/src/util/netcdf/cable_netcdf_internal.F90 b/src/util/netcdf/cable_netcdf_internal.F90 new file mode 100644 index 000000000..1129c60bb --- /dev/null +++ b/src/util/netcdf/cable_netcdf_internal.F90 @@ -0,0 +1,40 @@ +submodule (cable_netcdf_mod) cable_netcdf_internal + use cable_netcdf_nf90_mod + use cable_netcdf_pio_mod + implicit none + +contains + + module subroutine cable_netcdf_mod_init(mpi_grp) + type(mpi_grp_t), intent(in) :: mpi_grp + if (mpi_grp%size > 1) then + cable_netcdf_io_handler = cable_netcdf_pio_io_t(mpi_grp) + else + cable_netcdf_io_handler = cable_netcdf_nf90_io_t() + end if + call cable_netcdf_io_handler%init() + end subroutine + + module subroutine cable_netcdf_mod_end() + call cable_netcdf_io_handler%finalise() + end subroutine + + module function cable_netcdf_create_file(path) result(file) + character(len=*), intent(in) :: path + class(cable_netcdf_file_t), allocatable :: file + file = cable_netcdf_io_handler%create_file(path) + end function + + module function cable_netcdf_open_file(path) result(file) + character(len=*), intent(in) :: path + class(cable_netcdf_file_t), allocatable :: file + file = cable_netcdf_io_handler%open_file(path) + end function + + module function cable_netcdf_create_decomp(compmap, dims, type) result(decomp) + integer, intent(in) :: compmap(:), dims(:), type + class(cable_netcdf_decomp_t), allocatable :: decomp + decomp = cable_netcdf_io_handler%create_decomp(compmap, dims, type) + end function + +end submodule cable_netcdf_internal diff --git a/src/util/netcdf/cable_netcdf_stub_types.F90 b/src/util/netcdf/cable_netcdf_stub_types.F90 new file mode 100644 index 000000000..6f89dc8f4 --- /dev/null +++ b/src/util/netcdf/cable_netcdf_stub_types.F90 @@ -0,0 +1,600 @@ +module cable_netcdf_stub_types_mod + use cable_netcdf_mod + use cable_mpi_mod, only: mpi_grp_t + use iso_fortran_env, only: error_unit + implicit none + + private + public :: & + cable_netcdf_stub_decomp_t, & + cable_netcdf_stub_file_t, & + cable_netcdf_stub_io_t + + type, extends(cable_netcdf_decomp_t) :: cable_netcdf_stub_decomp_t + end type + + type, extends(cable_netcdf_io_t) :: cable_netcdf_stub_io_t + contains + procedure :: init => cable_netcdf_stub_io_init + procedure :: finalise => cable_netcdf_stub_io_finalise + procedure :: create_file => cable_netcdf_stub_io_create_file + procedure :: open_file => cable_netcdf_stub_io_open_file + procedure :: create_decomp => cable_netcdf_stub_io_create_decomp + end type + + type, extends(cable_netcdf_file_t) :: cable_netcdf_stub_file_t + contains + procedure :: close => cable_netcdf_stub_file_close + procedure :: end_def => cable_netcdf_stub_file_end_def + procedure :: sync => cable_netcdf_stub_file_sync + procedure :: def_dims => cable_netcdf_stub_file_def_dims + procedure :: def_var => cable_netcdf_stub_file_def_var + procedure :: put_att_global_string => cable_netcdf_stub_file_put_att_global_string + procedure :: put_att_global_int32 => cable_netcdf_stub_file_put_att_global_int32 + procedure :: put_att_global_real32 => cable_netcdf_stub_file_put_att_global_real32 + procedure :: put_att_global_real64 => cable_netcdf_stub_file_put_att_global_real64 + procedure :: put_att_var_string => cable_netcdf_stub_file_put_att_var_string + procedure :: put_att_var_int32 => cable_netcdf_stub_file_put_att_var_int32 + procedure :: put_att_var_real32 => cable_netcdf_stub_file_put_att_var_real32 + procedure :: put_att_var_real64 => cable_netcdf_stub_file_put_att_var_real64 + procedure :: get_att_global_string => cable_netcdf_stub_file_get_att_global_string + procedure :: get_att_global_int32 => cable_netcdf_stub_file_get_att_global_int32 + procedure :: get_att_global_real32 => cable_netcdf_stub_file_get_att_global_real32 + procedure :: get_att_global_real64 => cable_netcdf_stub_file_get_att_global_real64 + procedure :: get_att_var_string => cable_netcdf_stub_file_get_att_var_string + procedure :: get_att_var_int32 => cable_netcdf_stub_file_get_att_var_int32 + procedure :: get_att_var_real32 => cable_netcdf_stub_file_get_att_var_real32 + procedure :: get_att_var_real64 => cable_netcdf_stub_file_get_att_var_real64 + procedure :: inq_dim_len => cable_netcdf_stub_file_inq_dim_len + procedure :: put_var_int32_0d => cable_netcdf_stub_file_put_var_int32_0d + procedure :: put_var_int32_1d => cable_netcdf_stub_file_put_var_int32_1d + procedure :: put_var_int32_2d => cable_netcdf_stub_file_put_var_int32_2d + procedure :: put_var_int32_3d => cable_netcdf_stub_file_put_var_int32_3d + procedure :: put_var_real32_0d => cable_netcdf_stub_file_put_var_real32_0d + procedure :: put_var_real32_1d => cable_netcdf_stub_file_put_var_real32_1d + procedure :: put_var_real32_2d => cable_netcdf_stub_file_put_var_real32_2d + procedure :: put_var_real32_3d => cable_netcdf_stub_file_put_var_real32_3d + procedure :: put_var_real64_0d => cable_netcdf_stub_file_put_var_real64_0d + procedure :: put_var_real64_1d => cable_netcdf_stub_file_put_var_real64_1d + procedure :: put_var_real64_2d => cable_netcdf_stub_file_put_var_real64_2d + procedure :: put_var_real64_3d => cable_netcdf_stub_file_put_var_real64_3d + procedure :: write_darray_int32_1d => cable_netcdf_stub_file_write_darray_int32_1d + procedure :: write_darray_int32_2d => cable_netcdf_stub_file_write_darray_int32_2d + procedure :: write_darray_int32_3d => cable_netcdf_stub_file_write_darray_int32_3d + procedure :: write_darray_real32_1d => cable_netcdf_stub_file_write_darray_real32_1d + procedure :: write_darray_real32_2d => cable_netcdf_stub_file_write_darray_real32_2d + procedure :: write_darray_real32_3d => cable_netcdf_stub_file_write_darray_real32_3d + procedure :: write_darray_real64_1d => cable_netcdf_stub_file_write_darray_real64_1d + procedure :: write_darray_real64_2d => cable_netcdf_stub_file_write_darray_real64_2d + procedure :: write_darray_real64_3d => cable_netcdf_stub_file_write_darray_real64_3d + procedure :: get_var_int32_0d => cable_netcdf_stub_file_get_var_int32_0d + procedure :: get_var_int32_1d => cable_netcdf_stub_file_get_var_int32_1d + procedure :: get_var_int32_2d => cable_netcdf_stub_file_get_var_int32_2d + procedure :: get_var_int32_3d => cable_netcdf_stub_file_get_var_int32_3d + procedure :: get_var_real32_0d => cable_netcdf_stub_file_get_var_real32_0d + procedure :: get_var_real32_1d => cable_netcdf_stub_file_get_var_real32_1d + procedure :: get_var_real32_2d => cable_netcdf_stub_file_get_var_real32_2d + procedure :: get_var_real32_3d => cable_netcdf_stub_file_get_var_real32_3d + procedure :: get_var_real64_0d => cable_netcdf_stub_file_get_var_real64_0d + procedure :: get_var_real64_1d => cable_netcdf_stub_file_get_var_real64_1d + procedure :: get_var_real64_2d => cable_netcdf_stub_file_get_var_real64_2d + procedure :: get_var_real64_3d => cable_netcdf_stub_file_get_var_real64_3d + procedure :: read_darray_int32_1d => cable_netcdf_stub_file_read_darray_int32_1d + procedure :: read_darray_int32_2d => cable_netcdf_stub_file_read_darray_int32_2d + procedure :: read_darray_int32_3d => cable_netcdf_stub_file_read_darray_int32_3d + procedure :: read_darray_real32_1d => cable_netcdf_stub_file_read_darray_real32_1d + procedure :: read_darray_real32_2d => cable_netcdf_stub_file_read_darray_real32_2d + procedure :: read_darray_real32_3d => cable_netcdf_stub_file_read_darray_real32_3d + procedure :: read_darray_real64_1d => cable_netcdf_stub_file_read_darray_real64_1d + procedure :: read_darray_real64_2d => cable_netcdf_stub_file_read_darray_real64_2d + procedure :: read_darray_real64_3d => cable_netcdf_stub_file_read_darray_real64_3d + end type + +contains + + subroutine cable_netcdf_stub_io_init(this) + class(cable_netcdf_stub_io_t), intent(inout) :: this + end subroutine + + subroutine cable_netcdf_stub_io_finalise(this) + class(cable_netcdf_stub_io_t), intent(inout) :: this + end subroutine + + function cable_netcdf_stub_io_create_file(this, path) result(file) + class(cable_netcdf_stub_io_t), intent(inout) :: this + character(len=*), intent(in) :: path + class(cable_netcdf_file_t), allocatable :: file + file = cable_netcdf_stub_file_t() + end function + + function cable_netcdf_stub_io_open_file(this, path) result(file) + class(cable_netcdf_stub_io_t), intent(inout) :: this + character(len=*), intent(in) :: path + class(cable_netcdf_file_t), allocatable :: file + file = cable_netcdf_stub_file_t() + end function + + function cable_netcdf_stub_io_create_decomp(this, compmap, dims, type) result(decomp) + class(cable_netcdf_stub_io_t), intent(inout) :: this + integer, intent(in) :: compmap(:), dims(:) + integer, intent(in) :: type + class(cable_netcdf_decomp_t), allocatable :: decomp + decomp = cable_netcdf_stub_decomp_t(compmap, dims, type) + end function + + subroutine cable_netcdf_stub_file_close(this) + class(cable_netcdf_stub_file_t), intent(inout) :: this + end subroutine + + subroutine cable_netcdf_stub_file_end_def(this) + class(cable_netcdf_stub_file_t), intent(inout) :: this + end subroutine + + subroutine cable_netcdf_stub_file_sync(this) + class(cable_netcdf_stub_file_t), intent(inout) :: this + end subroutine + + subroutine cable_netcdf_stub_file_def_dims(this, dim_names, dim_lens) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: dim_names(:) + integer, intent(in) :: dim_lens(:) + end subroutine + + subroutine cable_netcdf_stub_file_def_var(this, var_name, dim_names, type) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, dim_names(:) + integer, intent(in) :: type + end subroutine + + subroutine cable_netcdf_stub_file_put_att_global_string(this, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name, att_value + end subroutine + + subroutine cable_netcdf_stub_file_put_att_global_int32(this, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: att_value + end subroutine + + subroutine cable_netcdf_stub_file_put_att_global_real32(this, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: att_value + end subroutine + + subroutine cable_netcdf_stub_file_put_att_global_real64(this, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: att_value + end subroutine + + subroutine cable_netcdf_stub_file_put_att_var_string(this, var_name, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name, att_value + end subroutine + + subroutine cable_netcdf_stub_file_put_att_var_int32(this, var_name, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: att_value + end subroutine + + subroutine cable_netcdf_stub_file_put_att_var_real32(this, var_name, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: att_value + end subroutine + + subroutine cable_netcdf_stub_file_put_att_var_real64(this, var_name, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: att_value + end subroutine + + subroutine cable_netcdf_stub_file_get_att_global_string(this, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + character(len=*), intent(out) :: att_value + att_value = "" + end subroutine + + subroutine cable_netcdf_stub_file_get_att_global_int32(this, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: att_value + att_value = 0 + end subroutine + + subroutine cable_netcdf_stub_file_get_att_global_real32(this, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: att_value + att_value = 0.0 + end subroutine + + subroutine cable_netcdf_stub_file_get_att_global_real64(this, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: att_value + att_value = 0.0 + end subroutine + + subroutine cable_netcdf_stub_file_get_att_var_string(this, var_name, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + character(len=*), intent(out) :: att_value + att_value = "" + end subroutine + + subroutine cable_netcdf_stub_file_get_att_var_int32(this, var_name, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: att_value + att_value = 0 + end subroutine + + subroutine cable_netcdf_stub_file_get_att_var_real32(this, var_name, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: att_value + att_value = 0.0 + end subroutine + + subroutine cable_netcdf_stub_file_get_att_var_real64(this, var_name, att_name, att_value) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: att_value + att_value = 0.0 + end subroutine + + subroutine cable_netcdf_stub_file_inq_dim_len(this, dim_name, dim_len) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: dim_name + integer, intent(out) :: dim_len + dim_len = 0 + end subroutine + + subroutine cable_netcdf_stub_file_put_var_int32_0d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values + integer, intent(in), optional :: start(:), count(:) + end subroutine + + subroutine cable_netcdf_stub_file_put_var_int32_1d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:) + integer, intent(in), optional :: start(:), count(:) + end subroutine + + subroutine cable_netcdf_stub_file_put_var_int32_2d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + + subroutine cable_netcdf_stub_file_put_var_int32_3d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + + subroutine cable_netcdf_stub_file_put_var_real32_0d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values + integer, intent(in), optional :: start(:), count(:) + end subroutine + + subroutine cable_netcdf_stub_file_put_var_real32_1d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:) + integer, intent(in), optional :: start(:), count(:) + end subroutine + + subroutine cable_netcdf_stub_file_put_var_real32_2d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + + subroutine cable_netcdf_stub_file_put_var_real32_3d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + + subroutine cable_netcdf_stub_file_put_var_real64_0d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values + integer, intent(in), optional :: start(:), count(:) + end subroutine + + subroutine cable_netcdf_stub_file_put_var_real64_1d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:) + integer, intent(in), optional :: start(:), count(:) + end subroutine + + subroutine cable_netcdf_stub_file_put_var_real64_2d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + + subroutine cable_netcdf_stub_file_put_var_real64_3d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + end subroutine + + subroutine cable_netcdf_stub_file_write_darray_int32_1d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + + subroutine cable_netcdf_stub_file_write_darray_int32_2d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + + subroutine cable_netcdf_stub_file_write_darray_int32_3d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + + subroutine cable_netcdf_stub_file_write_darray_real32_1d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + + subroutine cable_netcdf_stub_file_write_darray_real32_2d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + + subroutine cable_netcdf_stub_file_write_darray_real32_3d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + + subroutine cable_netcdf_stub_file_write_darray_real64_1d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + + subroutine cable_netcdf_stub_file_write_darray_real64_2d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + + subroutine cable_netcdf_stub_file_write_darray_real64_3d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + end subroutine + + subroutine cable_netcdf_stub_file_get_var_int32_0d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values + integer, intent(in), optional :: start(:), count(:) + values = 0 + end subroutine + + subroutine cable_netcdf_stub_file_get_var_int32_1d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:) + integer, intent(in), optional :: start(:), count(:) + values = 0 + end subroutine + + subroutine cable_netcdf_stub_file_get_var_int32_2d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + values = 0 + end subroutine + + subroutine cable_netcdf_stub_file_get_var_int32_3d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + values = 0 + end subroutine + + subroutine cable_netcdf_stub_file_get_var_real32_0d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values + integer, intent(in), optional :: start(:), count(:) + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_get_var_real32_1d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:) + integer, intent(in), optional :: start(:), count(:) + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_get_var_real32_2d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_get_var_real32_3d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_get_var_real64_0d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values + integer, intent(in), optional :: start(:), count(:) + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_get_var_real64_1d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:) + integer, intent(in), optional :: start(:), count(:) + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_get_var_real64_2d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_get_var_real64_3d(this, var_name, values, start, count) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_read_darray_int32_1d(this, var_name, values, decomp, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_read_darray_int32_2d(this, var_name, values, decomp, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_read_darray_int32_3d(this, var_name, values, decomp, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_read_darray_real32_1d(this, var_name, values, decomp, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_read_darray_real32_2d(this, var_name, values, decomp, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_read_darray_real32_3d(this, var_name, values, decomp, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_read_darray_real64_1d(this, var_name, values, decomp, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_read_darray_real64_2d(this, var_name, values, decomp, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + values = 0. + end subroutine + + subroutine cable_netcdf_stub_file_read_darray_real64_3d(this, var_name, values, decomp, frame) + class(cable_netcdf_stub_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + values = 0. + end subroutine + +end module cable_netcdf_stub_types_mod diff --git a/src/util/netcdf/nf90/cable_netcdf_nf90.F90 b/src/util/netcdf/nf90/cable_netcdf_nf90.F90 new file mode 100644 index 000000000..dfa8a08d4 --- /dev/null +++ b/src/util/netcdf/nf90/cable_netcdf_nf90.F90 @@ -0,0 +1,1071 @@ +module cable_netcdf_nf90_mod + use cable_netcdf_mod + + use cable_mpi_mod, only: mpi_grp_t + use cable_abort_module, only: cable_abort + + use cable_array_utils_mod, only: array_index + + use netcdf, only: nf90_create + use netcdf, only: nf90_open + use netcdf, only: nf90_close + use netcdf, only: nf90_sync + use netcdf, only: nf90_strerror + use netcdf, only: nf90_def_dim + use netcdf, only: nf90_def_var + use netcdf, only: nf90_put_att + use netcdf, only: nf90_get_att + use netcdf, only: nf90_put_var + use netcdf, only: nf90_get_var + use netcdf, only: nf90_inq_dimid + use netcdf, only: nf90_inq_varid + use netcdf, only: nf90_inquire + use netcdf, only: nf90_inquire_dimension + use netcdf, only: nf90_inquire_variable + use netcdf, only: nf90_enddef + use netcdf, only: NF90_NOERR + use netcdf, only: NF90_NETCDF4 + use netcdf, only: NF90_UNLIMITED + use netcdf, only: NF90_INT + use netcdf, only: NF90_FLOAT + use netcdf, only: NF90_DOUBLE + use netcdf, only: NF90_FILL_INT + use netcdf, only: NF90_FILL_FLOAT + use netcdf, only: NF90_FILL_DOUBLE + use netcdf, only: NF90_MAX_VAR_DIMS + use netcdf, only: NF90_GLOBAL + + implicit none + + private + + public :: cable_netcdf_nf90_io_t + + type, extends(cable_netcdf_io_t) :: cable_netcdf_nf90_io_t + contains + procedure :: init => cable_netcdf_nf90_io_init + procedure :: finalise => cable_netcdf_nf90_io_finalise + procedure :: create_file => cable_netcdf_nf90_io_create_file + procedure :: open_file => cable_netcdf_nf90_io_open_file + procedure :: create_decomp => cable_netcdf_nf90_io_create_decomp + end type + + type, extends(cable_netcdf_file_t) :: cable_netcdf_nf90_file_t + integer, private :: ncid + contains + procedure :: close => cable_netcdf_nf90_file_close + procedure :: end_def => cable_netcdf_nf90_file_end_def + procedure :: sync => cable_netcdf_nf90_file_sync + procedure :: def_dims => cable_netcdf_nf90_file_def_dims + procedure :: def_var => cable_netcdf_nf90_file_def_var + procedure :: put_att_global_string => cable_netcdf_nf90_file_put_att_global_string + procedure :: put_att_global_int32 => cable_netcdf_nf90_file_put_att_global_int32 + procedure :: put_att_global_real32 => cable_netcdf_nf90_file_put_att_global_real32 + procedure :: put_att_global_real64 => cable_netcdf_nf90_file_put_att_global_real64 + procedure :: put_att_var_string => cable_netcdf_nf90_file_put_att_var_string + procedure :: put_att_var_int32 => cable_netcdf_nf90_file_put_att_var_int32 + procedure :: put_att_var_real32 => cable_netcdf_nf90_file_put_att_var_real32 + procedure :: put_att_var_real64 => cable_netcdf_nf90_file_put_att_var_real64 + procedure :: get_att_global_string => cable_netcdf_nf90_file_get_att_global_string + procedure :: get_att_global_int32 => cable_netcdf_nf90_file_get_att_global_int32 + procedure :: get_att_global_real32 => cable_netcdf_nf90_file_get_att_global_real32 + procedure :: get_att_global_real64 => cable_netcdf_nf90_file_get_att_global_real64 + procedure :: get_att_var_string => cable_netcdf_nf90_file_get_att_var_string + procedure :: get_att_var_int32 => cable_netcdf_nf90_file_get_att_var_int32 + procedure :: get_att_var_real32 => cable_netcdf_nf90_file_get_att_var_real32 + procedure :: get_att_var_real64 => cable_netcdf_nf90_file_get_att_var_real64 + procedure :: inq_dim_len => cable_netcdf_nf90_file_inq_dim_len + procedure :: put_var_int32_0d => cable_netcdf_nf90_file_put_var_int32_0d + procedure :: put_var_int32_1d => cable_netcdf_nf90_file_put_var_int32_1d + procedure :: put_var_int32_2d => cable_netcdf_nf90_file_put_var_int32_2d + procedure :: put_var_int32_3d => cable_netcdf_nf90_file_put_var_int32_3d + procedure :: put_var_real32_0d => cable_netcdf_nf90_file_put_var_real32_0d + procedure :: put_var_real32_1d => cable_netcdf_nf90_file_put_var_real32_1d + procedure :: put_var_real32_2d => cable_netcdf_nf90_file_put_var_real32_2d + procedure :: put_var_real32_3d => cable_netcdf_nf90_file_put_var_real32_3d + procedure :: put_var_real64_0d => cable_netcdf_nf90_file_put_var_real64_0d + procedure :: put_var_real64_1d => cable_netcdf_nf90_file_put_var_real64_1d + procedure :: put_var_real64_2d => cable_netcdf_nf90_file_put_var_real64_2d + procedure :: put_var_real64_3d => cable_netcdf_nf90_file_put_var_real64_3d + procedure :: write_darray_int32_1d => cable_netcdf_nf90_file_write_darray_int32_1d + procedure :: write_darray_int32_2d => cable_netcdf_nf90_file_write_darray_int32_2d + procedure :: write_darray_int32_3d => cable_netcdf_nf90_file_write_darray_int32_3d + procedure :: write_darray_real32_1d => cable_netcdf_nf90_file_write_darray_real32_1d + procedure :: write_darray_real32_2d => cable_netcdf_nf90_file_write_darray_real32_2d + procedure :: write_darray_real32_3d => cable_netcdf_nf90_file_write_darray_real32_3d + procedure :: write_darray_real64_1d => cable_netcdf_nf90_file_write_darray_real64_1d + procedure :: write_darray_real64_2d => cable_netcdf_nf90_file_write_darray_real64_2d + procedure :: write_darray_real64_3d => cable_netcdf_nf90_file_write_darray_real64_3d + procedure :: get_var_int32_0d => cable_netcdf_nf90_file_get_var_int32_0d + procedure :: get_var_int32_1d => cable_netcdf_nf90_file_get_var_int32_1d + procedure :: get_var_int32_2d => cable_netcdf_nf90_file_get_var_int32_2d + procedure :: get_var_int32_3d => cable_netcdf_nf90_file_get_var_int32_3d + procedure :: get_var_real32_0d => cable_netcdf_nf90_file_get_var_real32_0d + procedure :: get_var_real32_1d => cable_netcdf_nf90_file_get_var_real32_1d + procedure :: get_var_real32_2d => cable_netcdf_nf90_file_get_var_real32_2d + procedure :: get_var_real32_3d => cable_netcdf_nf90_file_get_var_real32_3d + procedure :: get_var_real64_0d => cable_netcdf_nf90_file_get_var_real64_0d + procedure :: get_var_real64_1d => cable_netcdf_nf90_file_get_var_real64_1d + procedure :: get_var_real64_2d => cable_netcdf_nf90_file_get_var_real64_2d + procedure :: get_var_real64_3d => cable_netcdf_nf90_file_get_var_real64_3d + procedure :: read_darray_int32_1d => cable_netcdf_nf90_file_read_darray_int32_1d + procedure :: read_darray_int32_2d => cable_netcdf_nf90_file_read_darray_int32_2d + procedure :: read_darray_int32_3d => cable_netcdf_nf90_file_read_darray_int32_3d + procedure :: read_darray_real32_1d => cable_netcdf_nf90_file_read_darray_real32_1d + procedure :: read_darray_real32_2d => cable_netcdf_nf90_file_read_darray_real32_2d + procedure :: read_darray_real32_3d => cable_netcdf_nf90_file_read_darray_real32_3d + procedure :: read_darray_real64_1d => cable_netcdf_nf90_file_read_darray_real64_1d + procedure :: read_darray_real64_2d => cable_netcdf_nf90_file_read_darray_real64_2d + procedure :: read_darray_real64_3d => cable_netcdf_nf90_file_read_darray_real64_3d + end type + +contains + + function type_nf90(type) + integer, intent(in) :: type + integer :: type_nf90 + select case(type) + case(CABLE_NETCDF_INT) + type_nf90 = NF90_INT + case(CABLE_NETCDF_FLOAT) + type_nf90 = NF90_FLOAT + case(CABLE_NETCDF_DOUBLE) + type_nf90 = NF90_DOUBLE + case default + call cable_abort("cable_netcdf_nf90_mod: Error: type not supported") + end select + end function type_nf90 + + subroutine check_nf90(status) + integer, intent ( in) :: status + if(status /= NF90_NOERR) then + call cable_abort(trim(nf90_strerror(status)), file=__FILE__, line=__LINE__) + end if + end subroutine check_nf90 + + subroutine cable_netcdf_nf90_io_init(this) + class(cable_netcdf_nf90_io_t), intent(inout) :: this + end subroutine + + subroutine cable_netcdf_nf90_io_finalise(this) + class(cable_netcdf_nf90_io_t), intent(inout) :: this + end subroutine + + function cable_netcdf_nf90_io_create_file(this, path) result(file) + class(cable_netcdf_nf90_io_t), intent(inout) :: this + character(len=*), intent(in) :: path + class(cable_netcdf_file_t), allocatable :: file + integer :: ncid + call check_nf90(nf90_create(path, NF90_NETCDF4, ncid)) + file = cable_netcdf_nf90_file_t(ncid=ncid) + end function + + function cable_netcdf_nf90_io_open_file(this, path) result(file) + class(cable_netcdf_nf90_io_t), intent(inout) :: this + character(len=*), intent(in) :: path + class(cable_netcdf_file_t), allocatable :: file + integer :: ncid + call check_nf90(nf90_open(path, NF90_NETCDF4, ncid)) + file = cable_netcdf_nf90_file_t(ncid=ncid) + end function + + function cable_netcdf_nf90_io_create_decomp(this, compmap, dims, type) result(decomp) + class(cable_netcdf_nf90_io_t), intent(inout) :: this + integer, intent(in) :: compmap(:), dims(:) + integer, intent(in) :: type + class(cable_netcdf_decomp_t), allocatable :: decomp + decomp = cable_netcdf_decomp_t(compmap=compmap, dims=dims, type=type) + end function + + subroutine cable_netcdf_nf90_file_close(this) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + call check_nf90(nf90_close(this%ncid)) + end subroutine + + subroutine cable_netcdf_nf90_file_end_def(this) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + call check_nf90(nf90_enddef(this%ncid)) + end subroutine + + subroutine cable_netcdf_nf90_file_sync(this) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + call check_nf90(nf90_sync(this%ncid)) + end subroutine + + subroutine cable_netcdf_nf90_file_def_dims(this, dim_names, dim_lens) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: dim_names(:) + integer, intent(in) :: dim_lens(:) + integer :: i, tmp + do i = 1, size(dim_names) + if (dim_lens(i) == CABLE_NETCDF_UNLIMITED) then + call check_nf90(nf90_def_dim(this%ncid, dim_names(i), NF90_UNLIMITED, tmp)) + else + call check_nf90(nf90_def_dim(this%ncid, dim_names(i), dim_lens(i), tmp)) + end if + end do + end subroutine + + subroutine cable_netcdf_nf90_file_def_var(this, var_name, dim_names, type) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, dim_names(:) + integer, intent(in) :: type + integer, allocatable :: dimids(:) + integer :: i, tmp + allocate(dimids(size(dim_names))) + do i = 1, size(dimids) + call check_nf90(nf90_inq_dimid(this%ncid, dim_names(i), dimids(i))) + end do + call check_nf90(nf90_def_var(this%ncid, var_name, type_nf90(type), dimids, tmp)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_att_global_string(this, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name, att_value + call check_nf90(nf90_put_att(this%ncid, NF90_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_att_global_int32(this, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: att_value + call check_nf90(nf90_put_att(this%ncid, NF90_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_att_global_real32(this, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: att_value + call check_nf90(nf90_put_att(this%ncid, NF90_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_att_global_real64(this, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: att_value + call check_nf90(nf90_put_att(this%ncid, NF90_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_att_var_string(this, var_name, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name, att_value + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_att(this%ncid, varid, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_att_var_int32(this, var_name, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: att_value + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_att(this%ncid, varid, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_att_var_real32(this, var_name, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: att_value + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_att(this%ncid, varid, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_att_var_real64(this, var_name, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: att_value + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_att(this%ncid, varid, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_att_global_string(this, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + character(len=*), intent(out) :: att_value + call check_nf90(nf90_get_att(this%ncid, NF90_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_att_global_int32(this, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: att_value + call check_nf90(nf90_get_att(this%ncid, NF90_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_att_global_real32(this, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: att_value + call check_nf90(nf90_get_att(this%ncid, NF90_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_att_global_real64(this, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: att_value + call check_nf90(nf90_get_att(this%ncid, NF90_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_att_var_string(this, var_name, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + character(len=*), intent(out) :: att_value + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_att(this%ncid, varid, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_att_var_int32(this, var_name, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: att_value + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_att(this%ncid, varid, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_att_var_real32(this, var_name, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: att_value + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_att(this%ncid, varid, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_att_var_real64(this, var_name, att_name, att_value) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: att_value + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_att(this%ncid, varid, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_nf90_file_inq_dim_len(this, dim_name, dim_len) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: dim_name + integer, intent(out) :: dim_len + integer :: dimid + call check_nf90(nf90_inq_dimid(this%ncid, dim_name, dimid)) + call check_nf90(nf90_inquire_dimension(this%ncid, dimid, len=dim_len)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_var_int32_0d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_var(this%ncid, varid, values, start=start)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_var_int32_1d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_var_int32_2d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_var_int32_3d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_var_real32_0d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_var(this%ncid, varid, values, start=start)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_var_real32_1d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_var_real32_2d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_var_real32_3d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_var_real64_0d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_var(this%ncid, varid, values, start=start)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_var_real64_1d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_var_real64_2d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_put_var_real64_3d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_put_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_write_darray_int32(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(..) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + integer(kind=CABLE_NETCDF_INT32_KIND), allocatable :: values_filled(:) + integer :: i, varid, ndims + integer :: dimids(NF90_MAX_VAR_DIMS), starts(NF90_MAX_VAR_DIMS), counts(NF90_MAX_VAR_DIMS), mem_index(CABLE_NETCDF_MAX_RANK) + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + if (present(fill_value)) then + allocate(values_filled(product(decomp%dims)), source=fill_value) + else + allocate(values_filled(product(decomp%dims)), source=NF90_FILL_INT) + end if + select rank(values) + rank(1) + do i = 1, size(values) + values_filled(decomp%compmap(i)) = values(i) + end do + rank(2) + do i = 1, size(values) + call array_index(i, shape(values), mem_index(:2)) + values_filled(decomp%compmap(i)) = values(mem_index(1), mem_index(2)) + end do + rank(3) + do i = 1, size(values) + call array_index(i, shape(values), mem_index(:3)) + values_filled(decomp%compmap(i)) = values(mem_index(1), mem_index(2), mem_index(3)) + end do + end select + call check_nf90(nf90_inquire_variable(this%ncid, varid, dimids=dimids, ndims=ndims)) + do i = 1, ndims + starts(i) = 1 + call check_nf90(nf90_inquire_dimension(this%ncid, dimids(i), len=counts(i))) + end do + if (present(frame)) then + starts(ndims) = frame + counts(ndims) = 1 + end if + call check_nf90( & + nf90_put_var( & + this%ncid, & + varid, & + values_filled, & + start=starts(:ndims), & + count=counts(:ndims), & + map=[1, (product(decomp%dims(:i)), i = 1, size(decomp%dims) - 1)] & + ) & + ) + end subroutine + + subroutine cable_netcdf_nf90_file_write_darray_int32_1d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_write_darray_int32(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_nf90_file_write_darray_int32_2d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_write_darray_int32(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_nf90_file_write_darray_int32_3d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_write_darray_int32(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_write_darray_real32(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(..) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + real(kind=CABLE_NETCDF_REAL32_KIND), allocatable :: values_filled(:) + integer :: i, varid, ndims + integer :: dimids(NF90_MAX_VAR_DIMS), starts(NF90_MAX_VAR_DIMS), counts(NF90_MAX_VAR_DIMS), mem_index(CABLE_NETCDF_MAX_RANK) + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + if (present(fill_value)) then + allocate(values_filled(product(decomp%dims)), source=fill_value) + else + allocate(values_filled(product(decomp%dims)), source=NF90_FILL_FLOAT) + end if + select rank(values) + rank(1) + do i = 1, size(values) + values_filled(decomp%compmap(i)) = values(i) + end do + rank(2) + do i = 1, size(values) + call array_index(i, shape(values), mem_index(:2)) + values_filled(decomp%compmap(i)) = values(mem_index(1), mem_index(2)) + end do + rank(3) + do i = 1, size(values) + call array_index(i, shape(values), mem_index(:3)) + values_filled(decomp%compmap(i)) = values(mem_index(1), mem_index(2), mem_index(3)) + end do + end select + call check_nf90(nf90_inquire_variable(this%ncid, varid, dimids=dimids, ndims=ndims)) + do i = 1, ndims + starts(i) = 1 + call check_nf90(nf90_inquire_dimension(this%ncid, dimids(i), len=counts(i))) + end do + if (present(frame)) then + starts(ndims) = frame + counts(ndims) = 1 + end if + call check_nf90( & + nf90_put_var( & + this%ncid, & + varid, & + values_filled, & + start=starts(:ndims), & + count=counts(:ndims), & + map=[1, (product(decomp%dims(:i)), i = 1, size(decomp%dims) - 1)] & + ) & + ) + end subroutine + + subroutine cable_netcdf_nf90_file_write_darray_real32_1d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_write_darray_real32(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_nf90_file_write_darray_real32_2d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_write_darray_real32(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_nf90_file_write_darray_real32_3d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_write_darray_real32(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_write_darray_real64(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(..) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + real(kind=CABLE_NETCDF_REAL64_KIND), allocatable :: values_filled(:) + integer :: i, varid, ndims + integer :: dimids(NF90_MAX_VAR_DIMS), starts(NF90_MAX_VAR_DIMS), counts(NF90_MAX_VAR_DIMS), mem_index(CABLE_NETCDF_MAX_RANK) + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + if (present(fill_value)) then + allocate(values_filled(product(decomp%dims)), source=fill_value) + else + allocate(values_filled(product(decomp%dims)), source=NF90_FILL_DOUBLE) + end if + select rank(values) + rank(1) + do i = 1, size(values) + values_filled(decomp%compmap(i)) = values(i) + end do + rank(2) + do i = 1, size(values) + call array_index(i, shape(values), mem_index(:2)) + values_filled(decomp%compmap(i)) = values(mem_index(1), mem_index(2)) + end do + rank(3) + do i = 1, size(values) + call array_index(i, shape(values), mem_index(:3)) + values_filled(decomp%compmap(i)) = values(mem_index(1), mem_index(2), mem_index(3)) + end do + end select + call check_nf90(nf90_inquire_variable(this%ncid, varid, dimids=dimids, ndims=ndims)) + do i = 1, ndims + starts(i) = 1 + call check_nf90(nf90_inquire_dimension(this%ncid, dimids(i), len=counts(i))) + end do + if (present(frame)) then + starts(ndims) = frame + counts(ndims) = 1 + end if + call check_nf90( & + nf90_put_var( & + this%ncid, & + varid, & + values_filled, & + start=starts(:ndims), & + count=counts(:ndims), & + map=[1, (product(decomp%dims(:i)), i = 1, size(decomp%dims) - 1)] & + ) & + ) + end subroutine + + subroutine cable_netcdf_nf90_file_write_darray_real64_1d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_write_darray_real64(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_nf90_file_write_darray_real64_2d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_write_darray_real64(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_nf90_file_write_darray_real64_3d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_write_darray_real64(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_nf90_file_get_var_int32_0d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_var(this%ncid, varid, values, start=start)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_var_int32_1d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_var_int32_2d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_var_int32_3d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_var_real32_0d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_var(this%ncid, varid, values, start=start)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_var_real32_1d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_var_real32_2d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_var_real32_3d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_var_real64_0d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_var(this%ncid, varid, values, start=start)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_var_real64_1d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_var_real64_2d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_nf90_file_get_var_real64_3d(this, var_name, values, start, count) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + integer varid + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + call check_nf90(nf90_get_var(this%ncid, varid, values, start=start, count=count)) + end subroutine + + subroutine cable_netcdf_read_darray_int32(this, var_name, values, decomp, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(..) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + integer(kind=CABLE_NETCDF_INT32_KIND), allocatable :: values_filled(:) + integer :: i, varid, ndims + integer :: dimids(NF90_MAX_VAR_DIMS), starts(NF90_MAX_VAR_DIMS), counts(NF90_MAX_VAR_DIMS), mem_index(CABLE_NETCDF_MAX_RANK) + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + allocate(values_filled(product(decomp%dims))) + call check_nf90(nf90_inquire_variable(this%ncid, varid, dimids=dimids, ndims=ndims)) + do i = 1, ndims + starts(i) = 1 + call check_nf90(nf90_inquire_dimension(this%ncid, dimids(i), len=counts(i))) + end do + if (present(frame)) then + starts(ndims) = frame + counts(ndims) = 1 + end if + call check_nf90( & + nf90_get_var( & + this%ncid, & + varid, & + values_filled, & + start=starts(:ndims), & + count=counts(:ndims), & + map=[1, (product(decomp%dims(:i)), i = 1, size(decomp%dims) - 1)] & + ) & + ) + select rank(values) + rank(1) + do i = 1, size(values) + values(i) = values_filled(decomp%compmap(i)) + end do + rank(2) + do i = 1, size(values) + call array_index(i, shape(values), mem_index(:2)) + values(mem_index(1), mem_index(2)) = values_filled(decomp%compmap(i)) + end do + rank(3) + do i = 1, size(values) + call array_index(i, shape(values), mem_index(:3)) + values(mem_index(1), mem_index(2), mem_index(3)) = values_filled(decomp%compmap(i)) + end do + end select + end subroutine cable_netcdf_read_darray_int32 + + subroutine cable_netcdf_nf90_file_read_darray_int32_1d(this, var_name, values, decomp, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_read_darray_int32(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_nf90_file_read_darray_int32_2d(this, var_name, values, decomp, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_read_darray_int32(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_nf90_file_read_darray_int32_3d(this, var_name, values, decomp, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_read_darray_int32(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_read_darray_real32(this, var_name, values, decomp, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(..) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + real(kind=CABLE_NETCDF_REAL32_KIND), allocatable :: values_filled(:) + integer :: i, varid, ndims + integer :: dimids(NF90_MAX_VAR_DIMS), starts(NF90_MAX_VAR_DIMS), counts(NF90_MAX_VAR_DIMS), mem_index(CABLE_NETCDF_MAX_RANK) + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + allocate(values_filled(product(decomp%dims))) + call check_nf90(nf90_inquire_variable(this%ncid, varid, dimids=dimids, ndims=ndims)) + do i = 1, ndims + starts(i) = 1 + call check_nf90(nf90_inquire_dimension(this%ncid, dimids(i), len=counts(i))) + end do + if (present(frame)) then + starts(ndims) = frame + counts(ndims) = 1 + end if + call check_nf90( & + nf90_get_var( & + this%ncid, & + varid, & + values_filled, & + start=starts(:ndims), & + count=counts(:ndims), & + map=[1, (product(decomp%dims(:i)), i = 1, size(decomp%dims) - 1)] & + ) & + ) + select rank(values) + rank(1) + do i = 1, size(values) + values(i) = values_filled(decomp%compmap(i)) + end do + rank(2) + do i = 1, size(values) + call array_index(i, shape(values), mem_index(:2)) + values(mem_index(1), mem_index(2)) = values_filled(decomp%compmap(i)) + end do + rank(3) + do i = 1, size(values) + call array_index(i, shape(values), mem_index(:3)) + values(mem_index(1), mem_index(2), mem_index(3)) = values_filled(decomp%compmap(i)) + end do + end select + end subroutine cable_netcdf_read_darray_real32 + + subroutine cable_netcdf_nf90_file_read_darray_real32_1d(this, var_name, values, decomp, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_read_darray_real32(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_nf90_file_read_darray_real32_2d(this, var_name, values, decomp, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_read_darray_real32(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_nf90_file_read_darray_real32_3d(this, var_name, values, decomp, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_read_darray_real32(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_read_darray_real64(this, var_name, values, decomp, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(..) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + real(kind=CABLE_NETCDF_REAL64_KIND), allocatable :: values_filled(:) + integer :: i, varid, ndims + integer :: dimids(NF90_MAX_VAR_DIMS), starts(NF90_MAX_VAR_DIMS), counts(NF90_MAX_VAR_DIMS), mem_index(CABLE_NETCDF_MAX_RANK) + call check_nf90(nf90_inq_varid(this%ncid, var_name, varid)) + allocate(values_filled(product(decomp%dims))) + call check_nf90(nf90_inquire_variable(this%ncid, varid, dimids=dimids, ndims=ndims)) + do i = 1, ndims + starts(i) = 1 + call check_nf90(nf90_inquire_dimension(this%ncid, dimids(i), len=counts(i))) + end do + if (present(frame)) then + starts(ndims) = frame + counts(ndims) = 1 + end if + call check_nf90( & + nf90_get_var( & + this%ncid, & + varid, & + values_filled, & + start=starts(:ndims), & + count=counts(:ndims), & + map=[1, (product(decomp%dims(:i)), i = 1, size(decomp%dims) - 1)] & + ) & + ) + select rank(values) + rank(1) + do i = 1, size(values) + values(i) = values_filled(decomp%compmap(i)) + end do + rank(2) + do i = 1, size(values) + call array_index(i, shape(values), mem_index(:2)) + values(mem_index(1), mem_index(2)) = values_filled(decomp%compmap(i)) + end do + rank(3) + do i = 1, size(values) + call array_index(i, shape(values), mem_index(:3)) + values(mem_index(1), mem_index(2), mem_index(3)) = values_filled(decomp%compmap(i)) + end do + end select + end subroutine cable_netcdf_read_darray_real64 + + subroutine cable_netcdf_nf90_file_read_darray_real64_1d(this, var_name, values, decomp, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_read_darray_real64(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_nf90_file_read_darray_real64_2d(this, var_name, values, decomp, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_read_darray_real64(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_nf90_file_read_darray_real64_3d(this, var_name, values, decomp, frame) + class(cable_netcdf_nf90_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_read_darray_real64(this, var_name, values, decomp, frame) + end subroutine + +end module cable_netcdf_nf90_mod diff --git a/src/util/netcdf/pio/cable_netcdf_pio.F90 b/src/util/netcdf/pio/cable_netcdf_pio.F90 new file mode 100644 index 000000000..3a2cacb20 --- /dev/null +++ b/src/util/netcdf/pio/cable_netcdf_pio.F90 @@ -0,0 +1,1052 @@ +module cable_netcdf_pio_mod + use cable_netcdf_mod + + use cable_mpi_mod, only: mpi_grp_t + use cable_abort_module, only: cable_abort + + use pio, only: pio_file_desc_t => file_desc_t + use pio, only: pio_iosystem_desc_t => iosystem_desc_t + use pio, only: pio_io_desc_t => io_desc_t + use pio, only: pio_var_desc_t => var_desc_t + use pio, only: pio_init + use pio, only: pio_initdecomp + use pio, only: pio_createfile + use pio, only: pio_openfile + use pio, only: pio_closefile + use pio, only: pio_syncfile + use pio, only: pio_def_dim + use pio, only: pio_def_var + use pio, only: pio_put_att + use pio, only: pio_get_att + use pio, only: pio_put_var + use pio, only: pio_get_var + use pio, only: pio_setframe + use pio, only: pio_write_darray + use pio, only: pio_read_darray + use pio, only: pio_strerror + use pio, only: pio_enddef + use pio, only: pio_inq_dimid + use pio, only: pio_inquire_dimension + use pio, only: pio_inq_varid + use pio, only: pio_finalize + use pio, only: PIO_MAX_NAME + use pio, only: PIO_OFFSET_KIND + use pio, only: PIO_INT + use pio, only: PIO_REAL + use pio, only: PIO_DOUBLE + use pio, only: PIO_REARR_BOX + use pio, only: PIO_IOTYPE_NETCDF4C + use pio, only: PIO_CLOBBER + use pio, only: PIO_UNLIMITED + use pio, only: PIO_NOERR + use pio, only: PIO_GLOBAL + implicit none + + private + public :: cable_netcdf_pio_io_t + + type, extends(cable_netcdf_decomp_t) :: cable_netcdf_pio_decomp_t + type(pio_io_desc_t), private :: pio_io_desc + end type + + type, extends(cable_netcdf_io_t) :: cable_netcdf_pio_io_t + private + type(mpi_grp_t) :: mpi_grp + type(pio_iosystem_desc_t) :: pio_iosystem_desc + contains + procedure :: init => cable_netcdf_pio_io_init + procedure :: finalise => cable_netcdf_pio_io_finalise + procedure :: create_file => cable_netcdf_pio_io_create_file + procedure :: open_file => cable_netcdf_pio_io_open_file + procedure :: create_decomp => cable_netcdf_pio_io_create_decomp + end type + + interface cable_netcdf_pio_io_t + procedure cable_netcdf_pio_io_constructor + end interface + + type, extends(cable_netcdf_file_t) :: cable_netcdf_pio_file_t + type(pio_file_desc_t), private :: pio_file_desc + contains + procedure :: close => cable_netcdf_pio_file_close + procedure :: end_def => cable_netcdf_pio_file_end_def + procedure :: sync => cable_netcdf_pio_file_sync + procedure :: def_dims => cable_netcdf_pio_file_def_dims + procedure :: def_var => cable_netcdf_pio_file_def_var + procedure :: put_att_global_string => cable_netcdf_pio_file_put_att_global_string + procedure :: put_att_global_int32 => cable_netcdf_pio_file_put_att_global_int32 + procedure :: put_att_global_real32 => cable_netcdf_pio_file_put_att_global_real32 + procedure :: put_att_global_real64 => cable_netcdf_pio_file_put_att_global_real64 + procedure :: put_att_var_string => cable_netcdf_pio_file_put_att_var_string + procedure :: put_att_var_int32 => cable_netcdf_pio_file_put_att_var_int32 + procedure :: put_att_var_real32 => cable_netcdf_pio_file_put_att_var_real32 + procedure :: put_att_var_real64 => cable_netcdf_pio_file_put_att_var_real64 + procedure :: get_att_global_string => cable_netcdf_pio_file_get_att_global_string + procedure :: get_att_global_int32 => cable_netcdf_pio_file_get_att_global_int32 + procedure :: get_att_global_real32 => cable_netcdf_pio_file_get_att_global_real32 + procedure :: get_att_global_real64 => cable_netcdf_pio_file_get_att_global_real64 + procedure :: get_att_var_string => cable_netcdf_pio_file_get_att_var_string + procedure :: get_att_var_int32 => cable_netcdf_pio_file_get_att_var_int32 + procedure :: get_att_var_real32 => cable_netcdf_pio_file_get_att_var_real32 + procedure :: get_att_var_real64 => cable_netcdf_pio_file_get_att_var_real64 + procedure :: inq_dim_len => cable_netcdf_pio_file_inq_dim_len + procedure :: put_var_int32_0d => cable_netcdf_pio_file_put_var_int32_0d + procedure :: put_var_int32_1d => cable_netcdf_pio_file_put_var_int32_1d + procedure :: put_var_int32_2d => cable_netcdf_pio_file_put_var_int32_2d + procedure :: put_var_int32_3d => cable_netcdf_pio_file_put_var_int32_3d + procedure :: put_var_real32_0d => cable_netcdf_pio_file_put_var_real32_0d + procedure :: put_var_real32_1d => cable_netcdf_pio_file_put_var_real32_1d + procedure :: put_var_real32_2d => cable_netcdf_pio_file_put_var_real32_2d + procedure :: put_var_real32_3d => cable_netcdf_pio_file_put_var_real32_3d + procedure :: put_var_real64_0d => cable_netcdf_pio_file_put_var_real64_0d + procedure :: put_var_real64_1d => cable_netcdf_pio_file_put_var_real64_1d + procedure :: put_var_real64_2d => cable_netcdf_pio_file_put_var_real64_2d + procedure :: put_var_real64_3d => cable_netcdf_pio_file_put_var_real64_3d + procedure :: write_darray_int32_1d => cable_netcdf_pio_file_write_darray_int32_1d + procedure :: write_darray_int32_2d => cable_netcdf_pio_file_write_darray_int32_2d + procedure :: write_darray_int32_3d => cable_netcdf_pio_file_write_darray_int32_3d + procedure :: write_darray_real32_1d => cable_netcdf_pio_file_write_darray_real32_1d + procedure :: write_darray_real32_2d => cable_netcdf_pio_file_write_darray_real32_2d + procedure :: write_darray_real32_3d => cable_netcdf_pio_file_write_darray_real32_3d + procedure :: write_darray_real64_1d => cable_netcdf_pio_file_write_darray_real64_1d + procedure :: write_darray_real64_2d => cable_netcdf_pio_file_write_darray_real64_2d + procedure :: write_darray_real64_3d => cable_netcdf_pio_file_write_darray_real64_3d + procedure :: get_var_int32_0d => cable_netcdf_pio_file_get_var_int32_0d + procedure :: get_var_int32_1d => cable_netcdf_pio_file_get_var_int32_1d + procedure :: get_var_int32_2d => cable_netcdf_pio_file_get_var_int32_2d + procedure :: get_var_int32_3d => cable_netcdf_pio_file_get_var_int32_3d + procedure :: get_var_real32_0d => cable_netcdf_pio_file_get_var_real32_0d + procedure :: get_var_real32_1d => cable_netcdf_pio_file_get_var_real32_1d + procedure :: get_var_real32_2d => cable_netcdf_pio_file_get_var_real32_2d + procedure :: get_var_real32_3d => cable_netcdf_pio_file_get_var_real32_3d + procedure :: get_var_real64_0d => cable_netcdf_pio_file_get_var_real64_0d + procedure :: get_var_real64_1d => cable_netcdf_pio_file_get_var_real64_1d + procedure :: get_var_real64_2d => cable_netcdf_pio_file_get_var_real64_2d + procedure :: get_var_real64_3d => cable_netcdf_pio_file_get_var_real64_3d + procedure :: read_darray_int32_1d => cable_netcdf_pio_file_read_darray_int32_1d + procedure :: read_darray_int32_2d => cable_netcdf_pio_file_read_darray_int32_2d + procedure :: read_darray_int32_3d => cable_netcdf_pio_file_read_darray_int32_3d + procedure :: read_darray_real32_1d => cable_netcdf_pio_file_read_darray_real32_1d + procedure :: read_darray_real32_2d => cable_netcdf_pio_file_read_darray_real32_2d + procedure :: read_darray_real32_3d => cable_netcdf_pio_file_read_darray_real32_3d + procedure :: read_darray_real64_1d => cable_netcdf_pio_file_read_darray_real64_1d + procedure :: read_darray_real64_2d => cable_netcdf_pio_file_read_darray_real64_2d + procedure :: read_darray_real64_3d => cable_netcdf_pio_file_read_darray_real64_3d + end type + +contains + + function type_pio(basetype) + integer, intent(in) :: basetype + integer :: type_pio + select case(basetype) + case(CABLE_NETCDF_INT) + type_pio = PIO_INT + case(CABLE_NETCDF_FLOAT) + type_pio = PIO_REAL + case(CABLE_NETCDF_DOUBLE) + type_pio = PIO_DOUBLE + case default + call cable_abort("cable_netcdf_pio_mod: Error: type not supported") + end select + end function type_pio + + subroutine check_pio(status) + integer, intent(in) :: status + integer :: strerror_status + character(len=PIO_MAX_NAME) :: err_msg + if (status /= PIO_NOERR) then + strerror_status = pio_strerror(status, err_msg) + call cable_abort(trim(err_msg), file=__FILE__, line=__LINE__) + end if + end subroutine check_pio + + subroutine get_start_count_nonoptionals(start_nonopt, count_nonopt, shape, start, count) + integer, allocatable, intent(out) :: start_nonopt(:), count_nonopt(:) + integer, intent(in) :: shape(:) + integer, optional, intent(in) :: start(:), count(:) + if (present(start)) then + start_nonopt = start + else + allocate(start_nonopt, mold=shape) + start_nonopt = 1 + end if + if (present(count)) then + count_nonopt = count + else + allocate(count_nonopt, source=shape) + end if + end subroutine + + function cable_netcdf_pio_io_constructor(mpi_grp) result(this) + type(cable_netcdf_pio_io_t) :: this + type(mpi_grp_t), intent(in) :: mpi_grp + this%mpi_grp = mpi_grp + end function + + subroutine cable_netcdf_pio_io_init(this) + class(cable_netcdf_pio_io_t), intent(inout) :: this + ! TODO: get PIO configuration settings + call pio_init( & + comp_rank=this%mpi_grp%rank, & + comp_comm=this%mpi_grp%comm%mpi_val, & + num_iotasks=1, & + num_aggregator=0, & ! This argument is obsolete (see https://github.com/NCAR/ParallelIO/issues/1888) + stride=1, & + rearr=PIO_REARR_BOX, & + iosystem=this%pio_iosystem_desc, & + base=1 & + ) + end subroutine + + subroutine cable_netcdf_pio_io_finalise(this) + class(cable_netcdf_pio_io_t), intent(inout) :: this + integer :: status + call pio_finalize(this%pio_iosystem_desc, status) + call check_pio(status) + end subroutine + + + function cable_netcdf_pio_io_create_file(this, path) result(file) + class(cable_netcdf_pio_io_t), intent(inout) :: this + character(len=*), intent(in) :: path + class(cable_netcdf_file_t), allocatable :: file + type(pio_file_desc_t) :: pio_file_desc + call check_pio(pio_createfile(this%pio_iosystem_desc, pio_file_desc, PIO_IOTYPE_NETCDF4C, path, PIO_CLOBBER)) + file = cable_netcdf_pio_file_t(pio_file_desc) + end function + + function cable_netcdf_pio_io_open_file(this, path) result(file) + class(cable_netcdf_pio_io_t), intent(inout) :: this + character(len=*), intent(in) :: path + class(cable_netcdf_file_t), allocatable :: file + type(pio_file_desc_t) :: pio_file_desc + call check_pio(pio_openfile(this%pio_iosystem_desc, pio_file_desc, PIO_IOTYPE_NETCDF4C, path)) + file = cable_netcdf_pio_file_t(pio_file_desc) + end function + + function cable_netcdf_pio_io_create_decomp(this, compmap, dims, type) result(decomp) + class(cable_netcdf_pio_io_t), intent(inout) :: this + integer, intent(in) :: compmap(:), dims(:) + integer, intent(in) :: type + class(cable_netcdf_decomp_t), allocatable :: decomp + type(pio_io_desc_t) :: pio_io_desc + call pio_initdecomp( & + this%pio_iosystem_desc, & + type_pio(type), & + dims, & + compmap, & + pio_io_desc & + ) + allocate(decomp, source=cable_netcdf_pio_decomp_t(compmap, dims, type, pio_io_desc=pio_io_desc)) + end function + + subroutine cable_netcdf_pio_file_close(this) + class(cable_netcdf_pio_file_t), intent(inout) :: this + call pio_closefile(this%pio_file_desc) + end subroutine + + subroutine cable_netcdf_pio_file_end_def(this) + class(cable_netcdf_pio_file_t), intent(inout) :: this + call check_pio(pio_enddef(this%pio_file_desc)) + end subroutine + + subroutine cable_netcdf_pio_file_sync(this) + class(cable_netcdf_pio_file_t), intent(inout) :: this + call pio_syncfile(this%pio_file_desc) + end subroutine + + subroutine cable_netcdf_pio_file_def_dims(this, dim_names, dim_lens) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: dim_names(:) + integer, intent(in) :: dim_lens(:) + integer :: i, tmp + do i = 1, size(dim_names) + if (dim_lens(i) == CABLE_NETCDF_UNLIMITED) then + call check_pio(pio_def_dim(this%pio_file_desc, dim_names(i), PIO_UNLIMITED, tmp)) + else + call check_pio(pio_def_dim(this%pio_file_desc, dim_names(i), dim_lens(i), tmp)) + end if + end do + end subroutine + + subroutine cable_netcdf_pio_file_def_var(this, var_name, dim_names, type) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, dim_names(:) + integer, intent(in) :: type + integer, allocatable :: dimids(:) + integer :: i + type(pio_var_desc_t) :: tmp + allocate(dimids(size(dim_names))) + do i = 1, size(dimids) + call check_pio(pio_inq_dimid(this%pio_file_desc, dim_names(i), dimids(i))) + end do + call check_pio(pio_def_var(this%pio_file_desc, var_name, type_pio(type), dimids, tmp)) + end subroutine + + subroutine cable_netcdf_pio_file_put_att_global_string(this, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name, att_value + call check_pio(pio_put_att(this%pio_file_desc, PIO_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_put_att_global_int32(this, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: att_value + call check_pio(pio_put_att(this%pio_file_desc, PIO_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_put_att_global_real32(this, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: att_value + call check_pio(pio_put_att(this%pio_file_desc, PIO_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_put_att_global_real64(this, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: att_value + call check_pio(pio_put_att(this%pio_file_desc, PIO_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_put_att_var_string(this, var_name, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name, att_value + type(pio_var_desc_t) :: var_desc + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_att(this%pio_file_desc, var_desc, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_put_att_var_int32(this, var_name, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: att_value + type(pio_var_desc_t) :: var_desc + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_att(this%pio_file_desc, var_desc, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_put_att_var_real32(this, var_name, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: att_value + type(pio_var_desc_t) :: var_desc + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_att(this%pio_file_desc, var_desc, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_put_att_var_real64(this, var_name, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: att_value + type(pio_var_desc_t) :: var_desc + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_att(this%pio_file_desc, var_desc, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_get_att_global_string(this, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + character(len=*), intent(out) :: att_value + call check_pio(pio_get_att(this%pio_file_desc, PIO_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_get_att_global_int32(this, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: att_value + call check_pio(pio_get_att(this%pio_file_desc, PIO_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_get_att_global_real32(this, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: att_value + call check_pio(pio_get_att(this%pio_file_desc, PIO_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_get_att_global_real64(this, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: att_value + call check_pio(pio_get_att(this%pio_file_desc, PIO_GLOBAL, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_get_att_var_string(this, var_name, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + character(len=*), intent(out) :: att_value + type(pio_var_desc_t) :: var_desc + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_att(this%pio_file_desc, var_desc, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_get_att_var_int32(this, var_name, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: att_value + type(pio_var_desc_t) :: var_desc + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_att(this%pio_file_desc, var_desc, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_get_att_var_real32(this, var_name, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: att_value + type(pio_var_desc_t) :: var_desc + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_att(this%pio_file_desc, var_desc, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_get_att_var_real64(this, var_name, att_name, att_value) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name, att_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: att_value + type(pio_var_desc_t) :: var_desc + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_att(this%pio_file_desc, var_desc, att_name, att_value)) + end subroutine + + subroutine cable_netcdf_pio_file_inq_dim_len(this, dim_name, dim_len) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: dim_name + integer, intent(out) :: dim_len + integer :: dimid + call check_pio(pio_inq_dimid(this%pio_file_desc, dim_name, dimid)) + call check_pio(pio_inquire_dimension(this%pio_file_desc, dimid, len=dim_len)) + end subroutine + + subroutine cable_netcdf_pio_file_put_var_int32_0d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, [1], start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_var(this%pio_file_desc, var_desc, start_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_put_var_int32_1d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_put_var_int32_2d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_put_var_int32_3d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_put_var_real32_0d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, [1], start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_var(this%pio_file_desc, var_desc, start_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_put_var_real32_1d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_put_var_real32_2d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_put_var_real32_3d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_put_var_real64_0d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, [1], start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_var(this%pio_file_desc, var_desc, start_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_put_var_real64_1d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_put_var_real64_2d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_put_var_real64_3d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_put_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_write_darray_int32(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(..) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + integer :: status + type(pio_var_desc_t) :: var_desc + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + if (present(frame)) then + call pio_setframe(this%pio_file_desc, var_desc, int(frame, PIO_OFFSET_KIND)) + end if + select type(decomp) + type is (cable_netcdf_pio_decomp_t) + select rank(values) + rank(1) + call pio_write_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status, fill_value) + rank(2) + call pio_write_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status, fill_value) + rank(3) + call pio_write_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status, fill_value) + end select + call check_pio(status) + class default + call cable_abort("Error: decomp must be of type cable_netcdf_pio_decomp_t", file=__FILE__, line=__LINE__) + end select + end subroutine + + subroutine cable_netcdf_pio_file_write_darray_int32_1d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_write_darray_int32(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_pio_file_write_darray_int32_2d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_write_darray_int32(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_pio_file_write_darray_int32_3d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer(kind=CABLE_NETCDF_INT32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_write_darray_int32(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_pio_file_write_darray_real32(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(..) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + integer :: status + type(pio_var_desc_t) :: var_desc + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + if (present(frame)) then + call pio_setframe(this%pio_file_desc, var_desc, int(frame, PIO_OFFSET_KIND)) + end if + select type(decomp) + type is (cable_netcdf_pio_decomp_t) + select rank(values) + rank(1) + call pio_write_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status, fill_value) + rank(2) + call pio_write_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status, fill_value) + rank(3) + call pio_write_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status, fill_value) + end select + call check_pio(status) + class default + call cable_abort("Error: decomp must be of type cable_netcdf_pio_decomp_t", file=__FILE__, line=__LINE__) + end select + end subroutine + + subroutine cable_netcdf_pio_file_write_darray_real32_1d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_write_darray_real32(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_pio_file_write_darray_real32_2d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_write_darray_real32(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_pio_file_write_darray_real32_3d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL32_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_write_darray_real32(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_pio_file_write_darray_real64(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(..) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + integer :: status + type(pio_var_desc_t) :: var_desc + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + if (present(frame)) then + call pio_setframe(this%pio_file_desc, var_desc, int(frame, PIO_OFFSET_KIND)) + end if + select type(decomp) + type is (cable_netcdf_pio_decomp_t) + select rank(values) + rank(1) + call pio_write_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status, fill_value) + rank(2) + call pio_write_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status, fill_value) + rank(3) + call pio_write_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status, fill_value) + end select + call check_pio(status) + class default + call cable_abort("Error: decomp must be of type cable_netcdf_pio_decomp_t", file=__FILE__, line=__LINE__) + end select + end subroutine + + subroutine cable_netcdf_pio_file_write_darray_real64_1d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_write_darray_real64(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_pio_file_write_darray_real64_2d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_write_darray_real64(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_pio_file_write_darray_real64_3d(this, var_name, values, decomp, fill_value, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + real(kind=CABLE_NETCDF_REAL64_KIND), intent(in), optional :: fill_value + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_write_darray_real64(this, var_name, values, decomp, fill_value, frame) + end subroutine + + subroutine cable_netcdf_pio_file_get_var_int32_0d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, [1], start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_var(this%pio_file_desc, var_desc, start_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_get_var_int32_1d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_get_var_int32_2d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_get_var_int32_3d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_get_var_real32_0d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, [1], start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_var(this%pio_file_desc, var_desc, start_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_get_var_real32_1d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_get_var_real32_2d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_get_var_real32_3d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_get_var_real64_0d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, [1], start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_var(this%pio_file_desc, var_desc, start_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_get_var_real64_1d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_get_var_real64_2d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_get_var_real64_3d(this, var_name, values, start, count) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :, :) + integer, intent(in), optional :: start(:), count(:) + integer, allocatable :: start_nonopt(:), count_nonopt(:) + type(pio_var_desc_t) :: var_desc + call get_start_count_nonoptionals(start_nonopt, count_nonopt, shape(values), start, count) + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + call check_pio(pio_get_var(this%pio_file_desc, var_desc, start_nonopt, count_nonopt, values)) + end subroutine + + subroutine cable_netcdf_pio_file_read_darray_int32(this, var_name, values, decomp, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(..) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + integer :: status + type(pio_var_desc_t) :: var_desc + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + if (present(frame)) then + call pio_setframe(this%pio_file_desc, var_desc, int(frame, PIO_OFFSET_KIND)) + end if + select type(decomp) + type is (cable_netcdf_pio_decomp_t) + select rank(values) + rank(1) + call pio_read_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status) + rank(2) + call pio_read_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status) + rank(3) + call pio_read_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status) + end select + call check_pio(status) + class default + call cable_abort("Error: decomp must be of type cable_netcdf_pio_decomp_t", file=__FILE__, line=__LINE__) + end select + end subroutine + + subroutine cable_netcdf_pio_file_read_darray_int32_1d(this, var_name, values, decomp, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_read_darray_int32(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_pio_file_read_darray_int32_2d(this, var_name, values, decomp, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_read_darray_int32(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_pio_file_read_darray_int32_3d(this, var_name, values, decomp, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer(kind=CABLE_NETCDF_INT32_KIND), intent(out) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_read_darray_int32(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_pio_file_read_darray_real32(this, var_name, values, decomp, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(..) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + integer :: status + type(pio_var_desc_t) :: var_desc + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + if (present(frame)) then + call pio_setframe(this%pio_file_desc, var_desc, int(frame, PIO_OFFSET_KIND)) + end if + select type(decomp) + type is (cable_netcdf_pio_decomp_t) + select rank(values) + rank(1) + call pio_read_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status) + rank(2) + call pio_read_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status) + rank(3) + call pio_read_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status) + end select + call check_pio(status) + class default + call cable_abort("Error: decomp must be of type cable_netcdf_pio_decomp_t", file=__FILE__, line=__LINE__) + end select + end subroutine + + subroutine cable_netcdf_pio_file_read_darray_real32_1d(this, var_name, values, decomp, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_read_darray_real32(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_pio_file_read_darray_real32_2d(this, var_name, values, decomp, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_read_darray_real32(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_pio_file_read_darray_real32_3d(this, var_name, values, decomp, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL32_KIND), intent(out) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_read_darray_real32(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_pio_file_read_darray_real64(this, var_name, values, decomp, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(..) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + integer :: status + type(pio_var_desc_t) :: var_desc + call check_pio(pio_inq_varid(this%pio_file_desc, var_name, var_desc)) + if (present(frame)) then + call pio_setframe(this%pio_file_desc, var_desc, int(frame, PIO_OFFSET_KIND)) + end if + select type(decomp) + type is (cable_netcdf_pio_decomp_t) + select rank(values) + rank(1) + call pio_read_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status) + rank(2) + call pio_read_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status) + rank(3) + call pio_read_darray(this%pio_file_desc, var_desc, decomp%pio_io_desc, values, status) + end select + call check_pio(status) + class default + call cable_abort("Error: decomp must be of type cable_netcdf_pio_decomp_t", file=__FILE__, line=__LINE__) + end select + end subroutine + + subroutine cable_netcdf_pio_file_read_darray_real64_1d(this, var_name, values, decomp, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_read_darray_real64(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_pio_file_read_darray_real64_2d(this, var_name, values, decomp, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_read_darray_real64(this, var_name, values, decomp, frame) + end subroutine + + subroutine cable_netcdf_pio_file_read_darray_real64_3d(this, var_name, values, decomp, frame) + class(cable_netcdf_pio_file_t), intent(inout) :: this + character(len=*), intent(in) :: var_name + real(kind=CABLE_NETCDF_REAL64_KIND), intent(out) :: values(:, :, :) + class(cable_netcdf_decomp_t), intent(inout) :: decomp + integer, intent(in), optional :: frame + call cable_netcdf_pio_file_read_darray_real64(this, var_name, values, decomp, frame) + end subroutine + +end module cable_netcdf_pio_mod diff --git a/src/util/netcdf/pio/cable_netcdf_pio_stub.F90 b/src/util/netcdf/pio/cable_netcdf_pio_stub.F90 new file mode 100644 index 000000000..e9ae55113 --- /dev/null +++ b/src/util/netcdf/pio/cable_netcdf_pio_stub.F90 @@ -0,0 +1,26 @@ +module cable_netcdf_pio_mod + use cable_netcdf_mod + use cable_mpi_mod, only: mpi_grp_t + use cable_abort_module, only: cable_abort + use cable_netcdf_stub_types_mod, only: cable_netcdf_stub_io_t + use cable_netcdf_stub_types_mod, only: cable_netcdf_pio_decomp_t => cable_netcdf_stub_decomp_t + use cable_netcdf_stub_types_mod, only: cable_netcdf_pio_file_t => cable_netcdf_stub_file_t + implicit none + + type, extends(cable_netcdf_stub_io_t) :: cable_netcdf_pio_io_t + end type + + interface cable_netcdf_pio_io_t + procedure cable_netcdf_pio_io_constructor + end interface + +contains + + function cable_netcdf_pio_io_constructor(mpi_grp) result(this) + type(cable_netcdf_pio_io_t) :: this + type(mpi_grp_t), intent(in) :: mpi_grp + call cable_abort("Error instantiating cable_netcdf_pio_io_t: PIO support not available", file=__FILE__, line=__LINE__) + this = cable_netcdf_pio_io_t() + end function + +end module cable_netcdf_pio_mod diff --git a/tests/cable_tests.F90 b/tests/cable_tests.F90 new file mode 100644 index 000000000..ed7a15bb2 --- /dev/null +++ b/tests/cable_tests.F90 @@ -0,0 +1,26 @@ +module cable_tests + use fortuno_interface_m, only: test_list + use test_cable_netcdf, only: cable_netcdf_test_list + implicit none + +contains + + function tests() + type(test_list) :: tests + tests = test_list([& + cable_netcdf_test_list()& + ]) + end function tests + +end module cable_tests + +program test_cable + + use fortuno_interface_m, only: execute_cmd_app + use cable_tests, only: tests + + implicit none + + call execute_cmd_app(tests()) + +end program test_cable diff --git a/tests/fixtures.F90 b/tests/fixtures.F90 new file mode 100644 index 000000000..61839151e --- /dev/null +++ b/tests/fixtures.F90 @@ -0,0 +1,95 @@ +module fixtures_mod + use fortuno_interface_m, only: test_case_t, test_item, check, check_failed, global_comm, num_ranks, this_rank + use cable_mpi_mod, only: mpi_grp_t, MPI_COMM_UNDEFINED + use file_utils, only: file_delete_collective + use cable_netcdf_mod, only: cable_netcdf_io_t, CABLE_NETCDF_MAX_STR_LEN_FILE + use cable_netcdf_nf90_mod, only: cable_netcdf_nf90_io_t + use cable_netcdf_pio_mod, only: cable_netcdf_pio_io_t + implicit none + + private + + public :: test_case_nf90, test_case_pio, io_handler_factory_interface + + character(len=CABLE_NETCDF_MAX_STR_LEN_FILE), parameter :: nc_file_name = "file.nc" + + type, extends(test_case_t) :: test_case_cable_netcdf_nf90_t + procedure(cable_netcdf_test_interface), pointer, nopass :: test + contains + procedure :: run => run_test_cable_netcdf_nf90 + end type test_case_cable_netcdf_nf90_t + + type, extends(test_case_t) :: test_case_cable_netcdf_pio_t + procedure(cable_netcdf_test_interface), pointer, nopass :: test + contains + procedure :: run => run_test_pio + end type test_case_cable_netcdf_pio_t + + abstract interface + function io_handler_factory_interface() result(io_handler) + import cable_netcdf_io_t + class(cable_netcdf_io_t), allocatable :: io_handler + end function + subroutine cable_netcdf_test_interface(io_handler_factory, file_name) + import cable_netcdf_io_t, io_handler_factory_interface + procedure(io_handler_factory_interface), pointer, intent(in) :: io_handler_factory + character(*), intent(in) :: file_name + end subroutine + end interface + +contains + + function test_case_nf90(name, test) result(testitem) + character(*), intent(in) :: name + procedure(cable_netcdf_test_interface) :: test + type(test_item) :: testitem + testitem = test_item(test_case_cable_netcdf_nf90_t(name=name, test=test)) + end function test_case_nf90 + + function nf90_io_handler() result(io_handler) + class(cable_netcdf_io_t), allocatable :: io_handler + io_handler = cable_netcdf_nf90_io_t() + end function + + subroutine run_test_cable_netcdf_nf90(this) + class(test_case_cable_netcdf_nf90_t), intent(in) :: this + class(cable_netcdf_io_t), allocatable :: io_handler + + call check(num_ranks() == 1, msg="NetCDF tests must be run with a single process.") + if (check_failed()) return + + call this%test(nf90_io_handler, nc_file_name) + call file_delete_collective(nc_file_name) + + end subroutine run_test_cable_netcdf_nf90 + + function test_case_pio(name, test) result(testitem) + character(*), intent(in) :: name + procedure(cable_netcdf_test_interface) :: test + type(test_item) :: testitem + testitem = test_item(test_case_cable_netcdf_pio_t(name=name, test=test)) + end function test_case_pio + + function pio_io_handler() result(io_handler) + class(cable_netcdf_io_t), allocatable :: io_handler + io_handler = cable_netcdf_pio_io_t(mpi_grp_t(global_comm())) + end function + + subroutine run_test_pio(this) + class(test_case_cable_netcdf_pio_t), intent(in) :: this + class(cable_netcdf_io_t), allocatable :: io_handler + type(mpi_grp_t) :: mpi_grp + + mpi_grp = mpi_grp_t(global_comm()) + call check(& + mpi_grp%comm%mpi_val /= MPI_COMM_UNDEFINED%mpi_val,& + msg="MPI communicator must be defined for PIO tests"& + ) + if (check_failed()) return + + call this%test(pio_io_handler, nc_file_name) + call file_delete_collective(nc_file_name) + + end subroutine run_test_pio + +end module fixtures_mod diff --git a/tests/fortuno_interface_mpi.f90 b/tests/fortuno_interface_mpi.f90 new file mode 100644 index 000000000..5883822c9 --- /dev/null +++ b/tests/fortuno_interface_mpi.f90 @@ -0,0 +1,42 @@ +!! Copyright (C) 2024 Alex Buccheri +!! +!! This Source Code Form is subject to the terms of the Mozilla Public +!! License, v. 2.0. If a copy of the MPL was not distributed with this +!! file, You can obtain one at https://mozilla.org/MPL/2.0/. +!! + +!> @brief Expose Fortuno MPI data types and routines through common aliases. +!! +!! Alias MPI routine Description +!! ------------------------------------------------------------------------------------------------------ +!! execute_cmd_app execute_mpi_cmd_app Accepts an array of test_item, and runs them. +!! test_case_t mpi_case_base Base type for representing a test case. +!! test_case mpi_case_item Returns a test case instace as a generic test item. +!! suite mpi_suite_item Returns a suite instance wrapped as test_item. +!! check mpi_check Perform a logical check (assertion) on a condition. +!! check_failed mpi_check_failed Returns .true. if the previous check failed, .false. otherwise. +!! + +module fortuno_interface_m + + use fortuno_mpi, only : & + execute_cmd_app => execute_mpi_cmd_app, & + test_case_t => mpi_case_base, & + test_case => mpi_case_item, & + suite => mpi_suite_item, & + check => mpi_check, & + check_failed => mpi_check_failed, & + is_equal, & + all_equal, & + all_close, & + test_item, & + test_list, & + global_comm, & + num_ranks, & + this_rank + + implicit none + + ! Scope is deliberately public + +end module fortuno_interface_m diff --git a/tests/fortuno_interface_serial.f90 b/tests/fortuno_interface_serial.f90 new file mode 100644 index 000000000..58b3f4ccc --- /dev/null +++ b/tests/fortuno_interface_serial.f90 @@ -0,0 +1,58 @@ +!! Copyright (C) 2024 Alex Buccheri +!! +!! This Source Code Form is subject to the terms of the Mozilla Public +!! License, v. 2.0. If a copy of the MPL was not distributed with this +!! file, You can obtain one at https://mozilla.org/MPL/2.0/. +!! + +!> @brief Expose Fortuno serail data types and routines through common aliases. +!! +!! Alias Serial routine Description +!! ------------------------------------------------------------------------------------------------------ +!! execute_cmd_app execute_serial_cmd_app Accepts an array of test_item, and runs them. +!! test_case_t serial_case_base Base type for representing a test case. +!! test_case serial_case_item Returns a test case instace as a generic test item. +!! suite serial_suite_item Returns a suite instance wrapped as test_item. +!! check serial_check Perform a logical check (assertion) on a condition. +!! check_failed serial_check_failed Returns .true. if the previous check failed, .false. otherwise. +!! + +module fortuno_interface_m + + use fortuno_serial, only : & + execute_cmd_app => execute_serial_cmd_app, & + test_case_t => serial_case_base, & + test_case => serial_case_item, & + suite => serial_suite_item, & + check => serial_check, & + check_failed => serial_check_failed, & + is_equal, & + all_equal, & + all_close, & + test_item, & + test_list + + implicit none + + ! Scope is deliberately public + +contains + + function global_comm() + !! Serial stub for global_comm function. + use cable_mpi_stub_types_mod, only: MPI_COMM, MPI_COMM_NULL + type(MPI_COMM) global_comm + global_comm = MPI_COMM_NULL + end function + + integer function num_ranks() + !! Serial stub for num_ranks function. + num_ranks = 1 + end function + + integer function this_rank() + !! Serial stub for this_rank function. + this_rank = 0 + end function + +end module fortuno_interface_m diff --git a/tests/test_cable_netcdf.F90 b/tests/test_cable_netcdf.F90 new file mode 100644 index 000000000..dbe3144b0 --- /dev/null +++ b/tests/test_cable_netcdf.F90 @@ -0,0 +1,236 @@ +module test_cable_netcdf + use fortuno_interface_m, only: check, check_failed, suite, test_list, num_ranks, this_rank, all_equal, all_close + use fixtures_mod, only: test_case_nf90, test_case_pio, io_handler_factory_interface + use cable_netcdf_mod + use cable_netcdf_nf90_mod + use cable_netcdf_pio_mod + implicit none + + private + + public :: cable_netcdf_test_list + + integer, parameter :: LEN = 16 + integer, parameter :: VAL = 42 + +contains + + function cable_netcdf_test_list() + type(test_list) :: cable_netcdf_test_list + + cable_netcdf_test_list = test_list([& + test_case_nf90("test_cable_netcdf_nf90_write_darray_int32", test_write_read_darray_int32),& + test_case_nf90("test_cable_netcdf_nf90_write_darray_real32", test_write_read_darray_real32),& + test_case_nf90("test_cable_netcdf_nf90_write_darray_real64", test_write_read_darray_real64),& + suite("parallel", test_list([& + test_case_pio("test_cable_netcdf_pio_write_darray_int32", test_write_read_darray_int32),& + test_case_pio("test_cable_netcdf_pio_write_darray_real32", test_write_read_darray_real32),& + test_case_pio("test_cable_netcdf_pio_write_darray_real64", test_write_read_darray_real64)& + ]))& + ]) + + end function cable_netcdf_test_list + + logical function check_valid_decomp(compmap, start, end, block_per_pe) + integer, allocatable, intent(out) :: compmap(:) + integer, intent(out) :: start, end, block_per_pe + integer i + + block_per_pe = LEN / num_ranks() + + call check(mod(LEN, num_ranks()) == 0, msg="test_cable_netcdf.F90: work not divisible by number of ranks") + call check(block_per_pe > 0, msg="test_cable_netcdf.F90: not enough work to distribute among pes") + call check(mod(block_per_pe, 4) == 0, msg="test_cable_netcdf.F90: block_per_pe must be divisible by 4") + + check_valid_decomp = .not. check_failed() + if (check_failed()) return + + start = this_rank() * block_per_pe + 1 + end = start + block_per_pe - 1 + + allocate(compmap(start:end)) + compmap(start:end) = [(i, i=start, end, 1)] + + end function check_valid_decomp + + subroutine test_write_read_darray_int32(io_handler_factory, file_name) + procedure(io_handler_factory_interface), pointer, intent(in) :: io_handler_factory + character(*), intent(in) :: file_name + class(cable_netcdf_io_t), allocatable :: io_handler + class(cable_netcdf_file_t), allocatable :: file + class(cable_netcdf_decomp_t), allocatable :: decomp + integer, allocatable :: compmap(:) + integer :: block_per_pe, start, end, buffer_shape_2d(2), buffer_shape_3d(3) + integer(kind=CABLE_NETCDF_INT32_KIND), allocatable :: write_buffer_1d(:), write_buffer_2d(:, :), write_buffer_3d(:, :, :) + integer(kind=CABLE_NETCDF_INT32_KIND), allocatable :: read_buffer_1d(:), read_buffer_2d(:, :), read_buffer_3d(:, :, :) + + if (.not. check_valid_decomp(compmap, start, end, block_per_pe)) return + + buffer_shape_2d = [block_per_pe / 4, 4] + buffer_shape_3d = [block_per_pe / 4, 2, 2] + + io_handler = io_handler_factory() + + call io_handler%init() + + file = io_handler%create_file(file_name) + + allocate(write_buffer_1d(start:end), source=int(this_rank() + VAL, kind=CABLE_NETCDF_INT32_KIND)) + write_buffer_2d = reshape(write_buffer_1d, buffer_shape_2d) + write_buffer_3d = reshape(write_buffer_1d, buffer_shape_3d) + + allocate(read_buffer_1d(start:end), source=int(0, kind=CABLE_NETCDF_INT32_KIND)) + read_buffer_2d = reshape(read_buffer_1d, buffer_shape_2d) + read_buffer_3d = reshape(read_buffer_1d, buffer_shape_3d) + + decomp = io_handler%create_decomp(compmap, dims=[LEN], type=CABLE_NETCDF_INT) + + call file%def_dims(["i"], [LEN]) + + call file%def_var("values_1d", ["i"], CABLE_NETCDF_INT) + call file%def_var("values_2d", ["i"], CABLE_NETCDF_INT) + call file%def_var("values_3d", ["i"], CABLE_NETCDF_INT) + + call file%end_def() + + call file%write_darray("values_1d", write_buffer_1d, decomp) + call file%write_darray("values_2d", write_buffer_2d, decomp) + call file%write_darray("values_3d", write_buffer_3d, decomp) + + call file%sync() + + call file%read_darray("values_1d", read_buffer_1d, decomp) + call file%read_darray("values_2d", read_buffer_2d, decomp) + call file%read_darray("values_3d", read_buffer_3d, decomp) + + call check(all_equal(write_buffer_1d, read_buffer_1d)) + call check(all_equal(reshape(write_buffer_2d, [block_per_pe]), reshape(read_buffer_2d, [block_per_pe]))) + call check(all_equal(reshape(write_buffer_3d, [block_per_pe]), reshape(read_buffer_3d, [block_per_pe]))) + + call file%close() + + call io_handler%finalise() + + end subroutine test_write_read_darray_int32 + + subroutine test_write_read_darray_real32(io_handler_factory, file_name) + procedure(io_handler_factory_interface), pointer, intent(in) :: io_handler_factory + character(*), intent(in) :: file_name + class(cable_netcdf_io_t), allocatable :: io_handler + class(cable_netcdf_file_t), allocatable :: file + class(cable_netcdf_decomp_t), allocatable :: decomp + integer, allocatable :: compmap(:) + integer :: block_per_pe, start, end, buffer_shape_2d(2), buffer_shape_3d(3) + real(kind=CABLE_NETCDF_REAL32_KIND), allocatable :: write_buffer_1d(:), write_buffer_2d(:, :), write_buffer_3d(:, :, :) + real(kind=CABLE_NETCDF_REAL32_KIND), allocatable :: read_buffer_1d(:), read_buffer_2d(:, :), read_buffer_3d(:, :, :) + + if (.not. check_valid_decomp(compmap, start, end, block_per_pe)) return + + buffer_shape_2d = [block_per_pe / 4, 4] + buffer_shape_3d = [block_per_pe / 4, 2, 2] + + io_handler = io_handler_factory() + + call io_handler%init() + + file = io_handler%create_file(file_name) + + allocate(write_buffer_1d(start:end), source=real(this_rank() + VAL, kind=CABLE_NETCDF_REAL32_KIND)) + write_buffer_2d = reshape(write_buffer_1d, buffer_shape_2d) + write_buffer_3d = reshape(write_buffer_1d, buffer_shape_3d) + + allocate(read_buffer_1d(start:end), source=real(0, kind=CABLE_NETCDF_REAL32_KIND)) + read_buffer_2d = reshape(read_buffer_1d, buffer_shape_2d) + read_buffer_3d = reshape(read_buffer_1d, buffer_shape_3d) + + decomp = io_handler%create_decomp(compmap, dims=[LEN], type=CABLE_NETCDF_FLOAT) + + call file%def_dims(["i"], [LEN]) + + call file%def_var("values_1d", ["i"], CABLE_NETCDF_FLOAT) + call file%def_var("values_2d", ["i"], CABLE_NETCDF_FLOAT) + call file%def_var("values_3d", ["i"], CABLE_NETCDF_FLOAT) + + call file%end_def() + + call file%write_darray("values_1d", write_buffer_1d, decomp) + call file%write_darray("values_2d", write_buffer_2d, decomp) + call file%write_darray("values_3d", write_buffer_3d, decomp) + + call file%sync() + + call file%read_darray("values_1d", read_buffer_1d, decomp) + call file%read_darray("values_2d", read_buffer_2d, decomp) + call file%read_darray("values_3d", read_buffer_3d, decomp) + + call check(all_close(write_buffer_1d, read_buffer_1d)) + call check(all_close(reshape(write_buffer_2d, [block_per_pe]), reshape(read_buffer_2d, [block_per_pe]))) + call check(all_close(reshape(write_buffer_3d, [block_per_pe]), reshape(read_buffer_3d, [block_per_pe]))) + + call file%close() + + call io_handler%finalise() + + end subroutine test_write_read_darray_real32 + + subroutine test_write_read_darray_real64(io_handler_factory, file_name) + procedure(io_handler_factory_interface), pointer, intent(in) :: io_handler_factory + character(*), intent(in) :: file_name + class(cable_netcdf_io_t), allocatable :: io_handler + class(cable_netcdf_file_t), allocatable :: file + class(cable_netcdf_decomp_t), allocatable :: decomp + integer, allocatable :: compmap(:) + integer :: block_per_pe, start, end, buffer_shape_2d(2), buffer_shape_3d(3) + real(kind=CABLE_NETCDF_REAL64_KIND), allocatable :: write_buffer_1d(:), write_buffer_2d(:, :), write_buffer_3d(:, :, :) + real(kind=CABLE_NETCDF_REAL64_KIND), allocatable :: read_buffer_1d(:), read_buffer_2d(:, :), read_buffer_3d(:, :, :) + + if (.not. check_valid_decomp(compmap, start, end, block_per_pe)) return + + buffer_shape_2d = [block_per_pe / 4, 4] + buffer_shape_3d = [block_per_pe / 4, 2, 2] + + io_handler = io_handler_factory() + + call io_handler%init() + + file = io_handler%create_file(file_name) + + allocate(write_buffer_1d(start:end), source=real(this_rank() + VAL, kind=CABLE_NETCDF_REAL64_KIND)) + write_buffer_2d = reshape(write_buffer_1d, buffer_shape_2d) + write_buffer_3d = reshape(write_buffer_1d, buffer_shape_3d) + + allocate(read_buffer_1d(start:end), source=real(0, kind=CABLE_NETCDF_REAL64_KIND)) + read_buffer_2d = reshape(read_buffer_1d, buffer_shape_2d) + read_buffer_3d = reshape(read_buffer_1d, buffer_shape_3d) + + decomp = io_handler%create_decomp(compmap, dims=[LEN], type=CABLE_NETCDF_DOUBLE) + + call file%def_dims(["i"], [LEN]) + + call file%def_var("values_1d", ["i"], CABLE_NETCDF_DOUBLE) + call file%def_var("values_2d", ["i"], CABLE_NETCDF_DOUBLE) + call file%def_var("values_3d", ["i"], CABLE_NETCDF_DOUBLE) + + call file%end_def() + + call file%write_darray("values_1d", write_buffer_1d, decomp) + call file%write_darray("values_2d", write_buffer_2d, decomp) + call file%write_darray("values_3d", write_buffer_3d, decomp) + + call file%sync() + + call file%read_darray("values_1d", read_buffer_1d, decomp) + call file%read_darray("values_2d", read_buffer_2d, decomp) + call file%read_darray("values_3d", read_buffer_3d, decomp) + + call check(all_close(write_buffer_1d, read_buffer_1d)) + call check(all_close(reshape(write_buffer_2d, [block_per_pe]), reshape(read_buffer_2d, [block_per_pe]))) + call check(all_close(reshape(write_buffer_3d, [block_per_pe]), reshape(read_buffer_3d, [block_per_pe]))) + + call file%close() + + call io_handler%finalise() + + end subroutine test_write_read_darray_real64 + +end module test_cable_netcdf diff --git a/tests/utils/file_utils.F90 b/tests/utils/file_utils.F90 new file mode 100644 index 000000000..2c1ecc330 --- /dev/null +++ b/tests/utils/file_utils.F90 @@ -0,0 +1,36 @@ +module file_utils + use fortuno_interface_m, only: global_comm + use cable_mpi_mod, only: mpi_grp_t + implicit none + + private + + public :: & + file_exists, & + file_delete, & + file_delete_collective + +contains + + function file_exists(file_name) + character(len=*), intent(in) :: file_name + logical :: file_exists + inquire(file=trim(file_name), exist=file_exists) + end function + + subroutine file_delete(file_name) + character(len=*), intent(in) :: file_name + integer :: file_unit + if (.not. file_exists(file_name)) return + open(file=file_name, newunit=file_unit) + close(file_unit, status="delete") + end subroutine + + subroutine file_delete_collective(file_name) + character(len=*), intent(in) :: file_name + type(mpi_grp_t) :: mpi_grp + mpi_grp = mpi_grp_t(global_comm()) + if (mpi_grp%rank == 0) call file_delete(file_name) + end subroutine + +end module file_utils