diff --git a/app/train-cloud-microphysics.f90 b/app/train-cloud-microphysics.f90 new file mode 100644 index 000000000..3a93bd762 --- /dev/null +++ b/app/train-cloud-microphysics.f90 @@ -0,0 +1,85 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +#ifndef __INTEL_FORTRAN +!! Due to a suspected bug in the Intel ifx compiler, the above C preprocessor macro +!! effectively eliminates this file's source code when building with an Intel compiler. +program train_cloud_microphysics + !! Train a neural network to represent the simplest cloud microphysics model from + !! the Intermediate Complexity Atmospheric Research Model (ICAR) at + !! https://github.com/BerkeleyLab/icar. + use sourcery_m, only : string_t, file_t, command_line_t + use NetCDF_file_m, only : NetCDF_file_t + implicit none + + type(command_line_t) command_line + character(len=:), allocatable :: base + + base = command_line%flag_value("--base-name") ! gfortran 13 seg faults if this is an association + + if (len(base)==0) error stop new_line('a') // new_line('a') // & + 'Usage: ./build/run-fpm.sh run train-cloud-microphysics -- --base-name ""' + + associate(network_input => base // "_input.nc", network_output => base // "_output.nc", network => base // "_network.json") + + read_and_train: & + block + real, allocatable, dimension(:,:,:,:) :: pressure_in, potential_temperature_in, temperature_in, & + qv_in, qc_in, qi_in, qr_in, qs_in + real, allocatable, dimension(:,:,:,:) :: pressure_out, potential_temperature_out, temperature_out, & + qv_out, qc_out, qi_out, qr_out, qs_out + real, allocatable, dimension(:,:,:) :: precipitation_in, snowfall_in + real, allocatable, dimension(:,:,:) :: precipitation_out, snowfall_out + real time_in, time_out + + associate(network_input_file => netCDF_file_t(network_input)) + call network_input_file%input("pressure", pressure_in) + call network_input_file%input("potential_temperature", potential_temperature_in) + call network_input_file%input("temperature", temperature_in) + call network_input_file%input("precipitation", precipitation_in) + call network_input_file%input("snowfall", snowfall_in) + call network_input_file%input("qv", qv_in) + call network_input_file%input("qc", qc_in) + call network_input_file%input("qi", qi_in) + call network_input_file%input("qr", qr_in) + call network_input_file%input("qs", qs_in) + call network_input_file%input("time", time_in) + end associate + + associate(network_output_file => netCDF_file_t(network_output)) + call network_output_file%input("pressure", pressure_out) + call network_output_file%input("potential_temperature", potential_temperature_out) + call network_output_file%input("temperature", temperature_out) + call network_output_file%input("precipitation", precipitation_out) + call network_output_file%input("snowfall", snowfall_out) + call network_output_file%input("qv", qv_out) + call network_output_file%input("qc", qc_out) + call network_output_file%input("qi", qi_out) + call network_output_file%input("qr", qr_out) + call network_output_file%input("qs", qs_out) + call network_output_file%input("time", time_out) + end associate + + associate(dt => time_out - time_in) + associate( & + dp_dt => (pressure_out - pressure_in)/dt, & + dpt_dt => (potential_temperature_out - potential_temperature_in)/dt, & + dtemp_dt => (temperature_out - temperature_in)/dt, & + dprecip_dt => (precipitation_out - precipitation_in)/dt, & + dsnow_dt => (snowfall_out - snowfall_in)/dt, & + dqv_dt => (qv_out - qv_in)/dt, & + dqc_dt => (qc_out - qc_in)/dt, & + dqi_dt => (qi_out - qi_in)/dt, & + dqr_dt => (qr_out - qr_in)/dt, & + dqs_dt => (qs_out - qs_in)/dt & + ) + end associate + end associate + + end block read_and_train + + end associate + + print *,new_line('a') // "______training_cloud_microhpysics done _______" + +end program train_cloud_microphysics +#endif // __INTEL_FORTRAN diff --git a/fpm.toml b/fpm.toml index 3c3380f92..fa4386cbb 100644 --- a/fpm.toml +++ b/fpm.toml @@ -5,6 +5,6 @@ author = "Damian Rouson, Tan Nguyen, Jordan Welsman" maintainer = "rouson@lbl.gov" [dependencies] -assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.4.0"} +assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.5.0"} sourcery = {git = "https://github.com/sourceryinstitute/sourcery", tag = "3.8.2"} netcdf-interfaces = {git = "https://github.com/rouson/netcdf-interfaces.git", branch = "implicit-interfaces"} diff --git a/src/inference_engine/NetCDF_file_m.f90 b/src/inference_engine/NetCDF_file_m.f90 new file mode 100644 index 000000000..3a5baf510 --- /dev/null +++ b/src/inference_engine/NetCDF_file_m.f90 @@ -0,0 +1,63 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +#ifndef __INTEL_FORTRAN +!! Due to a suspected bug in the Intel ifx compiler, the above C preprocessor macro +!! effectively eliminates this file's source code when building with an Intel compiler. +module NetCDF_file_m + implicit none + + private + public :: NetCDF_file_t + + type NetCDF_file_t + private + character(len=:), allocatable :: file_name_ + contains + procedure :: input_2D_integer, input_4D_real, input_3D_real, input_real_scalar + generic :: input => input_2D_integer, input_4D_real, input_3D_real, input_real_scalar + end type + + interface NetCDF_file_t + + pure module function construct(file_name) result(NetCDF_file) + implicit none + character(len=*), intent(in) :: file_name + type(NetCDF_file_t) NetCDF_file + end function + + end interface + + interface + + module subroutine input_real_scalar(self, varname, scalar) + implicit none + class(NetCDF_file_t), intent(in) :: self + character(len=*), intent(in) :: varname + real, intent(out) :: scalar + end subroutine + + module subroutine input_2D_integer(self, varname, values) + implicit none + class(NetCDF_file_t), intent(in) :: self + character(len=*), intent(in) :: varname + integer, intent(out), allocatable :: values(:,:) + end subroutine + + module subroutine input_4D_real(self, varname, values) + implicit none + class(NetCDF_file_t), intent(in) :: self + character(len=*), intent(in) :: varname + real, intent(out), allocatable :: values(:,:,:,:) + end subroutine + + module subroutine input_3D_real(self, varname, values) + implicit none + class(NetCDF_file_t), intent(in) :: self + character(len=*), intent(in) :: varname + real, intent(out), allocatable :: values(:,:,:) + end subroutine + + end interface + +end module NetCDF_file_m +#endif // __INTEL_FORTRAN \ No newline at end of file diff --git a/src/inference_engine/NetCDF_file_s.f90 b/src/inference_engine/NetCDF_file_s.f90 new file mode 100644 index 000000000..3e0fc6421 --- /dev/null +++ b/src/inference_engine/NetCDF_file_s.f90 @@ -0,0 +1,157 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +#ifndef __INTEL_FORTRAN +!! Due to a suspected bug in the Intel ifx compiler, the above C preprocessor macro +!! effectively eliminates this file's source code when building with an Intel compiler. +submodule(netCDF_file_m) netCDF_file_s + use netcdf, only : & + nf90_create, nf90_def_dim, nf90_def_var, nf90_enddef, nf90_put_var, nf90_inquire_dimension, & ! functions + nf90_close, nf90_open, nf90_inq_varid, nf90_get_var, nf90_inquire_variable, & + nf90_clobber, nf90_noerr, nf90_strerror, nf90_int, nf90_nowrite ! constants + use assert_m, only : assert, intrinsic_array_t + implicit none + +contains + + module procedure construct + netCDF_file%file_name_ = file_name + end procedure + + function get_shape(ncid, varname) result(array_shape) + implicit none + character(len=*), intent(in) :: varname + integer, intent(in) :: ncid + integer, allocatable :: array_shape(:) + character(len=32) varid_string + integer varid, dimlen, i, var_rank + integer, parameter :: max_rank=15 + integer,dimension(max_rank+1) :: dims, dimIds + associate(nf_status => nf90_inq_varid(ncid, varname, varid)) + write(varid_string, *) varid + call assert(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inq_varid " // trim(nf90_strerror(nf_status)), & + diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string))) + end associate + associate(nf_status => nf90_inquire_variable(ncid, varid, ndims = var_rank)) + call assert(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inquire_variable" // trim(nf90_strerror(nf_status)), & + trim(nf90_strerror(nf_status)) // "(" // varname // ")") + end associate + associate(nf_status => nf90_inquire_variable(ncid, varid, dimids = dimIds(:var_rank))) + call assert(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inquire_variable" // trim(nf90_strerror(nf_status)), & + trim(nf90_strerror(nf_status)) // "(" // varname // ")") + end associate + do i=1,var_rank + associate(nf_status => nf90_inquire_dimension(ncid, dimIds(i), len = dimlen)) + call assert(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inquire_dimension" // trim(nf90_strerror(nf_status)),& + trim(nf90_strerror(nf_status)) // "(" // varname // ")") + end associate + dims(i+1)=dimlen + end do + array_shape = dims(2:var_rank+1) + end function + + module procedure input_real_scalar + + character(len=32) varid_string + integer ncid, varid + + associate( nf_status => nf90_open(self%file_name_, nf90_nowrite, ncid) ) ! open file with read-only acces + call assert(nf_status == nf90_noerr, & + "Net_CDF_file_m(input_real_scalar): nf90_open" // trim(nf90_strerror(nf_status)), & + diagnostic_data = trim(nf90_strerror(nf_status)) // self%file_name_) + end associate + + associate( nf_status => nf90_inq_varid(ncid, varname, varid)) ! get variable's ID + write(varid_string, *) varid + call assert(nf_status == nf90_noerr, "Net_CDF_file_m(input_real_scalar): nf90_inq_varid " // trim(nf90_strerror(nf_status)), & + diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string))) + end associate + + associate( nf_status => nf90_get_var(ncid, varid, scalar)) ! read data + call assert(nf_status == nf90_noerr, "NetCDF_file_s(input_real_scalar): nf90_get_var", trim(nf90_strerror(nf_status))) + end associate + + end procedure + + module procedure input_2D_integer + + character(len=32) varid_string + integer ncid, varid + + associate( nf_status => nf90_open(self%file_name_, nf90_nowrite, ncid) ) ! open file with read-only acces + call assert(nf_status == nf90_noerr, & + "Net_CDF_file_m(input_2D_integer): nf90_open" // trim(nf90_strerror(nf_status)), & + diagnostic_data = trim(nf90_strerror(nf_status)) // self%file_name_) + end associate + + associate( nf_status => nf90_inq_varid(ncid, varname, varid)) ! get variable's ID + write(varid_string, *) varid + call assert(nf_status == nf90_noerr, "Net_CDF_file_m(input_2D_integer): nf90_inq_varid " // trim(nf90_strerror(nf_status)), & + diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string))) + end associate + + associate(array_shape => get_shape(ncid, varname)) + call assert(size(array_shape)==rank(values), "netCDF_file_s(input_2D_integer): size(array_shape)==rank(values)") + allocate(values(array_shape(1), array_shape(2))) + associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data + call assert(nf_status == nf90_noerr, "NetCDF_file_s(input_2D_integer): nf90_get_var", trim(nf90_strerror(nf_status))) + end associate + end associate + + end procedure + + module procedure input_4D_real + + character(len=32) varid_string + integer ncid, varid + + associate( nf_status => nf90_open(self%file_name_, nf90_nowrite, ncid) ) ! open file with read-only acces + call assert(nf_status == nf90_noerr, "nf90_open(self%file_name_, NF90_NOWRITE, ncid)", & + trim(nf90_strerror(nf_status)) // self%file_name_) + end associate + + associate( nf_status => nf90_inq_varid(ncid, varname, varid)) ! get variable's ID + write(varid_string, *) varid + call assert(nf_status == nf90_noerr, "Net_CDF_file_m(input_4D_real): nf90_inq_varid " // trim(nf90_strerror(nf_status)), & + diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string))) + end associate + + associate(array_shape => get_shape(ncid, varname)) + call assert(size(array_shape)==rank(values), "netCDF_file_s(input_4D_real): size(array_shape)==rank(values)", & + intrinsic_array_t([size(array_shape),rank(values)])) + allocate(values(array_shape(1), array_shape(2), array_shape(3), array_shape(4))) + associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data + call assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) + end associate + end associate + + end procedure + + module procedure input_3D_real + + character(len=32) varid_string + integer ncid, varid + + associate( nf_status => nf90_open(self%file_name_, nf90_nowrite, ncid) ) ! open file with read-only acces + call assert(nf_status == nf90_noerr, "nf90_open(self%file_name_, NF90_NOWRITE, ncid)", & + trim(nf90_strerror(nf_status)) // self%file_name_) + end associate + + associate( nf_status => nf90_inq_varid(ncid, varname, varid)) ! get variable's ID + write(varid_string, *) varid + call assert(nf_status == nf90_noerr, "Net_CDF_file_m(input_3D_real): nf90_inq_varid " // trim(nf90_strerror(nf_status)), & + diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string))) + end associate + + associate(array_shape => get_shape(ncid, varname)) + call assert(size(array_shape)==rank(values), "netCDF_file_s(input_3D_real): size(array_shape)==rank(values)", & + intrinsic_array_t([size(array_shape),rank(values)])) + allocate(values(array_shape(1), array_shape(2), array_shape(3))) + associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data + call assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) + end associate + end associate + + end procedure + +end submodule netCDF_file_s +#endif // __INTEL_FORTRAN \ No newline at end of file diff --git a/src/inference_engine/netCDF_file_m.f90 b/src/inference_engine/netCDF_file_m.f90 deleted file mode 100644 index 8b962021c..000000000 --- a/src/inference_engine/netCDF_file_m.f90 +++ /dev/null @@ -1,47 +0,0 @@ -! Copyright (c), The Regents of the University of California -! Terms of use are as specified in LICENSE.txt -#ifndef __INTEL_FORTRAN -!! Due to a suspected bug in the Intel ifx compiler, the above C preprocessor macro -!! effectively eliminates this file's source code when building with an Intel compiler. -module netCDF_file_m - implicit none - - private - public :: netCDF_file_t - - type netCDF_file_t - private - character(len=:), allocatable :: file_name_ - contains - procedure input - procedure output - end type - - interface netCDF_file_t - - pure module function construct(file_name) result(netCDF_file) - implicit none - character(len=*), intent(in) :: file_name - type(netCDF_file_t) netCDF_file - end function - - end interface - - interface - - module subroutine input(self, data_in) - implicit none - class(netCDF_file_t), intent(in) :: self - integer, intent(inout), allocatable :: data_in(:,:) - end subroutine - - module subroutine output(self, data_out) - implicit none - class(netCDF_file_t), intent(in) :: self - integer, intent(in) :: data_out(:,:) - end subroutine - - end interface - -end module netCDF_file_m -#endif // __INTEL_FORTRAN diff --git a/src/inference_engine/netCDF_file_s.f90 b/src/inference_engine/netCDF_file_s.f90 deleted file mode 100644 index ff7698389..000000000 --- a/src/inference_engine/netCDF_file_s.f90 +++ /dev/null @@ -1,109 +0,0 @@ -! Copyright (c), The Regents of the University of California -! Terms of use are as specified in LICENSE.txt -#ifndef __INTEL_FORTRAN -!! Due to a suspected bug in the Intel ifx compiler, the above C preprocessor macro -!! effectively eliminates this file's source code when building with an Intel compiler. -submodule(netCDF_file_m) netCDF_file_s - use netcdf, only : & - nf90_create, nf90_def_dim, nf90_def_var, nf90_enddef, nf90_put_var, nf90_inquire_dimension, & ! functions - nf90_close, nf90_open, nf90_inq_varid, nf90_get_var, nf90_inquire_variable, & - nf90_clobber, nf90_noerr, nf90_strerror, nf90_int, nf90_nowrite ! constants - use assert_m, only : assert - implicit none - -contains - - module procedure construct - netCDF_file%file_name_ = file_name - end procedure - - module procedure output - - integer ncid, varid, x_dimid, y_dimid - - associate(nf_status => nf90_create(self%file_name_, nf90_clobber, ncid)) ! create or ovewrite file - call assert(nf_status == nf90_noerr, "nf90_create(self%file_name_, nf90_clobber, ncid) succeeds",trim(nf90_strerror(nf_status))) - end associate - associate(nf_status => nf90_def_dim(ncid, "x", size(data_out,2), x_dimid)) ! define x dimension & get its ID - call assert(nf_status == nf90_noerr,'nf90_def_dim(ncid,"x",size(data_out,2),x_dimid) succeeds',trim(nf90_strerror(nf_status))) - end associate - associate(nf_status => nf90_def_dim(ncid, "y", size(data_out,1), y_dimid)) ! define y dimension & get its ID - call assert(nf_status==nf90_noerr, 'nf90_def_dim(ncid,"y",size(data_out,2),y_dimid) succeeds', trim(nf90_strerror(nf_status))) - end associate - associate(nf_status => nf90_def_var(ncid, "data", nf90_int, [y_dimid, x_dimid], varid))!define integer 'data' variable & get ID - call assert(nf_status == nf90_noerr, 'nf90_def_var(ncid,"data",nf90_int,[y_dimid,x_dimid],varid) succeds', & - trim(nf90_strerror(nf_status))) - end associate - associate(nf_status => nf90_enddef(ncid)) ! exit define mode: tell netCDF we are done defining metadata - call assert(nf_status == nf90_noerr, 'nff90_noerr == nf90_enddef(ncid)', trim(nf90_strerror(nf_status))) - end associate - associate(nf_status => nf90_put_var(ncid, varid, data_out)) ! write all data to file - call assert(nf_status == nf90_noerr, 'nff90_noerr == nf90_put_var(ncid, varid, data_out)', trim(nf90_strerror(nf_status))) - end associate - associate(nf_status => nf90_close(ncid)) ! close file to free associated netCDF resources and flush buffers - call assert(nf_status == nf90_noerr, 'nff90_noerr == nf90_close(ncid)', trim(nf90_strerror(nf_status))) - end associate - - end procedure - - module procedure input - - integer ncid, varid, data_in_rank - - associate( nf_status => nf90_open(self%file_name_, nf90_nowrite, ncid) ) ! open file with read-only acces - call assert(nf_status == nf90_noerr, "nf90_open(self%file_name_, NF90_NOWRITE, ncid) succeeds", trim(nf90_strerror(nf_status))) - end associate - - associate( nf_status => nf90_inq_varid(ncid, "data", varid)) ! Get data variable's ID - call assert(nf_status == nf90_noerr, 'nf90_inq_varid(ncid, "data", varid) succeeds', trim(nf90_strerror(nf_status))) - end associate - - associate(data_in_shape => get_shape(ncid, "data")) - allocate(data_in(data_in_shape(1), data_in_shape(2))) - end associate - - associate( nf_status => nf90_get_var(ncid, varid, data_in)) ! Read data - call assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, data_in) succeeds", trim(nf90_strerror(nf_status))) - end associate - contains - - function get_shape(ncid, varname) result(array_shape) - implicit none - character(len=*), intent(in) :: varname - integer, intent(in) :: ncid - integer, allocatable :: array_shape(:) - character(len=32) varid_string - - integer varid, dimlen, i, var_rank - integer, parameter :: max_rank=15 - integer,dimension(max_rank+1) :: dims, dimIds - - associate(nf_status => nf90_inq_varid(ncid, varname, varid)) - write(varid_string, *) varid - call assert(nf_status == nf90_noerr, "nf90_noerr == nf90_inq_varid(ncid, varname, varid) (" // & - trim(nf90_strerror(nf_status)) // "(" // trim(varid_string)// ")") - end associate - associate(nf_status => nf90_inquire_variable(ncid, varid, ndims = var_rank)) - call assert(nf_status == nf90_noerr, "nf90_noerr == nf90_inquire_variable(ncid, varid, ndims = var_rank) (" // & - trim(nf90_strerror(nf_status)) // "(" // varname // ")") - end associate - associate(nf_status => nf90_inquire_variable(ncid, varid, dimids = dimIds(:var_rank))) - call assert(nf_status == nf90_noerr, "nf90_noerr == nf90_inquire_variable(ncid, varid, dimids = dimIds(:var_rank))", & - trim(nf90_strerror(nf_status)) // "(" // varname // ")") - end associate - - do i=1,var_rank - associate(nf_status => nf90_inquire_dimension(ncid, dimIds(i), len = dimlen)) - call assert(nf_status == nf90_noerr, "nf90_noerr == nf90_inquire_dimension(ncid, dimIds(i), len = dimlen)", & - trim(nf90_strerror(nf_status)) // "(" // varname // ")") - end associate - dims(i+1)=dimlen - end do - - array_shape = dims(2:var_rank+1) - end function - - end procedure - -end submodule netCDF_file_s -#endif // __INTEL_FORTRAN diff --git a/src/inference_engine_m.f90 b/src/inference_engine_m.f90 index d29718173..feb54eb98 100644 --- a/src/inference_engine_m.f90 +++ b/src/inference_engine_m.f90 @@ -8,6 +8,7 @@ module inference_engine_m use inference_engine_m_, only : inference_engine_t, difference_t use kind_parameters_m, only : rkind use mini_batch_m, only : mini_batch_t + use NetCDF_file_m, only : NetCDF_file_t use sigmoid_m, only : sigmoid_t use step_m, only : step_t use swish_m, only : swish_t diff --git a/test/netCDF_file_test_m.f90 b/test/netCDF_file_test_m.f90 index 4dffbae64..aa73dad41 100644 --- a/test/netCDF_file_test_m.f90 +++ b/test/netCDF_file_test_m.f90 @@ -3,7 +3,7 @@ #ifndef __INTEL_FORTRAN !! Due to a suspected bug in the Intel ifx compiler, the above C preprocessor macro !! effectively eliminates this file's source code when building with an Intel compiler. -module netCDF_file_test_m +module NetCDF_file_test_m !! Define asymmetric tests and procedures required for reporting results ! External dependencies @@ -17,14 +17,14 @@ module netCDF_file_test_m nf90_clobber, nf90_noerr, nf90_strerror, nf90_int, nf90_nowrite ! constants ! Internal dependencies - use netCDF_file_m, only : netCDF_file_t + use NetCDF_file_m, only : NetCDF_file_t implicit none private - public :: netCDF_file_test_t + public :: NetCDF_file_test_t - type, extends(test_t) :: netCDF_file_test_t + type, extends(test_t) :: NetCDF_file_test_t contains procedure, nopass :: subject procedure, nopass :: results @@ -34,7 +34,7 @@ module netCDF_file_test_m pure function subject() result(specimen) character(len=:), allocatable :: specimen - specimen = "A netCDF_file_t object" + specimen = "A NetCDF_file_t object" end function function results() result(test_results) @@ -46,33 +46,65 @@ function results() result(test_results) associate( & descriptions => & [ character(len=len(longest_description)) :: & - "written and the read gives input matching the output" & + "written and then read gives input matching the output" & ], & outcomes => & [ write_then_read() & ] & ) - call assert(size(descriptions) == size(outcomes),"asymetric_engine_test_m(results): size(descriptions) == size(outcomes)") + call assert(size(descriptions) == size(outcomes),"asymmetric_engine_test_m(results): size(descriptions) == size(outcomes)") test_results = test_result_t(descriptions, outcomes) end associate end function + subroutine output(file_name, data_out) + character(len=*), intent(in) :: file_name + integer, intent(in) :: data_out(:,:) + + integer ncid, varid, x_dimid, y_dimid + + associate(nf_status => nf90_create(file_name, nf90_clobber, ncid)) ! create or ovewrite file + call assert(nf_status == nf90_noerr, "nf90_create(file_name, nf90_clobber, ncid) succeeds",trim(nf90_strerror(nf_status))) + end associate + associate(nf_status => nf90_def_dim(ncid, "x", size(data_out,2), x_dimid)) ! define x dimension & get its ID + call assert(nf_status == nf90_noerr,'nf90_def_dim(ncid,"x",size(data_out,2),x_dimid) succeeds',trim(nf90_strerror(nf_status))) + end associate + associate(nf_status => nf90_def_dim(ncid, "y", size(data_out,1), y_dimid)) ! define y dimension & get its ID + call assert(nf_status==nf90_noerr, 'nf90_def_dim(ncid,"y",size(data_out,2),y_dimid) succeeds', trim(nf90_strerror(nf_status))) + end associate + associate(nf_status => nf90_def_var(ncid, "data", nf90_int, [y_dimid, x_dimid], varid))!define integer 'data' variable & get ID + call assert(nf_status == nf90_noerr, 'nf90_def_var(ncid,"data",nf90_int,[y_dimid,x_dimid],varid) succeds', & + trim(nf90_strerror(nf_status))) + end associate + associate(nf_status => nf90_enddef(ncid)) ! exit define mode: tell NetCDF we are done defining metadata + call assert(nf_status == nf90_noerr, 'nff90_noerr == nf90_enddef(ncid)', trim(nf90_strerror(nf_status))) + end associate + associate(nf_status => nf90_put_var(ncid, varid, data_out)) ! write all data to file + call assert(nf_status == nf90_noerr, 'nff90_noerr == nf90_put_var(ncid, varid, data_out)', trim(nf90_strerror(nf_status))) + end associate + associate(nf_status => nf90_close(ncid)) ! close file to free associated NetCDF resources and flush buffers + call assert(nf_status == nf90_noerr, 'nff90_noerr == nf90_close(ncid)', trim(nf90_strerror(nf_status))) + end associate + end subroutine + function write_then_read() result(test_passes) logical, allocatable :: test_passes(:) integer i, j integer, parameter :: ny = 12, nx = 6 integer, parameter :: data_written(*,*) = reshape([((i*j, i=1,nx), j=1,ny)], [ny,nx]) integer, allocatable :: data_read(:,:) + character(len=*), parameter :: file_name = "NetCDF_example.nc" - associate(netCDF_file => netCDF_file_t(file_name = "netCDF_example.nc")) - call netCDF_file%output(data_written) - call netCDF_file%input(data_read) - end associate + call output(file_name, data_written) + + associate(NetCDF_file => NetCDF_file_t(file_name)) + call NetCDF_file%input("data", data_read) + end associate - test_passes = [all(data_written == data_read)] + test_passes = [all(data_written == data_read)] end function -end module netCDF_file_test_m +end module NetCDF_file_test_m #endif // __INTEL_FORTRAN